X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdocumentation-lib.scm;h=5a0afbbf34c51d5d4cbf2aef69570db4a190a008;hb=87eedcd59f4082cb0841528ad5bc82cb1d1191e3;hp=4f7a0f05948dacb9c3c067230f0809eb46c7cda2;hpb=a23264aee8cab5acaa94cdc103f2497c3f042543;p=lilypond.git diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm index 4f7a0f0594..5a0afbbf34 100644 --- a/scm/documentation-lib.scm +++ b/scm/documentation-lib.scm @@ -3,26 +3,23 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2000--2004 Han-Wen Nienhuys +;;;; (c) 2000--2006 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen (use-modules (oop goops) (srfi srfi-13) - (srfi srfi-1) - ) + (srfi srfi-1)) (define-class () (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) (display @@ -37,16 +34,15 @@ "\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,40 +51,26 @@ x) (define (scm->texi x) - (string-append "@code{" (texify (scm->string x)) "}") - ) + (string-append "@code{" (texify (scm->string x)) "}")) -;; -;; don't confuse users with # 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 . "@unnumbered") + (2 . "@unnumberedsec") + (3 . "@unnumberedsubsec") + (4 . "@unnumberedsubsubsec") + (5 . "@unnumberedsubsubsec"))))) (define (one-item->texi label-desc-pair) "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) @@ -102,53 +84,40 @@ (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)) + "\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 ISO-8859-1\n" - - )) - + "@documentencoding utf-8\n")) (define (context-name name) name) @@ -168,18 +137,17 @@ "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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -198,12 +166,11 @@ with init values from ALIST (1st optional argument) (type (object-property sym type?-name)) (typename (type-name type)) (desc (object-property sym doc-name)) - (handle (assoc sym alist)) - ) + (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 ")" @@ -212,11 +179,6 @@ with init values from ALIST (1st optional argument) ":\n\n" (scm->texi (cdr handle)) "\n\n") - "") - - - ) - desc) - - )) + "")) + desc)))