albert-cvs Mailing List for Albert
Status: Alpha
Brought to you by:
stig
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)) |