albert-cvs Mailing List for Albert
Status: Alpha
Brought to you by:
stig
Menu
▾
▴
albert-cvs — cvs updates
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
(174) |
Aug
(14) |
Sep
|
Oct
(231) |
Nov
(3) |
Dec
(2) |
|---|
|
From: Stig E S. <st...@us...> - 2003-12-15 22:39:31
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv12350/spres
Modified Files:
object.lisp
Log Message:
now handles &rest and &body parameters
Index: object.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/object.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** object.lisp 27 Oct 2003 16:44:16 -0000 1.23
--- object.lisp 15 Dec 2003 22:39:27 -0000 1.24
***************
*** 94,100 ****
(strcat "(" name " " defval ")")
name))
((and (stringp mod)
(string-equal mod "optional"))
! (unless done-keydecl
(push "&OPTIONAL " retargs)
(setf done-optdecl t))
--- 94,101 ----
(strcat "(" name " " defval ")")
name))
+
((and (stringp mod)
(string-equal mod "optional"))
! (unless done-optdecl
(push "&OPTIONAL " retargs)
(setf done-optdecl t))
***************
*** 103,106 ****
--- 104,122 ----
(strcat "(" name " " defval ")")
name))
+
+ ((and (stringp mod)
+ (string-equal mod "rest"))
+ (push "&REST " retargs)
+ (if (stringp defval)
+ (strcat "(" name " " defval ")")
+ name))
+
+ ((and (stringp mod)
+ (string-equal mod "body"))
+ (push "&BODY " retargs)
+ (if (stringp defval)
+ (strcat "(" name " " defval ")")
+ name))
+
(type
(strcat "(" name " " type ")"))
|
|
From: Stig E S. <st...@us...> - 2003-12-15 22:39:31
|
Update of /cvsroot/albert/albert/lisp2csf
In directory sc8-pr-cvs1:/tmp/cvs-serv12350/lisp2csf
Modified Files:
lisp2csf.lisp
Log Message:
now handles &rest and &body parameters
Index: lisp2csf.lisp
===================================================================
RCS file: /cvsroot/albert/albert/lisp2csf/lisp2csf.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** lisp2csf.lisp 27 Oct 2003 01:04:34 -0000 1.21
--- lisp2csf.lisp 15 Dec 2003 22:39:27 -0000 1.22
***************
*** 234,241 ****
(map nil #'analyse-body-expression (cdr expr)))
))
!
!
!
!
))
--- 234,238 ----
(map nil #'analyse-body-expression (cdr expr)))
))
!
))
***************
*** 645,649 ****
(collected-args nil))
! (destructuring-bind (&key required-names key-args optional-args &allow-other-keys)
analysed-list
--- 642,646 ----
(collected-args nil))
! (destructuring-bind (&key required-names key-args optional-args rest-var body-var &allow-other-keys)
analysed-list
***************
*** 759,762 ****
--- 756,799 ----
)))
+ (when rest-var
+ (cond ((nonboolsym? rest-var) ;; single symbol, default is unspecified but nil
+ (let ((some-arg (make-csf-arg)))
+ (push (fill-info-obj (make-csf-info)
+ "name"
+ (format nil "~a" rest-var)
+ nil)
+ (csf-arg.info some-arg))
+ (push (fill-info-obj (make-csf-info)
+ "mod"
+ "rest"
+ nil)
+ (csf-arg.info some-arg))
+ (push some-arg collected-args)))
+
+ (t
+ (albert-warn "Unhandled rest-var ~s to function/method ~s"
+ rest-var name))
+ ))
+
+ (when body-var
+ (cond ((nonboolsym? body-var) ;; single symbol, default is unspecified but nil
+ (let ((some-arg (make-csf-arg)))
+ (push (fill-info-obj (make-csf-info)
+ "name"
+ (format nil "~a" body-var)
+ nil)
+ (csf-arg.info some-arg))
+ (push (fill-info-obj (make-csf-info)
+ "mod"
+ "body"
+ nil)
+ (csf-arg.info some-arg))
+ (push some-arg collected-args)))
+
+ (t
+ (albert-warn "Unhandled body-var ~s to function/method ~s"
+ body-var name))
+ ))
+
(setf (csf-method.args the-meth) (nreverse collected-args))))
|
|
From: Stig E S. <st...@us...> - 2003-11-14 16:08:43
|
Update of /cvsroot/albert/albert In directory sc8-pr-cvs1:/tmp/cvs-serv14915 Modified Files: construct.lisp Log Message: :downcase away Index: construct.lisp =================================================================== RCS file: /cvsroot/albert/albert/construct.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** construct.lisp 14 Nov 2003 16:03:27 -0000 1.6 --- construct.lisp 14 Nov 2003 16:08:40 -0000 1.7 *************** *** 52,56 **** (setf excl::stream-buffer-size 8192) ! (setf cl:*print-case* :downcase) (defun load-albert () --- 52,56 ---- (setf excl::stream-buffer-size 8192) ! ;;(setf cl:*print-case* :downcase) (defun load-albert () |
|
From: Stig E S. <st...@us...> - 2003-11-14 16:03:31
|
Update of /cvsroot/albert/albert/apispec
In directory sc8-pr-cvs1:/tmp/cvs-serv13923/apispec
Modified Files:
base.lisp helpers.lisp
Log Message:
updated some code so that albert will compile even if *readtable* is :downcase
Index: base.lisp
===================================================================
RCS file: /cvsroot/albert/albert/apispec/base.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** base.lisp 20 Oct 2003 17:47:58 -0000 1.10
--- base.lisp 14 Nov 2003 16:03:27 -0000 1.11
***************
*** 104,119 ****
#+allegro
(ecase excl:*current-case-mode*
! (:case-sensitive-lower
! 'nstring-downcase)
! (:case-insensitive-upper
! 'nstring-upcase))
#-allegro
! 'nstring-upcase))
`(let ((,str (,case-fun (reduce #'mystrcat (list ,@args)))))
(if (and (plusp (length ,str)) (eql (char ,str 0) #\:))
(intern (subseq ,str 1) *keyword-package*)
! (intern ,str)
! ))
))
--- 104,120 ----
#+allegro
(ecase excl:*current-case-mode*
! (:case-sensitive-lower 'nstring-downcase)
! (:case-insensitive-upper 'nstring-upcase))
#-allegro
! (ecase (cl:readtable-case cl:*readtable*)
! (:downcase 'nstring-downcase)
! (:upcase 'nstring-upcase))
! ))
`(let ((,str (,case-fun (reduce #'mystrcat (list ,@args)))))
(if (and (plusp (length ,str)) (eql (char ,str 0) #\:))
(intern (subseq ,str 1) *keyword-package*)
! (intern ,str)
! ))
))
Index: helpers.lisp
===================================================================
RCS file: /cvsroot/albert/albert/apispec/helpers.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** helpers.lisp 25 Oct 2003 21:47:26 -0000 1.4
--- helpers.lisp 14 Nov 2003 16:03:27 -0000 1.5
***************
*** 120,124 ****
;; (warn "defining const ~a" name)
! (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
(const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
`(eval-when (:compile-toplevel
--- 120,126 ----
;; (warn "defining const ~a" name)
! (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! (sym-name (concat-pnames "+sds-" "module-name+"))
! (mod-val (symbol-value sym-name))
(const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
`(eval-when (:compile-toplevel
***************
*** 133,137 ****
where MOD is the name of the module
"
! (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
(const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
`,const-name))
--- 135,141 ----
where MOD is the name of the module
"
! (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! (sym-name (concat-pnames "+sds-" "module-name+"))
! (mod-val (symbol-value sym-name))
(const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
`,const-name))
***************
*** 153,157 ****
is a string
"
! (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
(full-class-name (concat-pnames mod-val "-" `,name))
;;(constr-name (concat-pnames "MAKE-" full-class-name))
--- 157,163 ----
is a string
"
! (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! (sym-name (concat-pnames "+sds-" "module-name+"))
! (mod-val (symbol-value sym-name))
(full-class-name (concat-pnames mod-val "-" `,name))
;;(constr-name (concat-pnames "MAKE-" full-class-name))
***************
*** 276,282 ****
(defmacro add-subelements (obj &rest attrs)
! (let ((acc-name (concat-pnames "xml-class." "sub-Info-ptr"))
(fun-name (concat-pnames "make-xml-subelement-" "info"))
! (mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
(el-type (concat-pnames "" "xml-subelement-info"))
(howmany (length attrs))
--- 282,290 ----
(defmacro add-subelements (obj &rest attrs)
! (let* ((acc-name (concat-pnames "xml-class." "sub-Info-ptr"))
(fun-name (concat-pnames "make-xml-subelement-" "info"))
! (sym-name (concat-pnames "+sds-" "module-name+"))
! (mod-val (symbol-value sym-name))
! ;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
(el-type (concat-pnames "" "xml-subelement-info"))
(howmany (length attrs))
***************
*** 350,354 ****
(let* ((xmlclass-word (concat-pnames "xml-" "class"))
! (mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
(full-class-name (concat-pnames mod-val "-" `,name))
(export-list (list full-class-name))
--- 358,365 ----
(let* ((xmlclass-word (concat-pnames "xml-" "class"))
! (sym-name (concat-pnames "+sds-" "module-name+"))
! (mod-val (symbol-value sym-name))
! #|| (find-symbol (format nil "~a" :+sds-module-name+) *package*) ||#
!
(full-class-name (concat-pnames mod-val "-" `,name))
(export-list (list full-class-name))
***************
*** 380,383 ****
--- 391,395 ----
(setf new-slots (nconc new-slots new-val)))))
+ ;;(format t "~&>> Creating class ~s of ~s |~s|~%" full-class-name mod-val sym-name)
`(eval-when (:compile-toplevel
:load-toplevel
***************
*** 395,399 ****
(dolist (i args)
! (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
(full-class-name (concat-pnames mod-val "-" (if (symbolp i) i (car i))))
(xml-name (if (symbolp i) `,i `,(cadr i)))
--- 407,413 ----
(dolist (i args)
! (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! (sym-name (concat-pnames "+sds-" "module-name+"))
! (mod-val (symbol-value sym-name))
(full-class-name (concat-pnames mod-val "-" (if (symbolp i) i (car i))))
(xml-name (if (symbolp i) `,i `,(cadr i)))
|
|
From: Stig E S. <st...@us...> - 2003-11-14 16:03:31
|
Update of /cvsroot/albert/albert
In directory sc8-pr-cvs1:/tmp/cvs-serv13923
Modified Files:
construct.lisp
Log Message:
updated some code so that albert will compile even if *readtable* is :downcase
Index: construct.lisp
===================================================================
RCS file: /cvsroot/albert/albert/construct.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** construct.lisp 15 Oct 2003 13:24:55 -0000 1.5
--- construct.lisp 14 Nov 2003 16:03:27 -0000 1.6
***************
*** 48,54 ****
#+:cmu
! (setq extensions:*gc-verbose* nil)
#+allegro
! (setq excl::stream-buffer-size 8192)
(defun load-albert ()
--- 48,56 ----
#+:cmu
! (setf extensions:*gc-verbose* nil)
#+allegro
! (setf excl::stream-buffer-size 8192)
!
! (setf cl:*print-case* :downcase)
(defun load-albert ()
***************
*** 75,79 ****
#-mk-defsystem
! (warn "Don't know how to load albert without mkdefsys or asdf."))
--- 77,83 ----
#-mk-defsystem
! (progn
! (warn "Don't know how to load albert without mkdefsys or asdf.")
! (return-from load-albert nil)))
|
|
From: Kevin R. <kev...@us...> - 2003-10-28 00:22:35
|
Update of /cvsroot/albert/albert/debian In directory sc8-pr-cvs1:/tmp/cvs-serv25624 Modified Files: control Log Message: Automated commit for debian_version_0_4_9 Index: control =================================================================== RCS file: /cvsroot/albert/albert/debian/control,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** control 14 Jul 2003 07:13:55 -0000 1.5 --- control 28 Oct 2003 00:19:53 -0000 1.6 *************** *** 4,8 **** Maintainer: Kevin M. Rosenberg <km...@de...> Build-Depends: debhelper (>= 4.0.0) ! Standards-Version: 3.6.0 Package: albert --- 4,8 ---- Maintainer: Kevin M. Rosenberg <km...@de...> Build-Depends: debhelper (>= 4.0.0) ! Standards-Version: 3.6.1.0 Package: albert |
|
From: Stig E S. <st...@us...> - 2003-10-27 19:05:40
|
Update of /cvsroot/albert/albert/web
In directory sc8-pr-cvs1:/tmp/cvs-serv26069/web
Modified Files:
index.html
Log Message:
tweaking for release
Index: index.html
===================================================================
RCS file: /cvsroot/albert/albert/web/index.html,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** index.html 27 Oct 2003 17:59:34 -0000 1.30
--- index.html 27 Oct 2003 19:02:13 -0000 1.31
***************
*** 10,16 ****
<p>Albert is a Common Lisp doc-generator, comparable to Javadoc and
Doxygen. Currently it generates DocBook. It reads an ASDF system
! definition and documents the system. It is an experimental system
! which may or may not work for you. It's just a tool I use, which
! others might have an interest in. </p>
<table border="0"
--- 10,16 ----
<p>Albert is a Common Lisp doc-generator, comparable to Javadoc and
Doxygen. Currently it generates DocBook. It reads an ASDF system
! definition and documents the system. It has been an experimental
! system that I've used for my own projects, but others have found it
! useful too. Give it a go and let me know what you think.</p>
<table border="0"
***************
*** 23,26 ****
--- 23,30 ----
<td><a href="http://prdownloads.sourceforge.net/albert/albert-0.4.9.tar.gz?download">albert-0.4.9.tar.gz</a></td>
</tr>
+ <tr valign="top">
+ <td><b><a href="http://www.cliki.net/asdf-install">ASDF-Install</a> download:</b></td>
+ <td><a href="http://albert.sourceforge.net/albert-0.4.9.tar.gz">albert-0.4.9.tar.gz</a></td>
+ </tr>
</table>
***************
*** 29,40 ****
<ul>
! <li> <a
! href="http://etiquette.sourceforge.net/albert-docs/">Example</a> of
! generated docs for the lisp-package <a
! href="http://etiquette.sourceforge.net">Etiquette</a>. Also the
! first attempt to <a
! href="http://albert.sourceforge.net/Generated-Docs/">document/dogfood</a>
! Albert itself.</li>
!
<li> A simple <a href="howto.html">HOWTO guide</a> to get started.</li>
--- 33,40 ----
<ul>
! <li> A few examples of what Albert documentation typically looks
! like: [<a
! href="http://etiquette.sourceforge.net/Docs-Etiquette/">Etiquette</a>, <a href="http://albert.sourceforge.net/Docs-Langband/">Langband</a> and even <a href="http://albert.sourceforge.net/Docs-Albert/">Albert</a> itself.] </li>
!
<li> A simple <a href="howto.html">HOWTO guide</a> to get started.</li>
***************
*** 43,49 ****
several issues.</li>
! <li> Albert has several settings that can be configured either in
! the ASDF file or separately. The full list of <a
! href="properties.html">Properties</a>.</li>
<li> Albert's Sourceforge <a
--- 43,52 ----
several issues.</li>
! <li> Albert has several <a href="properties.html">settings</a> that can be configured either in
! the ASDF file or separately. Some of these will probably need
! tweaking to ensure that you get the result you want.</li>
!
! <li> Browse <a
! href="http://sourceforge.net/tracker/?atid=572559&group_id=84355&func=browse">known bugs</a> or <a href="http://sourceforge.net/tracker/?group_id=84355&atid=572562">existing feature requests</a>.
<li> Albert's Sourceforge <a
|
|
From: Stig E S. <st...@us...> - 2003-10-27 19:05:35
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv26069/spres
Modified Files:
generated.lisp
Log Message:
tweaking for release
Index: generated.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/generated.lisp,v
retrieving revision 1.48
retrieving revision 1.49
diff -C2 -d -r1.48 -r1.49
*** generated.lisp 27 Oct 2003 17:40:09 -0000 1.48
--- generated.lisp 27 Oct 2003 19:02:13 -0000 1.49
***************
*** 252,263 ****
(eol))
(tree-put doc
! `(:refmeta ,nil
! (:refentrytitle ,nil ,title)
! (:manvolnum nil 3)
! (:refmiscinfo nil "Project name")))
(tree-put doc
! `(:refnamediv ,nil
! (:refname ,nil ,title)
! (:refpurpose ,nil ,(if purpose purpose ""))))
(unless no-desc
(tree-put doc
--- 252,260 ----
(eol))
(tree-put doc
! `(:refmeta ,nil (:refentrytitle ,nil ,title) (:manvolnum nil 3)
! (:refmiscinfo nil "Project name")))
(tree-put doc
! `(:refnamediv ,nil (:refname ,nil ,title)
! (:refpurpose ,nil ,(if purpose purpose ""))))
(unless no-desc
(tree-put doc
***************
*** 280,284 ****
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string export-list :and-word (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(when inherit-list
--- 277,283 ----
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string export-list
! :and-word
! (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(when inherit-list
***************
*** 303,307 ****
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string inherit-list :and-word (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(unless (has-spres-flag? :simple-package)
--- 302,308 ----
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string inherit-list
! :and-word
! (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(unless (has-spres-flag? :simple-package)
***************
*** 903,907 ****
(tree-put doc
`(:programlisting ,nil
! ,(get-variable-signature doc obj :linked nil :style :intuitive)))
(when formal-pres
(put doc " <variablelist>" (eol) " <title></title>" (eol))
--- 904,913 ----
(tree-put doc
`(:programlisting ,nil
! ,(get-variable-signature doc
! obj
! :linked
! nil
! :style
! :intuitive)))
(when formal-pres
(put doc " <variablelist>" (eol) " <title></title>" (eol))
***************
*** 1123,1129 ****
(cond
((and (eq ?list-style :clever-sort))
! (print-content-list-clever-sort-of-content-presenter obj
! doc
! content-list))
(t
(warn "Fell through ~s and obj is ~s"
--- 1129,1134 ----
(cond
((and (eq ?list-style :clever-sort))
! (print-content-list-clever-sort-of-content-presenter obj doc
! content-list))
(t
(warn "Fell through ~s and obj is ~s"
|
|
From: Stig E S. <st...@us...> - 2003-10-27 19:05:32
|
Update of /cvsroot/albert/albert
In directory sc8-pr-cvs1:/tmp/cvs-serv26069
Modified Files:
albert.asd albert.system
Log Message:
tweaking for release
Index: albert.asd
===================================================================
RCS file: /cvsroot/albert/albert/albert.asd,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** albert.asd 27 Oct 2003 16:39:25 -0000 1.10
--- albert.asd 27 Oct 2003 19:02:12 -0000 1.11
***************
*** 183,188 ****
(:file "convert" :depends-on ("base"))
;;(:file "programs")
! #+sds-devel
! (:file "various")
(:file "sds-asdf" :depends-on ("convert"))
)
--- 183,188 ----
(:file "convert" :depends-on ("base"))
;;(:file "programs")
! ;;#+sds-devel
! ;;(:file "various")
(:file "sds-asdf" :depends-on ("convert"))
)
Index: albert.system
===================================================================
RCS file: /cvsroot/albert/albert/albert.system,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** albert.system 27 Oct 2003 16:39:25 -0000 1.4
--- albert.system 27 Oct 2003 19:02:13 -0000 1.5
***************
*** 172,177 ****
(:file "convert" :depends-on ("base"))
;;(:file "programs")
! #+sds-devel
! (:file "various")
(:file "sds-asdf" :depends-on ("convert"))
)
--- 172,177 ----
(:file "convert" :depends-on ("base"))
;;(:file "programs")
! ;;#+sds-devel
! ;;(:file "various")
(:file "sds-asdf" :depends-on ("convert"))
)
|
|
From: Stig E S. <st...@us...> - 2003-10-27 18:15:07
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv31459/spres
Modified Files:
tools.lisp
Log Message:
moved much code to files.lisp, also tweaked make-valid-entity somehwat
Index: tools.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/tools.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** tools.lisp 27 Oct 2003 01:04:06 -0000 1.17
--- tools.lisp 27 Oct 2003 16:42:43 -0000 1.18
***************
*** 15,81 ****
(in-package :spres-impl)
- (defun tl-find-out-dir (format)
- "Returns a pathname for the out-dir."
-
- ;;Ugly imperative style.
- ;;(warn ">> Ensure out-dir for ~s -> ~s." format (tl-get-outdir-pref format))
- ;;(warn "Pref is ~s" (albert-setting '("system" "directory")))
- (let ((sys-dir (albert-setting '("system" "directory")))
- (pref-dir (tl-get-outdir-pref format)))
-
- (when (albert-setting '("albert" "presentation" "to-current-dir"))
- (setf sys-dir cl:*default-pathname-defaults*))
-
- (cond ((pathnamep pref-dir) nil)
- ((stringp pref-dir)
- (setf pref-dir (pathname (ensure-dir-name pref-dir))))
- (t
- (albert-warn "spres> settings dir for ~s is ~s, not string/pathname." format pref-dir)
- (return-from tl-find-out-dir nil)))
-
- (cond ((pathnamep sys-dir) nil)
- ((stringp sys-dir)
- (setf sys-dir (ensure-dir-name (pathname sys-dir))))
- (t (setf sys-dir cl:*default-pathname-defaults*)))
-
- ;;(warn "Returning ~s" (merge-pathnames pref-dir sys-dir))
-
- (merge-pathnames pref-dir sys-dir)))
- #||
-
- (warn "Pref is ~s" (merge-pathnames (pathname (albert-setting '("system" "directory")))
- (let ((out-dir (ensure-dir-name (tl-get-outdir-pref format))))
- (pathname (ensure-dir-name out-dir))))
- ||#
-
- (defun tl-get-outdir-pref (format)
- "Returns the actual outdir-preference in the given output-preference.
- Returns the actual pref and not a list. Returns NIL on failure."
- (let ((retval nil))
-
- (when format
- (when (typep format 'spres-format)
- (setf format (format.name format)))
-
- (cond ((stringp format)
- (when-bind (val (albert-setting (list "albert" format "output-dir")))
- (cond ((stringp val)
- (setf retval val))
- (t
- (warn "Don't know how to handle outdir value ~s for format ~s" val format)))))
- (t
- (warn "Unable to handle format to get outdir: ~s" format))))
-
- (unless retval
- (when-bind (val (albert-setting '("albert" "presentation" "output-dir")))
- (cond ((stringp val)
- (setf retval val))
- (t
- (warn "Don't know how to handle outdir value ~s" val)))))
-
- (unless retval
- (setf retval "dumps/"))
-
- retval))
--- 15,18 ----
***************
*** 142,292 ****
- (defun permute-fname-and-add (f-obj table)
- "permutes the fname with counter till it is addable
- to the given table."
- (let ((key (file-info-to-fname f-obj)))
- (multiple-value-bind (obj found-p)
- (gethash key table)
- (declare (ignore obj))
- (cond (found-p
- (incf (file-info-counter f-obj))
- (permute-fname-and-add f-obj table))
- (t
- (setf (gethash key table) f-obj))))))
-
-
- (defun search-for-file-names (obj-list table)
- "goes recursively through the object list and adds any
- filenames to the table"
-
- (dolist (x obj-list)
- ;; hackish
- (let ((?outdir (if (typep x '(or sdoc-package sdoc-module))
- (pathname (strcat (namestring ?outdir)
- (get-object-name x) "/"))
- ?outdir)))
-
- ;; (when (typep x 'sdoc-package)
- ;; (warn "dir is ~a" ?outdir)
- ;; )
-
- (unless (is-empty? x)
-
- (when (should-have-individual-file-p x nil)
- (let ((wanted-file (get-suggested-file-name x nil)))
- (when wanted-file
- (let ((key (file-info-to-fname wanted-file)))
- (multiple-value-bind (obj found-p)
- (gethash key table)
- (declare (ignore obj))
- (cond (found-p
- (permute-fname-and-add wanted-file table))
- (t
- (setf (gethash key table) wanted-file))))))))
-
- (when (typep x '(or sdoc-package sdoc-module sdoc-class))
- (calculate-file-list x table))))))
-
-
- (defmethod calculate-file-list ((object sdoc-toplevel) table)
-
- (unless table
- (setq table (make-hash-table :test #'equal)))
-
- (let ((?outdir ""))
- (search-for-file-names (sdoc-toplevel.content object) table))
-
- (let ((ret-table (make-hash-table :test #'equal)))
- (loop for v being the hash-values of table
- do
- (setf (gethash (file-info-id v) ret-table) v))
-
- ret-table))
-
- (def-or-method calculate-file-list ((object (or sdoc-package sdoc-class sdoc-module)) table)
-
- (let ((content-list (slot-value object 'content)))
-
- (search-for-file-names content-list table)
-
- #||
- (when (typep object 'sdoc-package)
-
- (when (find-if #'(lambda (x) (typep x 'sdoc-class)) content-list)
- (let ((id (strcat "package_" (get-object-name object) "_classlist")))
- (setf (gethash id table) (make-file-info :id id
- :dir ?outdir
- :fname (make-valid-entity id)
- :counter 0))))
-
- (when (find-if #'is-generic-fun? content-list)
- (let ((id (strcat "package_" (get-object-name object) "_genfunlist")))
- (setf (gethash id table) (make-file-info :id id
- :dir ?outdir
- :fname (make-valid-entity id)
- :counter 0)))))
- ||#
- ))
-
-
-
- (defmethod get-suggested-file-name ((object sdoc-package) context)
- (declare (ignore context))
- (make-file-info :id (get-object-id object)
- :dir ?outdir
- :fname "_package"
- :counter 0))
-
- (defmethod get-suggested-file-name ((object sdoc-module) context)
- (declare (ignore context))
- (make-file-info :id (get-object-id object)
- :dir ?outdir
- :fname "_module"
- :counter 0))
-
-
- (defmethod get-suggested-file-name ((object sdoc-class) context)
- (declare (ignore context))
- (make-file-info :id (get-object-id object)
- :dir ?outdir
- :fname (make-valid-entity (get-object-name object))
- :counter 0))
-
- (defmethod get-suggested-file-name ((object sdoc-method) context)
- (declare (ignore context))
- (make-file-info :id (get-object-id object)
- :dir ?outdir
- :fname (make-valid-entity (get-object-name object))
- :counter 0))
-
-
-
- (defun file-info-to-fname (f-obj)
- "Translates the file-info obj into a filename string"
- (let ((fname (file-info-fname f-obj)))
- (when (> (file-info-counter f-obj) 0)
- (setq fname (format nil "~a-~a" fname (file-info-counter f-obj))))
- (strcat (namestring (file-info-dir f-obj)) fname)))
-
- (defun tl-ensure-file-dirs (file-table base-dir)
- "given a file-table and a pathname base-dir. Calls
- sds-global:make-sure-dirs-exist."
- ;; ensure directories in place
- (let ((done-dirs nil))
- (loop for val being the hash-values of file-table
- for dir = (file-info-dir val)
- do
- (unless (find dir done-dirs :test #'equal)
- ;; (warn "Merging ~s and ~s -> ~s,~s" ?outdir dir
- ;; (merge-pathnames dir ?outdir)
- ;; (merge-pathnames ?outdir dir)
- ;; )
- (make-sure-dirs-exist
- (tl-merge-two-paths dir base-dir))
- (push dir done-dirs)))))
! (defun make-valid-entity (word)
"translates the word into something eatable as entity and id in
sml and label in tex. It is returned as a _string_"
--- 79,86 ----
! (defun make-valid-entity (word &key (allow nil))
"translates the word into something eatable as entity and id in
sml and label in tex. It is returned as a _string_"
***************
*** 294,330 ****
(loop for x across word
do
! (if (find x '(#\% #\? #\/ #\* #\& #\! #\*
! #\~ #\[ #\] #\+ #\= #\@ #\,
! #\( #\) #\# #\< #\> #\Space) :test #'eql)
! (write-string +id-word-delim+ str)
! (write-char x str)))))
!
!
! (defun include-file-entity (f-obj)
! "Returns a string which is a legal file-inclusion
! in xml for the given f-obj"
!
! (if (stringp f-obj)
! (strcat "&file" +id-word-delim+ (make-valid-entity f-obj) ";")
! (strcat "&file" +id-word-delim+ (make-valid-entity (file-info-to-fname f-obj)) ";")))
!
!
!
! (def-or-method should-have-individual-file-p ((object (or sdoc-package
! sdoc-class
! sdoc-module)) context)
!
! ;; to avoid silly warning.. any compiler should wipe it
! (when (and nil object context))
!
! t)
!
! (defmethod should-have-individual-file-p ((object sdoc-method) context)
!
! (when (is-generic-fun? object)
! (when (>= (length (sdoc-method.content object))
! (setting-or-default '("albert" "presentation" "gf" "separatepage") 2))
! ;;(warn "File for ~s" object)
! t)))
--- 88,99 ----
(loop for x across word
do
! (cond ((and (consp allow) (find x allow))
! (write-char x str))
! ((find x '(#\% #\? #\/ #\* #\& #\! #\*
! #\~ #\[ #\] #\+ #\= #\@ #\,
! #\( #\) #\# #\< #\> #\Space) :test #'eql)
! (write-string +id-word-delim+ str))
! (t
! (write-char x str))))))
***************
*** 370,463 ****
"type"))))
- (defun tl-make-new-obj-document (obj &optional old-doc)
- "presents an independent file.."
- (let ((f-obj (gethash (get-object-id obj) ?file-table)))
-
- ;; (warn "Filename ~a -> [~a] ~a" f-obj
- ;; ?outdir (file-info-to-fname f-obj))
-
- ;; insert into the old-document an insert
- (when old-doc
- (put old-doc (include-file-entity f-obj) (eol)))
-
- ;; here is a directory-making bug
- (make-document ?outdir
- (file-info-to-fname f-obj)
- ?format
- ?language)))
-
- (defun tl-make-new-document (filename old-doc)
-
- (when old-doc
- (put old-doc (include-file-entity filename) (eol)))
-
- (make-document ?outdir
- (if (stringp filename)
- (make-valid-entity filename)
- (file-info-to-fname filename))
- ?format
- ?language))
-
-
- (defun tl-get-ok-obj-document (obj old-doc)
- "Returns a new document if the OBJ requires an
- idividual file, otherwise returns the given document."
-
- ;; (warn "Getting document from ~a ~a -> ~a" obj old-doc
- ;; (should-have-individual-file-p obj nil))
-
- (if (should-have-individual-file-p obj nil)
- (tl-make-new-obj-document obj old-doc)
-
- old-doc))
-
-
- (defun tl-possible-close-document (obj doc)
- "If the object OBJ requires it's own file, close this file,
- assuming it was opened by WITH-OK-DOCUMENT and therefore is
- safe. The closed document is also presented."
-
- (when (should-have-individual-file-p obj nil)
- ;; (warn "closing/presenting ~a document ~a" obj doc)
- (present-document doc)))
-
- (defmacro with-ok-obj-document (the-info &body the-body)
-
- (unless (and (consp the-info) (= 3 (length the-info)))
- (error "WITH-OK-DOCUMENT 1st argument should be (DOC-VAR OBJ OLD-DOC)"))
-
- (let ((gs (gensym))
- (old-doc (third the-info))
- (the-obj (second the-info))
- (doc-name (first the-info)))
-
- `(let ((,gs ,old-doc))
- (unwind-protect
- (let ((,doc-name (tl-get-ok-obj-document ,the-obj ,old-doc)))
- (unwind-protect
- ,@the-body
- (tl-possible-close-document ,the-obj ,doc-name)))
- (setf ,old-doc ,gs)))
- ))
-
- (defmacro with-ok-document (the-info &body the-body)
-
- ;; (unless (and (consp the-info) (= 3 (length the-info)))
- ;; (error "WITH-OK-DOCUMENT 1st argument should be (DOC-VAR OBJ OLD-DOC)"))
-
- (let ((gs (gensym))
- (old-doc (third the-info))
- (fname (second the-info))
- (doc-name (first the-info))
- )
-
- `(let ((,gs ,old-doc))
- (unwind-protect
- (let ((,doc-name (tl-make-new-document ,fname ,old-doc)))
- (unwind-protect
- ,@the-body
- (present-document ,doc-name)))
- (setf ,old-doc ,gs)))
- ))
(defun %strip-setf (x)
--- 139,142 ----
***************
*** 551,557 ****
t)))
- (defgeneric mergable-objs? (doc first-obj second-obj)
- (:documentation "Decides whether two objects may be
- merged for presentation."))
(defmethod mergable-objs? (doc first-obj second-obj)
--- 230,233 ----
***************
*** 560,565 ****
-
-
(defun tl-clean-for-leading-stars (str)
"makes sure comments look sane when output. Contains
--- 236,239 ----
***************
*** 655,668 ****
(tl-print-tree str tree)))
- #||
- (defun tl-make-anchor (&rest args)
- "Returns an anchor."
- (with-output-to-string (s)
- (write-string "<anchor id=\"" s)
- (dolist (i args)
- (when i
- (format s "~a" i)))
- (write-string "\"/>" s)))
- ||#
(defun tl-merge-list (doc the-list)
--- 329,332 ----
***************
*** 838,843 ****
(nreverse filtered))))
- (defstruct idx-entry
- name obj parent)
--- 502,505 ----
|
|
From: Stig E S. <st...@us...> - 2003-10-27 18:01:57
|
Update of /cvsroot/albert/albert/spres/rules
In directory sc8-pr-cvs1:/tmp/cvs-serv31277/spres/rules
Modified Files:
basic.lisp
Log Message:
made someone else handle output of <book></book> and entities than the sdoc-toplevel, should be done when full document is written
Index: basic.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/rules/basic.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** basic.lisp 26 Oct 2003 21:39:09 -0000 1.10
--- basic.lisp 27 Oct 2003 16:41:44 -0000 1.11
***************
*** 148,154 ****
(setf (db-get-dtd) better-dtd))
! (print-header obj doc :document)
! (put doc "<book>" (eol))
(print-header obj doc :book)
--- 148,154 ----
(setf (db-get-dtd) better-dtd))
! ;;(print-header obj doc :document)
! ;;(put doc "<book>" (eol))
(print-header obj doc :book)
***************
*** 181,198 ****
(when-verbose
(albert-info "spres> writing class-hierarchy to book."))
!
! (put doc "<refentry id=\"classHierarchy\">" (eol))
!
! (put doc "<refnamediv>"
! "<refname>" (get-word "Class Hierarchy" doc) "</refname>"
! "<refpurpose>Clickable index of all classes</refpurpose>"
! "</refnamediv>" (eol))
! (put doc "<refsect1><title></title>" (eol))
! (put doc "<programlisting>" (eol))
!
! (print-class-hierarchy doc ?class-hierarchy 0)
! (put doc "</programlisting>" (eol))
! (put doc "</refsect1>" (eol))
! (put doc "</refentry>" (eol)))
--- 181,203 ----
(when-verbose
(albert-info "spres> writing class-hierarchy to book."))
!
! (register-separate-document (make-file-info :id "class-hierarchy"
! :dir nil
! :fname (make-valid-entity "class-hierarchy")))
! (with-ok-document (doc "class-hierarchy" doc)
! (put doc "<refentry id=\"classHierarchy\">" (eol))
!
! (put doc "<refnamediv>"
! "<refname>" (get-word "Class Hierarchy" doc) "</refname>"
! "<refpurpose>Clickable index of all classes</refpurpose>"
! "</refnamediv>" (eol))
! (put doc "<refsect1><title></title>" (eol))
! (put doc "<programlisting>" (eol))
!
! (print-class-hierarchy doc ?class-hierarchy 0)
! (put doc "</programlisting>" (eol))
! (put doc "</refsect1>" (eol))
! (put doc "</refentry>" (eol))
! ))
***************
*** 200,221 ****
(albert-setting '("albert" "presentation" "index" "global-index")))
;; time to do an index
!
! (put doc "<refentry id=\"globalIndex\">" (eol))
!
! (put doc "<refnamediv>"
! "<refname>" (get-word "Global Index" doc) "</refname>"
! "<refpurpose>Clickable index of all symbols</refpurpose>"
! "</refnamediv>" (eol))
!
! (dolist (i content)
! (unless (is-empty? i)
! (present-object i doc :index)))
!
! (put doc "</refentry>" (eol)))
(put doc "</reference>" (eol))
)
! (put doc "</book>" (eol))))
#||
--- 205,233 ----
(albert-setting '("albert" "presentation" "index" "global-index")))
;; time to do an index
!
! (register-separate-document (make-file-info :id "global-index"
! :dir nil
! :fname (make-valid-entity "global-index")))
! (with-ok-document (doc "global-index" doc)
!
! (put doc "<refentry id=\"globalIndex\">" (eol))
!
! (put doc "<refnamediv>"
! "<refname>" (get-word "Global Index" doc) "</refname>"
! "<refpurpose>Clickable index of all symbols</refpurpose>"
! "</refnamediv>" (eol))
!
! (dolist (i content)
! (unless (is-empty? i)
! (present-object i doc :index)))
!
! (put doc "</refentry>" (eol))
! )) ;; end glob index
(put doc "</reference>" (eol))
)
! ;;(put doc "</book>" (eol))
! ))
#||
|
|
From: Stig E S. <st...@us...> - 2003-10-27 18:00:54
|
Update of /cvsroot/albert/albert/data In directory sc8-pr-cvs1:/tmp/cvs-serv13165/data Modified Files: albert.dsl Log Message: getting ready for 0.4.9 Index: albert.dsl =================================================================== RCS file: /cvsroot/albert/albert/data/albert.dsl,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** albert.dsl 22 Oct 2003 18:35:29 -0000 1.23 --- albert.dsl 27 Oct 2003 17:59:33 -0000 1.24 *************** *** 22,26 **** <style-specification-body> ! (define %albert-version% "0.4.9pre1") (define %css-decoration% --- 22,26 ---- <style-specification-body> ! (define %albert-version% "0.4.9") (define %css-decoration% |
|
From: Stig E S. <st...@us...> - 2003-10-27 18:00:51
|
Update of /cvsroot/albert/albert In directory sc8-pr-cvs1:/tmp/cvs-serv13165 Modified Files: ChangeLog Log Message: getting ready for 0.4.9 Index: ChangeLog =================================================================== RCS file: /cvsroot/albert/albert/ChangeLog,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** ChangeLog 20 Oct 2003 17:56:17 -0000 1.6 --- ChangeLog 27 Oct 2003 17:59:30 -0000 1.7 *************** *** 1,2 **** --- 1,43 ---- + 2003-10-27 Stig E Sandø <st...@us...> + * New file spres/files.lisp for file-related stuff in + presentation code. + * New file tools/docme.lisp to document albert itself. + * Two new icons exported.png and internal.png added to data/icons/ + and are referred to by data/albert.dsl wrt export-status. + * Made class-hierarchy setting numeric instead of boolean, see + settings.lisp + * Added preliminary support for listing 'related methods' in + classes and structs. Related methods are methods that dispatch on + that particular class or struct. Can be controlled via a setting. + * Can make a separate page for variables in a package if they're + many. Controlled by a setting. + * Can now control where slot-accessors and readers/writers are + listed in the data (in the class they refer to or in the package + itself or even both). + * Now uses proper parent-info in the sdoc-handling in spres + * Have improved lisp2csf handling of complex source, and it will + be less likely to crash and get the accurate info. Now uses a + testsuite to ensure that things remain solid and liberal. Are + looking for more code to add to testsuite. + * lisp2csf will now handle defparameter, keyword-parameters and + optional parameters correctly. lisp2csf will also understand more + calls to EXPORT and use that info. lisp2csf allows you to control + how to prepare the readtable, e.g sbcl needs several tweaks there. + * spres will try to put more info in other xml-files than + book.xml, improving debugging and overview of generated data. + This is the first step in making albert produce output that allows + easy inclusion of other docs and easy inclusion of albert api docs in + other docs. + * Changes lookup of names to use new parent-info in the + presentation. This may cause problems in some cases, but in the + testsuite it is more correct and flexible than the old lookups. + * Added back in locations in presentations of methods, also with + cvsview support. + * Removed caching and several other faster tricks in code, + resulting in slower, but more correct code. + * Many other bugfixes, cleanups, improvements and stuff behind the + scenes. + * Tagged tree VER_0_4_9 + 2003-10-20 Stig E Sandø <st...@us...> * Added printout of the class-hierarchy Albert already used |
|
From: Stig E S. <st...@us...> - 2003-10-27 18:00:42
|
Update of /cvsroot/albert/albert/web
In directory sc8-pr-cvs1:/tmp/cvs-serv13165/web
Modified Files:
index.html
Log Message:
getting ready for 0.4.9
Index: index.html
===================================================================
RCS file: /cvsroot/albert/albert/web/index.html,v
retrieving revision 1.29
retrieving revision 1.30
diff -C2 -d -r1.29 -r1.30
*** index.html 21 Oct 2003 19:04:36 -0000 1.29
--- index.html 27 Oct 2003 17:59:34 -0000 1.30
***************
*** 17,25 ****
<tr valign="top">
<td><b>Current version:</b></td>
! <td><b><font color="green">v0.4.8</font></b></td>
</tr>
<tr valign="top">
<td><b>Sourceforge download:</b></td>
! <td><a href="http://prdownloads.sourceforge.net/albert/albert-0.4.8.tar.gz?download">albert-0.4.8.tar.gz</a></td>
</tr>
</table>
--- 17,25 ----
<tr valign="top">
<td><b>Current version:</b></td>
! <td><b><font color="green">v0.4.9</font></b></td>
</tr>
<tr valign="top">
<td><b>Sourceforge download:</b></td>
! <td><a href="http://prdownloads.sourceforge.net/albert/albert-0.4.9.tar.gz?download">albert-0.4.9.tar.gz</a></td>
</tr>
</table>
|
|
From: Stig E S. <st...@us...> - 2003-10-27 18:00:42
|
Update of /cvsroot/albert/albert/debian In directory sc8-pr-cvs1:/tmp/cvs-serv13165/debian Modified Files: changelog Log Message: getting ready for 0.4.9 Index: changelog =================================================================== RCS file: /cvsroot/albert/albert/debian/changelog,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** changelog 20 Oct 2003 17:56:17 -0000 1.12 --- changelog 27 Oct 2003 17:59:34 -0000 1.13 *************** *** 1,2 **** --- 1,8 ---- + albert (0.4.9) unstable; urgency=low + + * Yet another new upstream. + + -- Stig E Sandoe <st...@us...> Mon, 27 Oct 2003 18:52:27 +0100 + albert (0.4.8) unstable; urgency=low |
|
From: Stig E S. <st...@us...> - 2003-10-27 17:46:20
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv9503/spres
Modified Files:
base.lisp generated.lisp tools.lisp
Log Message:
tweaking
Index: base.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/base.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** base.lisp 27 Oct 2003 16:44:45 -0000 1.11
--- base.lisp 27 Oct 2003 17:40:09 -0000 1.12
***************
*** 214,217 ****
--- 214,236 ----
in WHERE (and WHERE's content). Recursive. Returns a list of objects."))
+ (defgeneric put (destination &rest args)
+ (:documentation "Puts the ARGS sequentially to the destination which should
+ be an output-stream of some kind, or a document."))
+
+ (defgeneric put-t (destination type &rest args)
+ (:documentation "Puts the ARGS sequentially to the destination inside a tag
+ of type TYPE. The destination should be an output-stream of some kind,
+ or a document."))
+
+ (defgeneric present-book-header (doc actual-stream)
+ (:documentation "Presents a document-header (book) for a document DOC to
+ the output-stream ACTUAL-STREAM."))
+
+
+ (defgeneric present-book-footer (doc actual-stream)
+ (:documentation "Presents a document-footer (book) for a document DOC to
+ the output-stream ACTUAL-STREAM."))
+
+
;;; === end generics
Index: generated.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/generated.lisp,v
retrieving revision 1.47
retrieving revision 1.48
diff -C2 -d -r1.47 -r1.48
*** generated.lisp 27 Oct 2003 17:16:45 -0000 1.47
--- generated.lisp 27 Oct 2003 17:40:09 -0000 1.48
***************
*** 252,260 ****
(eol))
(tree-put doc
! `(:refmeta ,nil (:refentrytitle ,nil ,title) (:manvolnum nil 3)
! (:refmiscinfo nil "Project name")))
(tree-put doc
! `(:refnamediv ,nil (:refname ,nil ,title)
! (:refpurpose ,nil ,(if purpose purpose ""))))
(unless no-desc
(tree-put doc
--- 252,263 ----
(eol))
(tree-put doc
! `(:refmeta ,nil
! (:refentrytitle ,nil ,title)
! (:manvolnum nil 3)
! (:refmiscinfo nil "Project name")))
(tree-put doc
! `(:refnamediv ,nil
! (:refname ,nil ,title)
! (:refpurpose ,nil ,(if purpose purpose ""))))
(unless no-desc
(tree-put doc
***************
*** 277,283 ****
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string export-list
! :and-word
! (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(when inherit-list
--- 280,284 ----
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string export-list :and-word (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(when inherit-list
***************
*** 302,308 ****
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string inherit-list
! :and-word
! (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(unless (has-spres-flag? :simple-package)
--- 303,307 ----
(tree-put doc
`(:simpara ,nil
! ,(list-to-sep-string inherit-list :and-word (get-word "and" doc))))))
(put doc "</refsect1>" (eol)))
(unless (has-spres-flag? :simple-package)
***************
*** 904,913 ****
(tree-put doc
`(:programlisting ,nil
! ,(get-variable-signature doc
! obj
! :linked
! nil
! :style
! :intuitive)))
(when formal-pres
(put doc " <variablelist>" (eol) " <title></title>" (eol))
--- 903,907 ----
(tree-put doc
`(:programlisting ,nil
! ,(get-variable-signature doc obj :linked nil :style :intuitive)))
(when formal-pres
(put doc " <variablelist>" (eol) " <title></title>" (eol))
***************
*** 1129,1134 ****
(cond
((and (eq ?list-style :clever-sort))
! (print-content-list-clever-sort-of-content-presenter obj doc
! content-list))
(t
(warn "Fell through ~s and obj is ~s"
--- 1123,1129 ----
(cond
((and (eq ?list-style :clever-sort))
! (print-content-list-clever-sort-of-content-presenter obj
! doc
! content-list))
(t
(warn "Fell through ~s and obj is ~s"
Index: tools.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/tools.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** tools.lisp 27 Oct 2003 16:42:43 -0000 1.18
--- tools.lisp 27 Oct 2003 17:40:09 -0000 1.19
***************
*** 77,85 ****
(dolist (x the-info)
(put doc "<" field ">" (car (slot-value x 'value)) "</" field ">" (eol))))))
-
-
-
(defun make-valid-entity (word &key (allow nil))
"translates the word into something eatable as entity and id in
--- 77,82 ----
|
|
From: Stig E S. <st...@us...> - 2003-10-27 17:39:37
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv31589/spres
Modified Files:
r-db.lisp
Log Message:
added code to print <book></book> and entities as header+footer functions
Index: r-db.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/r-db.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** r-db.lisp 27 Oct 2003 01:04:06 -0000 1.22
--- r-db.lisp 27 Oct 2003 16:43:22 -0000 1.23
***************
*** 39,43 ****
! (defmethod present-document ((doc docbook-document))
;; (when-verbose
--- 39,43 ----
! (defmethod present-document ((doc docbook-document) &key content-prefix content-suffix)
;; (when-verbose
***************
*** 70,75 ****
:if-exists :new-version
:if-does-not-exist :create)
(write-string (get-output-stream-string (document.content doc))
! out-stream))
#||
--- 70,90 ----
:if-exists :new-version
:if-does-not-exist :create)
+
+ (cond ((stringp content-prefix)
+ (write-string content-prefix out-stream))
+ ((functionp content-prefix)
+ (funcall content-prefix doc out-stream))
+ (t nil))
+
(write-string (get-output-stream-string (document.content doc))
! out-stream)
!
! (cond ((stringp content-suffix)
! (write-string content-suffix out-stream))
! ((functionp content-suffix)
! (funcall content-suffix doc out-stream))
! (t nil))
! )
!
#||
***************
*** 78,82 ****
(albert-info "Wrote docbook book to ~a" (namestring out-file))))
||#
! ))
--- 93,97 ----
(albert-info "Wrote docbook book to ~a" (namestring out-file))))
||#
! doc))
***************
*** 666,668 ****
(present-with-content-manager package doc objs)
(put doc " </refsect1>" (eol))))
!
\ No newline at end of file
--- 681,713 ----
(present-with-content-manager package doc objs)
(put doc " </refsect1>" (eol))))
!
! (defmethod present-book-header ((doc docbook-document) stream)
!
! (put stream "<?xml version='1.0'?>" (eol))
! (put stream "<!DOCTYPE book PUBLIC \"-//Norman Walsh//DTD DocBk XML V3.1.7//EN\"
! \"" (db-get-dtd) "\" " )
!
! (when (and ?file-table (> (hash-table-count ?file-table) 0))
!
! (put stream "[" (eol))
!
! (loop for val being the hash-values of ?file-table
! for fname = (file-info-to-fname val)
! do
! (put stream
! "<!ENTITY "
! "fileX" (make-valid-entity fname) " "
! "SYSTEM \"" fname (get-file-extension doc)
! "\">" (eol)))
! (put stream "]"))
!
! (put stream ">" (eol))
!
! (put stream "<book>" (eol))
!
! doc)
!
!
! (defmethod present-book-footer ((doc docbook-document) actual-stream)
! (format actual-stream "~&</book>~%")
! doc)
|
|
From: Stig E S. <st...@us...> - 2003-10-27 17:22:09
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv5578/spres
Modified Files:
files.lisp generated.lisp
Log Message:
fixed dodgy filenames for generated files
Index: files.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/files.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** files.lisp 27 Oct 2003 16:39:25 -0000 1.1
--- files.lisp 27 Oct 2003 17:16:45 -0000 1.2
***************
*** 99,110 ****
(dolist (x obj-list)
;; hackish
! (let ((?outdir (if (typep x '(or sdoc-package sdoc-module))
! (pathname (strcat (namestring ?outdir)
! (get-object-name x) "/"))
! ?outdir)))
- ;; (when (typep x 'sdoc-package)
- ;; (warn "dir is ~a" ?outdir)
- ;; )
(unless (is-empty? x)
--- 99,108 ----
(dolist (x obj-list)
;; hackish
! (let ((?outdir (cond ((typep x '(or sdoc-package sdoc-module))
! (pathname (strcat (namestring ?outdir)
! (make-valid-entity (get-object-name x))
! "/")))
! (t ?outdir))))
(unless (is-empty? x)
Index: generated.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/generated.lisp,v
retrieving revision 1.46
retrieving revision 1.47
diff -C2 -d -r1.46 -r1.47
*** generated.lisp 27 Oct 2003 16:40:01 -0000 1.46
--- generated.lisp 27 Oct 2003 17:16:45 -0000 1.47
***************
*** 389,393 ****
+id-word-delim+
(make-valid-entity cl-name)))
! (fname (strcat cl-name "/" "contentlist"))
(?rec-state :refsect1)
(?parent obj)
--- 389,394 ----
+id-word-delim+
(make-valid-entity cl-name)))
! (fname
! (strcat (make-valid-entity cl-name) "/" "contentlist"))
(?rec-state :refsect1)
(?parent obj)
|
|
From: Stig E S. <st...@us...> - 2003-10-27 17:21:40
|
Update of /cvsroot/albert/albert/spres/rules In directory sc8-pr-cvs1:/tmp/cvs-serv5578/spres/rules Modified Files: package.lisp Log Message: fixed dodgy filenames for generated files Index: package.lisp =================================================================== RCS file: /cvsroot/albert/albert/spres/rules/package.lisp,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** package.lisp 27 Oct 2003 16:40:45 -0000 1.16 --- package.lisp 27 Oct 2003 17:16:45 -0000 1.17 *************** *** 222,226 **** (file-id (strcat "package" +id-word-delim+ "contentlist" +id-word-delim+ (make-valid-entity cl-name))) ! (fname (strcat cl-name "/" "contentlist")) (?rec-state :refsect1) (?parent obj) --- 222,226 ---- (file-id (strcat "package" +id-word-delim+ "contentlist" +id-word-delim+ (make-valid-entity cl-name))) ! (fname (strcat (make-valid-entity cl-name) "/" "contentlist")) (?rec-state :refsect1) (?parent obj) |
|
From: Stig E S. <st...@us...> - 2003-10-27 16:50:38
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv31908/spres
Modified Files:
base.lisp
Log Message:
rearranged some code, also turned PUT and PUT-T into methods
Index: base.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/base.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** base.lisp 27 Oct 2003 01:04:06 -0000 1.10
--- base.lisp 27 Oct 2003 16:44:45 -0000 1.11
***************
*** 19,27 ****
(in-package :spres-impl)
! ;; abstract
(defclass spres-format ()
((name :initarg :name :accessor format.name :initform nil)))
!
(defclass spres-document ()
((directory :initarg :directory
--- 19,27 ----
(in-package :spres-impl)
! ;; abstract, add docs
(defclass spres-format ()
((name :initarg :name :accessor format.name :initform nil)))
! ;; add docs
(defclass spres-document ()
((directory :initarg :directory
***************
*** 53,57 ****
--- 53,61 ----
) )
+ ;; add docs
+ (defstruct idx-entry
+ name obj parent)
+ ;; add docs
(defstruct file-info
id
***************
*** 60,63 ****
--- 64,68 ----
counter)
+ ;; add docs
(defclass tree-node ()
((the-class :initform nil :initarg :the-class :accessor tnode.class)
***************
*** 85,121 ****
! ;;; generics..
(defgeneric is-empty? (obj)
(:documentation "Checks whether an object is empty"))
- (defmethod is-empty? (obj)
- (warn "No IS-EMPTY? function written for ~a" (its-name obj))
- t)
-
(defgeneric taggify (format type str)
(:documentation "Tagifies/Formats given string according to format and type"))
- (defmethod taggify (format type str)
- (declare (ignore str))
- (warn "No support have been added for (taggify ~a ~a ..)" (its-name format) type)
- "")
-
(defgeneric make-document (dir filename format lang)
(:documentation "creates a document which is a subclass of spres-document"))
! (defmethod make-document (dir filename format lang)
! (declare (ignore dir filename))
! (warn "No support has been written for (MAKE-DOCUMENT dir filename ~a ~a)"
! (its-name format) (its-name lang)))
!
! (defgeneric present-document (doc)
! (:documentation
! "Presents a document"))
!
! ;;(defmethod-with-warn present-document (doc))
! (defmethod present-document (doc)
! (warn "No support have been written for (PRESENT-DOCUMENT ~a ..)" (its-name doc)))
!
;; default method in object.lisp
--- 90,110 ----
! ;;; === start generics..
!
! (defgeneric mergable-objs? (doc first-obj second-obj)
! (:documentation "Decides whether two objects may be
! merged for presentation."))
(defgeneric is-empty? (obj)
(:documentation "Checks whether an object is empty"))
(defgeneric taggify (format type str)
(:documentation "Tagifies/Formats given string according to format and type"))
(defgeneric make-document (dir filename format lang)
(:documentation "creates a document which is a subclass of spres-document"))
! (defgeneric present-document (doc &key content-prefix content-suffix)
! (:documentation "Presents a document"))
;; default method in object.lisp
***************
*** 137,183 ****
(:documentation "returns a simple link as text where it makes sense"))
- (defmethod get-simple-link (doc dest desc &key hovertext)
- (declare (ignore dest desc hovertext))
- (warn "No support have been written for (GET-SIMPLE-LINK ~a ..)"
- (its-name doc)))
-
(defgeneric make-obj-link (doc obj parent &key desc &allow-other-keys)
(:documentation "Returns a link to the given object."))
- (defmethod make-obj-link (doc obj parent &key desc)
- (declare (ignore doc obj parent desc))
- (error "simple MAKE-OBJ-LINK not implemented."))
-
- (defgeneric make-obj-id (doc obj parent &key &allow-other-keys)
- (:documentation "Returns an id for the given object."))
-
- (defmethod make-obj-id (doc obj parent &key)
- (declare (ignore doc obj parent))
- (error "simple MAKE-OBJ-ID not implemented."))
-
-
(defgeneric get-simple-anchor (doc anchor-word)
(:documentation "returns an anchor where appropriate"))
! (defmethod get-simple-anchor (doc word)
! (declare (ignore word))
! (warn "No support have been written for (GET-SIMPLE-ANCHOR ~a ..)"
! (its-name doc)))
(defgeneric get-newline (doc)
(:documentation "returns a newline for given doc"))
- (defmethod get-newline (doc)
- (warn "No support have been written for (GET-NEWLINE ~a ..)"
- (its-name doc)))
-
(defgeneric generate-tag (doc tag end-tag?)
(:documentation "generates some tag"))
- (defmethod generate-tag (doc tag end-tag?)
- (declare (ignore tag end-tag?))
- (warn "No support have been written for (GENERATE-TAG ~a ..)"
- (its-name doc)))
-
(defgeneric present-table (doc objlist style)
(:documentation "Makes a table of the objects in list in given style"))
--- 126,144 ----
(:documentation "returns a simple link as text where it makes sense"))
(defgeneric make-obj-link (doc obj parent &key desc &allow-other-keys)
(:documentation "Returns a link to the given object."))
(defgeneric get-simple-anchor (doc anchor-word)
(:documentation "returns an anchor where appropriate"))
! (defgeneric make-obj-id (doc obj parent &key &allow-other-keys)
! (:documentation "Returns an id for the given object."))
(defgeneric get-newline (doc)
(:documentation "returns a newline for given doc"))
(defgeneric generate-tag (doc tag end-tag?)
(:documentation "generates some tag"))
(defgeneric present-table (doc objlist style)
(:documentation "Makes a table of the objects in list in given style"))
***************
*** 186,200 ****
(:documentation "recurses down and collects file-names"))
- (defmethod calculate-file-list (object table)
- (declare (ignore table))
- (warn "No CALCULATE-FILE-LIST written for ~a [~a]" (its-name object) object))
-
(defgeneric print-class-hierarcy (doc hierarchy indent)
(:documentation "Prints a class hierarchy to the given document."))
- (defmethod print-class-hierarcy (doc hierarchy indent)
- (declare (ignore doc hierarchy indent))
- (error "PRINT-CLASS-HIERARCHY not implemented"))
-
(defgeneric get-suggested-file-name (object context)
(:documentation "Asks an object what it wants to have as its
--- 147,153 ----
***************
*** 203,224 ****
it wants."))
- (defmethod-with-warn get-suggested-file-name (object context))
-
-
(defgeneric should-have-individual-file-p (object context)
(:documentation "checks to see if the object should have
an individual file"))
- (defmethod should-have-individual-file-p (object context)
- (declare (ignore object context))
- nil)
-
(defgeneric collect-indexable (obj)
(:documentation "Collects all indexable contents of obj."))
- (defmethod collect-indexable (obj)
- (albert-warn "spres> unhandled indexable-obj ~s" obj)
- nil)
-
(defgeneric update-parent-status! (obj parent)
(:documentation "Updates OBJ (with parent PARENT) recursively downwards
--- 156,166 ----
***************
*** 261,268 ****
default should be used."))
- (defmethod docbook-page-title (doc object)
- (declare (ignore doc object))
- nil)
-
(defgeneric get-method-arguments (meth-obj prog-lang)
(:documentation "Returns a string with arguments organised properly for
--- 203,206 ----
***************
*** 276,307 ****
in WHERE (and WHERE's content). Recursive. Returns a list of objects."))
! (defun put (doc &rest args)
"convenient function when dumping output to a document"
- (let ((str (document.content doc)))
! (dolist (h args)
! ;; (declare (type simple-base-string h))
! (when h
! (etypecase h
! (string (write-string h str))
! (integer (format str "~d" h)))))
! (force-output str)
! ;; (terpri str)
! ))
! (defun put-t (doc type &rest args)
"puts tagged info to given document"
! ;; (warn "PUT-T called")
! (let ((str (document.content doc)))
!
! (dolist (h args)
! ;; (declare (type simple-base-string h))
! (when (and h (length h))
! (write-string (the simple-base-string (taggify doc type h)) str)))
! ;;(terpri str)
! (force-output str)
! ))
(defmacro with-some-tag (doc tag &rest body)
--- 214,332 ----
in WHERE (and WHERE's content). Recursive. Returns a list of objects."))
!
! ;;; === end generics
!
! ;;; === start base defmethods
!
! (defmethod is-empty? (obj)
! (warn "No IS-EMPTY? function written for ~a" (its-name obj))
! t)
!
! (defmethod taggify (format type str)
! (declare (ignore str))
! (warn "No support have been added for (taggify ~a ~a ..)" (its-name format) type)
! "")
!
!
! (defmethod make-document (dir filename format lang)
! (declare (ignore dir filename))
! (warn "No support has been written for (MAKE-DOCUMENT dir filename ~a ~a)"
! (its-name format) (its-name lang)))
!
! ;;(defmethod-with-warn present-document (doc))
! (defmethod present-document (doc &key content-prefix content-suffix)
! (warn "No support have been written for (PRESENT-DOCUMENT ~a ..)" (its-name doc))
! nil)
!
!
! (defmethod get-simple-link (doc dest desc &key hovertext)
! (declare (ignore dest desc hovertext))
! (warn "No support have been written for (GET-SIMPLE-LINK ~a ..)"
! (its-name doc)))
!
!
! (defmethod make-obj-link (doc obj parent &key desc)
! (declare (ignore doc obj parent desc))
! (error "simple MAKE-OBJ-LINK not implemented."))
!
!
! (defmethod make-obj-id (doc obj parent &key)
! (declare (ignore doc obj parent))
! (error "simple MAKE-OBJ-ID not implemented."))
!
!
!
! (defmethod get-simple-anchor (doc word)
! (declare (ignore word))
! (warn "No support have been written for (GET-SIMPLE-ANCHOR ~a ..)"
! (its-name doc)))
!
!
! (defmethod get-newline (doc)
! (warn "No support have been written for (GET-NEWLINE ~a ..)"
! (its-name doc)))
!
!
! (defmethod generate-tag (doc tag end-tag?)
! (declare (ignore tag end-tag?))
! (warn "No support have been written for (GENERATE-TAG ~a ..)"
! (its-name doc)))
!
! (defmethod calculate-file-list (object table)
! (declare (ignore table))
! (warn "No CALCULATE-FILE-LIST written for ~a [~a]" (its-name object) object))
!
!
! (defmethod print-class-hierarcy (doc hierarchy indent)
! (declare (ignore doc hierarchy indent))
! (error "PRINT-CLASS-HIERARCHY not implemented"))
!
!
! (defmethod-with-warn get-suggested-file-name (object context))
!
!
!
! (defmethod should-have-individual-file-p (object context)
! (declare (ignore object context))
! nil)
!
!
! (defmethod collect-indexable (obj)
! (albert-warn "spres> unhandled indexable-obj ~s" obj)
! nil)
!
!
! (defmethod docbook-page-title (doc object)
! (declare (ignore doc object))
! nil)
!
!
! (defmethod put ((str cl:stream) &rest args)
"convenient function when dumping output to a document"
! (dolist (h args)
! (when h
! (etypecase h
! (string (write-string h str))
! (integer (format str "~d" h)))))
! (force-output str))
! (defmethod put ((doc spres-document) &rest args)
! "convenient function when dumping output to a document"
! (apply #'put (document.content doc) args))
!
! (defmethod put-t ((str cl:stream) type &rest args)
"puts tagged info to given document"
!
! (dolist (h args)
! (when (and h (length h))
! (write-string (the simple-base-string (taggify doc type h)) str)))
! ;;(terpri str)
! (force-output str))
+
+ (defmethod put-t ((doc spres-document) type &rest args)
+ (apply #'put-t (document.content doc) type args))
(defmacro with-some-tag (doc tag &rest body)
|
|
From: Stig E S. <st...@us...> - 2003-10-27 16:50:13
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv31827/spres
Modified Files:
object.lisp
Log Message:
made present-document use header+footer as possible prefix+suffic to a document
Index: object.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/object.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** object.lisp 27 Oct 2003 01:04:06 -0000 1.22
--- object.lisp 27 Oct 2003 16:44:16 -0000 1.23
***************
*** 929,932 ****
--- 929,939 ----
(gethash (%strip-setf name) *package-exports*)))
+
+ (defmethod present-book-header (doc actual-stream)
+ nil)
+
+ (defmethod present-book-footer (doc actual-stream)
+ nil)
+
(defun present-book (tpl-object)
"Outputs a book of the given top-level object"
***************
*** 947,955 ****
(tl-ensure-file-dirs ?file-table ?outdir)
! ;; (cl-user::pr-ht ?file-table)
(let ((*scope-stack* (cons tpl-object *scope-stack*)))
(present-object tpl-object document :full))
! (present-document document)
(ignore-errors
(unless-quiet
--- 954,966 ----
(tl-ensure-file-dirs ?file-table ?outdir)
! ;;(cl-user::pr-ht ?file-table)
!
(let ((*scope-stack* (cons tpl-object *scope-stack*)))
(present-object tpl-object document :full))
!
! (present-document document :content-prefix #'present-book-header
! :content-suffix #'present-book-footer)
!
(ignore-errors
(unless-quiet
|
|
From: Stig E S. <st...@us...> - 2003-10-27 16:46:12
|
Update of /cvsroot/albert/albert/spres/rules
In directory sc8-pr-cvs1:/tmp/cvs-serv30936/spres/rules
Modified Files:
package.lisp
Log Message:
made package write contentlist to separate xml-file
Index: package.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/rules/package.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** package.lisp 27 Oct 2003 01:04:06 -0000 1.15
--- package.lisp 27 Oct 2003 16:40:45 -0000 1.16
***************
*** 219,223 ****
(when normal-objs
! (let* ((?rec-state :refsect1)
(?parent obj)
;;(var-count (loop for x in normal-objs when (typep x 'sdoc-variable) summing 1))
--- 219,227 ----
(when normal-objs
! (let* ((cl-name (get-object-name obj))
! (file-id (strcat "package" +id-word-delim+ "contentlist" +id-word-delim+
! (make-valid-entity cl-name)))
! (fname (strcat cl-name "/" "contentlist"))
! (?rec-state :refsect1)
(?parent obj)
;;(var-count (loop for x in normal-objs when (typep x 'sdoc-variable) summing 1))
***************
*** 226,229 ****
--- 230,240 ----
;;(other-count (- obj-count var-count))
)
+
+
+ (register-separate-document (make-file-info :id file-id
+ :dir nil
+ :fname fname))
+ (with-ok-document (doc fname doc)
+
(when (>= var-count (albert-setting '("albert" "presentation" "variables" "separatepage")))
***************
*** 284,288 ****
(put doc " </refentry>" (eol))))
! ))
(when (has-spres-flag? :simple-package)
--- 295,300 ----
(put doc " </refentry>" (eol))))
! ) ;; end special doc
! )) ;; end normal-objs
(when (has-spres-flag? :simple-package)
|
|
From: Stig E S. <st...@us...> - 2003-10-27 16:45:32
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv30663/spres
Modified Files:
generated.lisp
Log Message:
changes from other places
Index: generated.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/generated.lisp,v
retrieving revision 1.45
retrieving revision 1.46
diff -C2 -d -r1.45 -r1.46
*** generated.lisp 27 Oct 2003 01:35:34 -0000 1.45
--- generated.lisp 27 Oct 2003 16:40:01 -0000 1.46
***************
*** 133,138 ****
(when-bind (better-dtd (albert-setting '("albert" "docbook" "dtd")))
(setf (db-get-dtd) better-dtd))
- (print-header obj doc :document)
- (put doc "<book>" (eol))
(print-header obj doc :book)
(let* ((content (slot-value obj 'content))
--- 133,136 ----
***************
*** 159,195 ****
(when-verbose
(albert-info "spres> writing class-hierarchy to book."))
! (put doc "<refentry id=\"classHierarchy\">" (eol))
! (put doc
! "<refnamediv>"
! "<refname>"
! (get-word "Class Hierarchy" doc)
! "</refname>"
! "<refpurpose>Clickable index of all classes</refpurpose>"
! "</refnamediv>"
! (eol))
! (put doc "<refsect1><title></title>" (eol))
! (put doc "<programlisting>" (eol))
! (print-class-hierarchy doc ?class-hierarchy 0)
! (put doc "</programlisting>" (eol))
! (put doc "</refsect1>" (eol))
! (put doc "</refentry>" (eol)))
(when
(and indexable-stuff
(albert-setting
'("albert" "presentation" "index" "global-index")))
! (put doc "<refentry id=\"globalIndex\">" (eol))
! (put doc
! "<refnamediv>"
! "<refname>"
! (get-word "Global Index" doc)
! "</refname>"
! "<refpurpose>Clickable index of all symbols</refpurpose>"
! "</refnamediv>"
! (eol))
! (dolist (i content)
! (unless (is-empty? i) (present-object i doc :index)))
! (put doc "</refentry>" (eol)))
! (put doc "</reference>" (eol)))
! (put doc "</book>" (eol)))))
--- 157,209 ----
(when-verbose
(albert-info "spres> writing class-hierarchy to book."))
! (register-separate-document
! (make-file-info :id
! "class-hierarchy"
! :dir
! nil
! :fname
! (make-valid-entity "class-hierarchy")))
! (with-ok-document (doc "class-hierarchy" doc)
! (put doc "<refentry id=\"classHierarchy\">" (eol))
! (put doc
! "<refnamediv>"
! "<refname>"
! (get-word "Class Hierarchy" doc)
! "</refname>"
! "<refpurpose>Clickable index of all classes</refpurpose>"
! "</refnamediv>"
! (eol))
! (put doc "<refsect1><title></title>" (eol))
! (put doc "<programlisting>" (eol))
! (print-class-hierarchy doc ?class-hierarchy 0)
! (put doc "</programlisting>" (eol))
! (put doc "</refsect1>" (eol))
! (put doc "</refentry>" (eol))))
(when
(and indexable-stuff
(albert-setting
'("albert" "presentation" "index" "global-index")))
! (register-separate-document
! (make-file-info :id
! "global-index"
! :dir
! nil
! :fname
! (make-valid-entity "global-index")))
! (with-ok-document (doc "global-index" doc)
! (put doc "<refentry id=\"globalIndex\">" (eol))
! (put doc
! "<refnamediv>"
! "<refname>"
! (get-word "Global Index" doc)
! "</refname>"
! "<refpurpose>Clickable index of all symbols</refpurpose>"
! "</refnamediv>"
! (eol))
! (dolist (i content)
! (unless (is-empty? i)
! (present-object i doc :index)))
! (put doc "</refentry>" (eol))))
! (put doc "</reference>" (eol))))))
***************
*** 368,467 ****
(present-object i doc context))))
(when normal-objs
! (let* ((?rec-state :refsect1)
(?parent obj)
(obj-count (length normal-objs))
(var-objs 'nil))
! (when
! (>= var-count
! (albert-setting
! '("albert" "presentation" "variables" "separatepage")))
! (let ((vars 'nil) (others 'nil))
! (loop for
! i
! in
! normal-objs
! do
! (cond ((typep i 'sdoc-variable) (push i vars))
! ((typep i 'sdoc-method) (push i others))
! (t
! (when-verbose
! (albert-info
! "Non-method/var content ~s in package ~s"
! i
! cl-name))
! (push i others))))
! (setf var-objs (reverse vars) normal-objs (reverse others))))
! (cond
! ((has-spres-flag? :simple-package)
! (present-objs-in-package doc
! obj
! normal-objs
! :general
! :refsect1)
! (present-objs-in-package doc obj var-objs :vars :refsect1))
! (var-objs
! (put doc
! " <refentry id=\"packageX"
! (make-valid-entity cl-name)
! "Xvariables\">"
! (eol))
! (put doc
! "<refnamediv>"
! (eol)
! "<refname>"
! cl-name
! " variables</refname>"
! (eol)
! "<refpurpose>All variables and constants</refpurpose>"
! "</refnamediv>"
! (eol))
! (present-objs-in-package doc obj var-objs :vars :refsect1)
! (put doc " </refentry>" (eol))
! (put doc
! " <refentry id=\"packageX"
! (make-valid-entity cl-name)
! "Xcontent\">"
! (eol))
! (put doc
! "<refnamediv>"
! (eol)
! "<refname>"
! cl-name
! " full listing</refname>"
! (eol)
! "<refpurpose>"
! "All funcallable objects"
! "</refpurpose>"
! "</refnamediv>"
! (eol))
! (present-objs-in-package doc
! obj
! normal-objs
! :general
! :refsect1)
! (put doc " </refentry>" (eol)))
! (t
! (put doc
! " <refentry id=\"packageX"
! (make-valid-entity cl-name)
! "Xcontent\">"
! (eol))
! (put doc
! "<refnamediv>"
! (eol)
! "<refname>"
! cl-name
! " full listing</refname>"
! (eol)
! "<refpurpose>All funcallable objects and all variables</refpurpose>"
! "</refnamediv>"
! (eol))
! (present-objs-in-package doc
! obj
! normal-objs
! :general
! :refsect1)
! (present-objs-in-package doc obj var-objs :vars :refsect1)
! (put doc " </refentry>" (eol))))))
(when (has-spres-flag? :simple-package)
(put doc "</refentry>" (eol))
--- 382,511 ----
(present-object i doc context))))
(when normal-objs
! (let* ((cl-name (get-object-name obj))
! (file-id
! (strcat "package"
! +id-word-delim+
! "contentlist"
! +id-word-delim+
! (make-valid-entity cl-name)))
! (fname (strcat cl-name "/" "contentlist"))
! (?rec-state :refsect1)
(?parent obj)
(obj-count (length normal-objs))
(var-objs 'nil))
! (register-separate-document
! (make-file-info :id file-id :dir nil :fname fname))
! (with-ok-document (doc fname doc)
! (when
! (>= var-count
! (albert-setting
! '("albert" "presentation" "variables"
! "separatepage")))
! (let ((vars 'nil) (others 'nil))
! (loop for
! i
! in
! normal-objs
! do
! (cond
! ((typep i 'sdoc-variable)
! (push i vars))
! ((typep i 'sdoc-method)
! (push i others))
! (t
! (when-verbose
! (albert-info
! "Non-method/var content ~s in package ~s"
! i
! cl-name))
! (push i others))))
! (setf var-objs
! (reverse vars)
! normal-objs
! (reverse others))))
! (cond
! ((has-spres-flag? :simple-package)
! (present-objs-in-package doc
! obj
! normal-objs
! :general
! :refsect1)
! (present-objs-in-package doc
! obj
! var-objs
! :vars
! :refsect1))
! (var-objs
! (put doc
! " <refentry id=\"packageX"
! (make-valid-entity cl-name)
! "Xvariables\">"
! (eol))
! (put doc
! "<refnamediv>"
! (eol)
! "<refname>"
! cl-name
! " variables</refname>"
! (eol)
! "<refpurpose>All variables and constants</refpurpose>"
! "</refnamediv>"
! (eol))
! (present-objs-in-package doc
! obj
! var-objs
! :vars
! :refsect1)
! (put doc " </refentry>" (eol))
! (put doc
! " <refentry id=\"packageX"
! (make-valid-entity cl-name)
! "Xcontent\">"
! (eol))
! (put doc
! "<refnamediv>"
! (eol)
! "<refname>"
! cl-name
! " full listing</refname>"
! (eol)
! "<refpurpose>"
! "All funcallable objects"
! "</refpurpose>"
! "</refnamediv>"
! (eol))
! (present-objs-in-package doc
! obj
! normal-objs
! :general
! :refsect1)
! (put doc " </refentry>" (eol)))
! (t
! (put doc
! " <refentry id=\"packageX"
! (make-valid-entity cl-name)
! "Xcontent\">"
! (eol))
! (put doc
! "<refnamediv>"
! (eol)
! "<refname>"
! cl-name
! " full listing</refname>"
! (eol)
! "<refpurpose>All funcallable objects and all variables</refpurpose>"
! "</refnamediv>"
! (eol))
! (present-objs-in-package doc
! obj
! normal-objs
! :general
! :refsect1)
! (present-objs-in-package doc
! obj
! var-objs
! :vars
! :refsect1)
! (put doc " </refentry>" (eol)))))))
(when (has-spres-flag? :simple-package)
(put doc "</refentry>" (eol))
|
|
From: Stig E S. <st...@us...> - 2003-10-27 16:45:02
|
Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv30530/spres
Added Files:
files.lisp
Log Message:
added new file to handle all files-related stuff in spres
--- NEW FILE: files.lisp ---
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: spres-impl -*-
#|
DESC: spres/files.lisp - various presentation-functions related to files
Copyright (c) 2003 - Stig Erik Sandø
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
|#
(in-package :spres-impl)
(defun tl-find-out-dir (format)
"Returns a pathname for the out-dir."
;;Ugly imperative style.
;;(warn ">> Ensure out-dir for ~s -> ~s." format (tl-get-outdir-pref format))
;;(warn "Pref is ~s" (albert-setting '("system" "directory")))
(let ((sys-dir (albert-setting '("system" "directory")))
(pref-dir (tl-get-outdir-pref format)))
(when (albert-setting '("albert" "presentation" "to-current-dir"))
(setf sys-dir cl:*default-pathname-defaults*))
(cond ((pathnamep pref-dir) nil)
((stringp pref-dir)
(setf pref-dir (pathname (ensure-dir-name pref-dir))))
(t
(albert-warn "spres> settings dir for ~s is ~s, not string/pathname." format pref-dir)
(return-from tl-find-out-dir nil)))
(cond ((pathnamep sys-dir) nil)
((stringp sys-dir)
(setf sys-dir (ensure-dir-name (pathname sys-dir))))
(t (setf sys-dir cl:*default-pathname-defaults*)))
;;(warn "Returning ~s" (merge-pathnames pref-dir sys-dir))
(merge-pathnames pref-dir sys-dir)))
#||
(warn "Pref is ~s" (merge-pathnames (pathname (albert-setting '("system" "directory")))
(let ((out-dir (ensure-dir-name (tl-get-outdir-pref format))))
(pathname (ensure-dir-name out-dir))))
||#
(defun tl-get-outdir-pref (format)
"Returns the actual outdir-preference in the given output-preference.
Returns the actual pref and not a list. Returns NIL on failure."
(let ((retval nil))
(when format
(when (typep format 'spres-format)
(setf format (format.name format)))
(cond ((stringp format)
(when-bind (val (albert-setting (list "albert" format "output-dir")))
(cond ((stringp val)
(setf retval val))
(t
(warn "Don't know how to handle outdir value ~s for format ~s" val format)))))
(t
(warn "Unable to handle format to get outdir: ~s" format))))
(unless retval
(when-bind (val (albert-setting '("albert" "presentation" "output-dir")))
(cond ((stringp val)
(setf retval val))
(t
(warn "Don't know how to handle outdir value ~s" val)))))
(unless retval
(setf retval "dumps/"))
retval))
(defun permute-fname-and-add (f-obj table)
"permutes the fname with counter till it is addable
to the given table."
(let ((key (file-info-to-fname f-obj)))
(multiple-value-bind (obj found-p)
(gethash key table)
(declare (ignore obj))
(cond (found-p
(incf (file-info-counter f-obj))
(permute-fname-and-add f-obj table))
(t
(setf (gethash key table) f-obj))))))
(defun search-for-file-names (obj-list table)
"goes recursively through the object list and adds any
filenames to the table"
(dolist (x obj-list)
;; hackish
(let ((?outdir (if (typep x '(or sdoc-package sdoc-module))
(pathname (strcat (namestring ?outdir)
(get-object-name x) "/"))
?outdir)))
;; (when (typep x 'sdoc-package)
;; (warn "dir is ~a" ?outdir)
;; )
(unless (is-empty? x)
(when (should-have-individual-file-p x nil)
(let ((wanted-file (get-suggested-file-name x nil)))
(when wanted-file
(let ((key (file-info-to-fname wanted-file)))
(multiple-value-bind (obj found-p)
(gethash key table)
(declare (ignore obj))
(cond (found-p
(permute-fname-and-add wanted-file table))
(t
(setf (gethash key table) wanted-file))))))))
(when (typep x '(or sdoc-package sdoc-module sdoc-class))
(calculate-file-list x table))))))
(defmethod calculate-file-list ((object sdoc-toplevel) table)
(unless table
(setq table (make-hash-table :test #'equal)))
(let ((?outdir ""))
(search-for-file-names (sdoc-toplevel.content object) table))
(let ((ret-table (make-hash-table :test #'equal)))
(loop for v being the hash-values of table
do
(setf (gethash (file-info-id v) ret-table) v))
ret-table))
(defun register-separate-document (fileinfo)
"Registers the file-info object so that it will be counted."
(cond ((typep fileinfo 'file-info)
(setf (gethash (file-info-id fileinfo) ?file-table) fileinfo)
fileinfo)
(t
(albert-warn "spres> cannot register file-entity: ~s" fileinfo)
nil)))
(def-or-method calculate-file-list ((object (or sdoc-package sdoc-class sdoc-module)) table)
(let ((content-list (slot-value object 'content)))
(search-for-file-names content-list table)
#||
(when (typep object 'sdoc-package)
(when (find-if #'(lambda (x) (typep x 'sdoc-class)) content-list)
(let ((id (strcat "package_" (get-object-name object) "_classlist")))
(setf (gethash id table) (make-file-info :id id
:dir ?outdir
:fname (make-valid-entity id)
:counter 0))))
(when (find-if #'is-generic-fun? content-list)
(let ((id (strcat "package_" (get-object-name object) "_genfunlist")))
(setf (gethash id table) (make-file-info :id id
:dir ?outdir
:fname (make-valid-entity id)
:counter 0)))))
||#
))
(defmethod get-suggested-file-name ((object sdoc-package) context)
(declare (ignore context))
(make-file-info :id (get-object-id object)
:dir ?outdir
:fname "_package"
:counter 0))
(defmethod get-suggested-file-name ((object sdoc-module) context)
(declare (ignore context))
(make-file-info :id (get-object-id object)
:dir ?outdir
:fname "_module"
:counter 0))
(defmethod get-suggested-file-name ((object sdoc-class) context)
(declare (ignore context))
(make-file-info :id (get-object-id object)
:dir ?outdir
:fname (make-valid-entity (get-object-name object))
:counter 0))
(defmethod get-suggested-file-name ((object sdoc-method) context)
(declare (ignore context))
(make-file-info :id (get-object-id object)
:dir ?outdir
:fname (make-valid-entity (get-object-name object))
:counter 0))
(defun file-info-to-fname (f-obj)
"Translates the file-info obj into a filename string"
(let ((fname (file-info-fname f-obj))
(counter (file-info-counter f-obj))
(dir (file-info-dir f-obj)))
(unless (non-negative-integer? counter)
(setf counter 0))
(when (> counter 0)
(setf fname (format nil "~a-~a" fname counter)))
(cond ((pathnamep dir)
(setf dir (namestring dir)))
((eq dir nil)
(setf dir ""))
((stringp dir) nil)
(t
(albert-warn "spres> directory ~s for filename ~s is odd, ignored." dir fname)
(setf dir "")))
(strcat dir fname)))
(defun tl-ensure-file-dirs (file-table base-dir)
"given a file-table and a pathname base-dir. Calls
sds-global:make-sure-dirs-exist."
;; ensure directories in place
(let ((done-dirs nil))
(loop for val being the hash-values of file-table
for dir = (file-info-dir val)
do
(unless (find dir done-dirs :test #'equal)
;; (warn "Merging ~s and ~s -> ~s,~s" ?outdir dir
;; (merge-pathnames dir ?outdir)
;; (merge-pathnames ?outdir dir)
;; )
(make-sure-dirs-exist
(tl-merge-two-paths dir base-dir))
(push dir done-dirs)))))
(defun include-file-entity (f-obj)
"Returns a string which is a legal file-inclusion
in xml for the given f-obj"
(if (stringp f-obj)
(strcat "&file" +id-word-delim+ (make-valid-entity f-obj) ";")
(strcat "&file" +id-word-delim+ (make-valid-entity (file-info-to-fname f-obj)) ";")))
(def-or-method should-have-individual-file-p ((object (or sdoc-package
sdoc-class
sdoc-module)) context)
;; to avoid silly warning.. any compiler should wipe it
(when (and nil object context))
t)
(defmethod should-have-individual-file-p ((object sdoc-method) context)
(when (is-generic-fun? object)
(when (>= (length (sdoc-method.content object))
(setting-or-default '("albert" "presentation" "gf" "separatepage") 2))
;;(warn "File for ~s" object)
t)))
(defun tl-make-new-obj-document (obj &optional old-doc)
"presents an independent file.."
(let ((f-obj (gethash (get-object-id obj) ?file-table)))
;;(warn "Filename ~a -> [~a] ~a" f-obj ?outdir (file-info-to-fname f-obj))
;; insert into the old-document an insert
(when old-doc
(put old-doc (include-file-entity f-obj) (eol)))
;; here is a directory-making bug
(make-document ?outdir
(file-info-to-fname f-obj)
?format
?language)))
(defun tl-make-new-document (filename old-doc)
(when old-doc
(put old-doc (include-file-entity filename) (eol)))
(make-document ?outdir
(if (stringp filename)
(make-valid-entity filename :allow '(#\/))
(file-info-to-fname filename))
?format
?language))
(defun tl-get-ok-obj-document (obj old-doc)
"Returns a new document if the OBJ requires an
idividual file, otherwise returns the given document."
;; (warn "Getting document from ~a ~a -> ~a" obj old-doc
;; (should-have-individual-file-p obj nil))
(if (should-have-individual-file-p obj nil)
(tl-make-new-obj-document obj old-doc)
old-doc))
(defun tl-possible-close-document (obj doc)
"If the object OBJ requires it's own file, close this file,
assuming it was opened by WITH-OK-DOCUMENT and therefore is
safe. The closed document is also presented."
(when (should-have-individual-file-p obj nil)
;; (warn "closing/presenting ~a document ~a" obj doc)
(present-document doc)))
(defmacro with-ok-obj-document (the-info &body the-body)
"Makes a subdocument I think and encloses creation of the document
for the given object and closing of the document."
(unless (and (consp the-info) (= 3 (length the-info)))
(error "WITH-OK-DOCUMENT 1st argument should be (DOC-VAR OBJ OLD-DOC)"))
(let ((gs (gensym))
(old-doc (third the-info))
(the-obj (second the-info))
(doc-name (first the-info)))
`(let ((,gs ,old-doc))
(unwind-protect
(let ((,doc-name (tl-get-ok-obj-document ,the-obj ,old-doc)))
(unwind-protect
,@the-body
(tl-possible-close-document ,the-obj ,doc-name)))
(setf ,old-doc ,gs)))
))
(defmacro with-ok-document (the-info &body the-body)
"Makes a document and presents it I think, it's not connected to a specific obj."
;; (unless (and (consp the-info) (= 3 (length the-info)))
;; (error "WITH-OK-DOCUMENT 1st argument should be (DOC-VAR OBJ OLD-DOC)"))
(let ((gs (gensym))
(old-doc (third the-info))
(fname (second the-info))
(doc-name (first the-info))
)
`(let ((,gs ,old-doc))
(unwind-protect
(let ((,doc-name (tl-make-new-document ,fname ,old-doc)))
(unwind-protect
,@the-body
(present-document ,doc-name)))
(setf ,old-doc ,gs)))
))
|
|
From: Stig E S. <st...@us...> - 2003-10-27 16:45:01
|
Update of /cvsroot/albert/albert
In directory sc8-pr-cvs1:/tmp/cvs-serv30530
Modified Files:
albert.asd albert.system
Log Message:
added new file to handle all files-related stuff in spres
Index: albert.asd
===================================================================
RCS file: /cvsroot/albert/albert/albert.asd,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** albert.asd 27 Oct 2003 01:10:39 -0000 1.9
--- albert.asd 27 Oct 2003 16:39:25 -0000 1.10
***************
*** 139,146 ****
(:file "base" :depends-on ("vars"))
(:file "tools" :depends-on ("vars" "base"))
(:file "hyperspec" :depends-on ("vars"))
(:file "hier" :depends-on ("base"))
(:file "lang" :depends-on ("hier"))
! (:file "object" :depends-on ("tools" "lang" "hyperspec")))
:depends-on (sdoc))
--- 139,147 ----
(:file "base" :depends-on ("vars"))
(:file "tools" :depends-on ("vars" "base"))
+ (:file "files" :depends-on ("vars" "base"))
(:file "hyperspec" :depends-on ("vars"))
(:file "hier" :depends-on ("base"))
(:file "lang" :depends-on ("hier"))
! (:file "object" :depends-on ("lang" "files" "tools" "hyperspec")))
:depends-on (sdoc))
Index: albert.system
===================================================================
RCS file: /cvsroot/albert/albert/albert.system,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** albert.system 19 Oct 2003 23:27:37 -0000 1.3
--- albert.system 27 Oct 2003 16:39:25 -0000 1.4
***************
*** 128,135 ****
(:file "base" :depends-on ("vars"))
(:file "tools" :depends-on ("vars" "base"))
(:file "hyperspec" :depends-on ("vars"))
(:file "hier" :depends-on ("base"))
(:file "lang" :depends-on ("hier"))
! (:file "object" :depends-on ("tools" "lang" "hyperspec")))
:depends-on (sdoc))
--- 128,136 ----
(:file "base" :depends-on ("vars"))
(:file "tools" :depends-on ("vars" "base"))
+ (:file "files" :depends-on ("vars" "base"))
(:file "hyperspec" :depends-on ("vars"))
(:file "hier" :depends-on ("base"))
(:file "lang" :depends-on ("hier"))
! (:file "object" :depends-on ("lang" "files" "tools" "hyperspec")))
:depends-on (sdoc))
|
