X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdocumentation-lib.scm;h=ede9e2256232838d24b547e1aba29dec21bccdf7;hb=0b544cfb7332615ef809b71b57ab656741311ae1;hp=0c9e2bdec6a1a5bbe2491e14b645ae29ba1c4f65;hpb=407be6aca707178dc8dcae673803b16916f59d50;p=lilypond.git diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm index 0c9e2bdec6..ede9e22562 100644 --- a/scm/documentation-lib.scm +++ b/scm/documentation-lib.scm @@ -1,16 +1,27 @@ +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; documentation-lib.scm -- Assorted Functions for generated documentation -;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2000--2007 Han-Wen Nienhuys +;;;; Copyright (C) 2000--2014 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen +;;;; +;;;; LilyPond 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 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . (use-modules (oop goops) - (srfi srfi-13) - (srfi srfi-1)) + (srfi srfi-13) + (srfi srfi-1)) (define-class () + (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) @@ -21,13 +32,13 @@ (node-name x) (node-desc x))) -(define* (dump-node node port level #:optional (appendix #f)) +(define* (dump-node node port level) (display (string-append "\n@node " - (node-name node) - "\n\n" - (if appendix + (if (= level 0) "Top" (node-name node)) + "\n" + (if (appendix? node) (texi-appendix-section-command level) (texi-section-command level)) " " @@ -36,16 +47,16 @@ (node-text node) "\n\n" (if (pair? (node-children node)) - (texi-menu - (map (lambda (x) (menu-entry x)) - (node-children node))) - "")) + (texi-menu + (map (lambda (x) (menu-entry x)) + (node-children node))) + "")) port) - (map (lambda (x) (dump-node x port (+ 1 level) appendix)) - (node-children node))) + (for-each (lambda (x) (dump-node x port (+ 1 level))) + (node-children node))) (define (processing name) - (ly:message (_ "Processing ~S...") name)) + (ly:basic-progress (_ "Processing ~S...") name)) (define (self-evaluating? x) (or (number? x) (string? x) (procedure? x) (boolean? x))) @@ -59,22 +70,22 @@ (define (texi-section-command level) - (cdr (assoc level '( - ;; Hmm, texinfo doesn't have ``part'' - (0 . "@top") - (1 . "@chapter") - (2 . "@section") - (3 . "@subsection") - (4 . "@unnumberedsubsubsec") - (5 . "@unnumberedsubsubsec"))))) + (assoc-get level '( + ;; 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"))))) + (assoc-get 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." @@ -90,7 +101,7 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment." "\n" (if quote? "@quotation\n" "") "@table @asis\n" - (apply string-append (map one-item->texi items-alist)) + (string-concatenate (map one-item->texi items-alist)) "\n" "@end table\n" (if quote? "@end quotation\n" ""))) @@ -98,25 +109,25 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment." (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)))) - + (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)) + (string-concatenate + (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) + items-alist) + #t) "\n@end ifhtml\n" "\n@end ignore\n"))) @@ -148,12 +159,13 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment." name) (define (ref-ify x) - "Add ref to X" + "Return @ref{X}. If mapping ref-ify to a list that needs to be sorted, + sort the list first." (string-append "@ref{" x "}")) (define (human-listify lst) "Produce a textual enumeration from LST, a list of strings" - + (cond ((null? lst) "none") ((null? (cdr lst)) (car lst)) @@ -163,36 +175,46 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment." (define (writing-wip x) (ly:message (_ "Writing ~S...") x)) +(define (identifierstring (car a)) + (symbol->string (car b)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; property stuff. +(define (verify-type-name where sym type) + (if (eq? type #f) + (ly:error (_ "cannot find description for property `~S' (~S)") + sym + where)) + (type-name type)) + (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)) - (handle (assoc sym alist))) + (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 (verify-type-name where sym type)) + (desc (object-property sym doc-name)) + (init-value (assoc-get sym alist))) (if (eq? desc #f) - (ly:error (_ "cannot find description for property ~S (~S)") sym where)) - + (ly:error (_ "cannot find description for property ~S (~S)") sym where)) + (cons (string-append "@code{" name "} " - "(" typename ")" - (if handle - (string-append - ":\n\n" - (scm->texi (cdr handle)) - "\n\n") - "")) + "(" typename ")" + (if init-value + (string-append + ":\n\n" + (scm->texi init-value) + "\n\n") + "")) desc))) -