X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdocumentation-lib.scm;h=4a25f5420c633a9320d6c4d53dd8e67efe13dac5;hb=e9d68c099f03166dbd3c82f753b314a25ddc40cf;hp=8dc5edc5cabf2bb6836c7a298fd2fa3ae75ce69c;hpb=f23a0d9dcda87d3f6f072fba3addeae941cce4aa;p=lilypond.git

diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm
index 8dc5edc5ca..4a25f5420c 100644
--- a/scm/documentation-lib.scm
+++ b/scm/documentation-lib.scm
@@ -1,52 +1,52 @@
-;;;
-;;; documentation-lib.scm -- Assorted Functions for generated documentation
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;; 
-;;; (c)  2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-;;; Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+;;;; documentation-lib.scm -- Assorted Functions for generated documentation
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;; 
+;;;; (c) 2000--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
 
 (use-modules (oop goops)
 	     (srfi srfi-13)
-	     (srfi srfi-1)
-	     )
+	     (srfi srfi-1))
 
 (define-class <texi-node> ()
+  (appendix #:init-value #f #:accessor appendix? #:init-keyword #:appendix)
   (children #:init-value '() #:accessor node-children #:init-keyword #:children)
   (text #:init-value "" #:accessor node-text #:init-keyword #:text)
   (name #:init-value "" #:accessor node-name #:init-keyword #:name)
-  (description #:init-value "" #:accessor node-desc #:init-keyword #:desc)
-  )
+  (description #:init-value "" #:accessor node-desc #:init-keyword #:desc))
 
 (define (menu-entry x)
   (cons
    (node-name x)
-   (node-desc x))
-  )
+   (node-desc x)))
 
-(define (dump-node node port level)
+(define* (dump-node node port level)
   (display
    (string-append
     "\n@node "
     (node-name node)
     "\n\n"
-    (texi-section-command level) " "
+    (if (appendix? node)
+        (texi-appendix-section-command level)
+        (texi-section-command level))
+    " "
     (node-name node)
     "\n\n"
     (node-text node)
     "\n\n"
     (if (pair? (node-children node))
 	(texi-menu
-	 (map (lambda (x) (menu-entry x) )
+	 (map (lambda (x) (menu-entry x))
 	      (node-children node)))
-	 ""))
+	""))
    port)
   (map (lambda (x) (dump-node x port (+ 1 level)))
-        (node-children node))
-  )
+       (node-children node)))
 
 (define (processing name)
-  (display (string-append "\nProcessing " name " ... ") (current-error-port)))
+  (ly:message (_ "Processing ~S...") name))
 
 (define (self-evaluating? x)
   (or (number? x) (string? x) (procedure? x) (boolean? x)))
@@ -55,97 +55,84 @@
   x)
 
 (define (scm->texi x)
-  (string-append "@code{" (texify (scm->string x)) "}")
-  )
+  (string-append "@code{" (texify (scm->string x)) "}"))
 
 
-;;
-;; don't confuse users with #<procedure .. > syntax. 
-;; 
-(define (scm->string val)
-  (if (and (procedure? val) (symbol? (procedure-name val)))
-      (symbol->string (procedure-name val))
-      (string-append
-       (if (self-evaluating? val) "" "'")
-       (call-with-output-string (lambda (port) (display val port)))
-       )))
-
 
 (define (texi-section-command level)
   (cdr (assoc level '(
-    ;; Hmm, texinfo doesn't have ``part''
-    (0 . "@top")
-    (1 . "@unnumbered")
-    (2 . "@unnumberedsec")
-    (3 . "@unnumberedsubsec")
-    (4 . "@unnumberedsubsubsec")
-    (5 . "@unnumberedsubsubsec")
-    ))))
+		      ;; Hmm, texinfo doesn't have ``part''
+		      (0 . "@top")
+		      (1 . "@chapter")
+		      (2 . "@section")
+		      (3 . "@subsection")
+		      (4 . "@unnumberedsubsubsec")
+		      (5 . "@unnumberedsubsubsec")))))
+
+(define (texi-appendix-section-command level)
+  (cdr (assoc level '((0 . "@top")
+		      (1 . "@appendix")
+		      (2 . "@appendixsec")
+		      (3 . "@appendixsubsec")
+		      (4 . "@appendixsubsubsec")
+		      (5 . "@appendixsubsubsec")))))
 
 (define (one-item->texi label-desc-pair)
-  "Document one (LABEL . DESC); return empty string if LABEL is empty string. 
-"
+  "Document one (LABEL . DESC); return empty string if LABEL is empty string."
   (if (eq? (car label-desc-pair) "")
       ""
-      (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))
-  ))
+      (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))))
 
 
-(define (description-list->texi items-alist)
-  "Document ITEMS-ALIST in a table. entries contain (item-label
-. string-to-use)
-"
+(define (description-list->texi items-alist quote?)
+  "Document ITEMS-ALIST in a table; entries contain (item-label .
+string-to-use).  If QUOTE? is #t, embed table in a @quotation environment."
   (string-append
-   "\n@table @asis\n"
+   "\n"
+   (if quote? "@quotation\n" "")
+   "@table @asis\n"
    (apply string-append (map one-item->texi items-alist))
-   "\n@end table\n"))
+   "\n"
+   "@end table\n"
+   (if quote? "@end quotation\n" "")))
 
 (define (texi-menu items-alist)
   "Generate what is between @menu and @end menu."
-  (let
-      (
-       (maxwid (apply max (map (lambda (x) (string-length (car x)))
-			       items-alist)))
-       )
+  (let ((maxwid
+	 (apply max (map (lambda (x) (string-length (car x))) items-alist))))
     
-
-    
-  (string-append
-  "\n@menu"
-  (apply string-append
-	 (map (lambda (x)
-		(string-append
-		(string-pad-right 
-		 (string-append "\n* " (car x) ":: ")
-		 (+ maxwid 8)
-		 )
-		(cdr x))
-		)
-	      items-alist))
-  "\n@end menu\n"
-  ;; Menus don't appear in html, so we make a list ourselves
-  "\n@ignore\n"
-  "\n@ifhtml\n"
-  (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
-			 items-alist))
-  "\n@end ifhtml\n"
-  "\n@end ignore\n")))
-
-  
-
+    (string-append
+     "\n@menu"
+     (apply string-append
+	    (map (lambda (x)
+		   (string-append
+		    (string-pad-right 
+		     (string-append "\n* " (car x) ":: ")
+		     (+ maxwid 8))
+		    (cdr x)))
+		 items-alist))
+     "\n@end menu\n"
+     ;; Menus don't appear in html, so we make a list ourselves
+     "\n@ignore\n"
+     "\n@ifhtml\n"
+     (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
+				  items-alist)
+			     #t)
+     "\n@end ifhtml\n"
+     "\n@end ignore\n")))
 
 (define (texi-file-head name file-name top)
   (string-append
    "\\input texinfo @c -*-texinfo-*-"
    "\n@setfilename " file-name ".info"
    "\n@settitle " name
-   "\n@dircategory GNU music project"
+   "\n@dircategory LilyPond"
    "\n@direntry"
    ;; prepend GNU for dir, must be unique
    "\n* GNU " name ": (" file-name ").          " name "."
-   "\n@end direntry"
-   ))
-
+   "\n@end direntry\n"
+   "@documentlanguage en\n"
+   "@documentencoding utf-8\n"))
 
 (define (context-name name)
   name)
