]> git.donarmstrong.com Git - lilypond.git/blob - scm/document-context-mods.scm
Run grand-replace (issue 3765)
[lilypond.git] / scm / document-context-mods.scm
1 ;;;; This file is part of LilyPond, the GNU music typesetter.
2 ;;;;
3 ;;;; Copyright (C) 2011--2014 Neil Puttock <n.puttock@gmail.com>
4 ;;;;
5 ;;;; LilyPond is free software: you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation, either version 3 of the License, or
8 ;;;; (at your option) any later version.
9 ;;;;
10 ;;;; LilyPond is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 ;;;; GNU General Public License for more details.
14 ;;;;
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
17
18 (use-modules (ice-9 format))
19
20 (define (grob-property-path path)
21   (string-join (map symbol->string path) " "))
22
23 (define (document-mod-list op)
24   (let ((tag (car op))
25         (name-sym (cadr op))
26         (args (cddr op)))
27     (case tag
28       ((push)
29        (let ((value (car args))
30              (path (cdr args)))
31          (string-append
32           "@item Sets "
33           (format "grob property @code{~a} "
34                   (grob-property-path path))
35           (format "in @code{@rinternals{~a}} to ~a."
36                   name-sym
37                   (scm->texi value))
38           "\n")))
39       ((pop)
40        (string-append
41         "@item Reverts "
42         (format "grob property @code{~a} "
43                 (grob-property-path (car args)))
44         (format "in @code{@rinternals{~a}}."
45                 name-sym)
46         "\n"))
47       ((assign)
48        (format "@item Sets translator property @code{~a} to ~a.\n"
49                name-sym
50                (scm->texi (car args))))
51       ((unset)
52        (format "@item Unsets translator property @code{~a}.\n"
53                name-sym))
54       ((consists)
55        (format "@item Adds @code{@rinternals{~a}}.\n" name-sym))
56       ((remove)
57        (format "@item Removes @code{@rinternals{~a}}.\n" name-sym))
58       (else ""))))
59
60 (define (document-context-mod context-mod-pair)
61   (let* ((name-sym (car context-mod-pair))
62          (mod-list (ly:get-context-mods (cdr context-mod-pair)))
63          (docstring (filter (lambda (mod)
64                               (eq? (car mod) 'description))
65                             mod-list)))
66     (format
67      "@item @code{~a}
68 @findex ~a
69 ~a
70 @itemize
71 ~{~a ~}
72 @end itemize
73 "
74      name-sym
75      name-sym
76      (if (pair? docstring)
77          (cadar docstring)
78          (begin
79            (ly:warning "context modification `~a' not documented." name-sym)
80            "(undocumented; fixme)"))
81      (map document-mod-list mod-list))))
82
83 (define (document-mod obj-pair)
84   (and (ly:context-mod? (cdr obj-pair))
85        (document-context-mod obj-pair)))
86
87 (define context-mods-doc-string
88   (format
89    "@table @asis
90 ~a
91 @end table
92 "
93    (string-join
94     (filter-map
95      document-mod
96      (sort
97       (ly:module->alist (current-module))
98       identifier<?)))
99    ""))