@@ -165,66 +152,48 @@
   "Add ref to X"
   (string-append "@ref{" x "}"))
 
-(define (human-listify l)
-  "Produce a textual enumeration from L, a list of strings"
+(define (human-listify lst)
+  "Produce a textual enumeration from LST, a list of strings"
   
   (cond
-   ((null? l) "none")
-   ((null? (cdr l)) (car l))
-   ((null? (cddr l)) (string-append (car l) " and " (cadr l)))
-   (else (string-append (car l) ", " (human-listify (cdr l))))
-   ))
+   ((null? lst) "none")
+   ((null? (cdr lst)) (car lst))
+   ((null? (cddr lst)) (string-append (car lst) " and " (cadr lst)))
+   (else (string-append (car lst) ", " (human-listify (cdr lst))))))
 
 (define (writing-wip x)
-  (display (string-append "\nWriting " x " ... ") (current-error-port)))
+  (ly:message (_ "Writing ~S...") x))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; property  stuff.
 
-(define (property->texi where sym)
-  "Document SYM for WHERE (which can be translation, backend, music)"
+(define (property->texi where sym . rest)
+  "Document SYM for WHERE (which can be translation, backend, music),
+with init values from ALIST (1st optional argument)
+"
   (let* ((name (symbol->string sym))
+	 (alist (if (pair? rest) (car rest) '()))
 	 (type?-name (string->symbol
 		      (string-append (symbol->string where) "-type?")))
 	 (doc-name (string->symbol		    
 		    (string-append (symbol->string where) "-doc")))
 	 (type (object-property sym type?-name))
 	 (typename (type-name type))
-	 (desc (object-property sym doc-name)))
+	 (desc (object-property sym doc-name))
+	 (handle (assoc sym alist)))
 
     (if (eq? desc #f)
-	(error "No description for property ~S" sym))
-	
+	(ly:error (_ "cannot find description for property ~S (~S)") sym where))
+    
     (cons
      (string-append "@code{" name "} "
-		    "(" typename ")")
-     desc)
-     
-    ))
-
-(define (document-property-value sym alist)
-  "Extract value for SYM from ALIST, return as texi string"
-  (let* ((handle (assoc sym alist)))
-    (if (eq? handle #f)
-	"(unset)"
-	(scm->texi (cdr handle)))))
-
-(define (backend-property->texi sym)
-  (property->texi 'backend sym))
-
-(define (document-property sym where alist)
-  "Document SYM. If GROB-DESCRIPTION is not #f, it's an alist
-containing default values."
-  (let*
-      ((without (property->texi where sym))
-       (rv
-
-	(cons (car without)
-	      (if (eq? alist #f)
-		  (cdr without)
-		  (string-append
-		   (cdr without)
-		   "\nDefault value: "
-		   (document-property-value sym alist))))))
-    rv))
+		    "(" typename ")"
+		    (if handle
+			(string-append
+			 ":\n\n"
+			 (scm->texi (cdr handle))
+			 "\n\n")
+			""))
+     desc)))
+