scm/document-context-mods.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2011--2015 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           (format #f "@item Sets grob property @code{~a} "
  33                   (grob-property-path path))
  34           (format #f "in @code{@rinternals{~a}} to" name-sym)
  35           (if (pretty-printable? value)
  36             (format #f ":~a\n" (scm->texi value))
  37             (format #f " ~a.\n" (scm->texi value))))))
  38       ((pop)
  39        (string-append
  40         (format #f "@item Reverts grob property @code{~a} "
  41                 (grob-property-path (car args)))
  42         (format #f "in @code{@rinternals{~a}}.\n"
  43                 name-sym)))
  44       ((assign)
  45        (string-append
  46          (format #f "@item Sets translator property @code{~a} to" name-sym)
  47          (if (pretty-printable? value)
  48            (format #f ":~a\n" (scm->texi (car args)))
  49            (format #f " ~a.\n" (scm->texi (car args))))))
  50       ((unset)
  51        (format #f "@item Unsets translator property @code{~a}.\n"
  52                name-sym))
  53       ((consists)
  54        (format #f "@item Adds @code{@rinternals{~a}}.\n" name-sym))
  55       ((remove)
  56        (format #f "@item Removes @code{@rinternals{~a}}.\n" name-sym))
  57       (else ""))))
  58
  59 (define (document-context-mod context-mod-pair)
  60   (let* ((name-sym (car context-mod-pair))
  61          (mod-list (ly:get-context-mods (cdr context-mod-pair)))
  62          (docstring (filter (lambda (mod)
  63                               (eq? (car mod) 'description))
  64                             mod-list)))
  65     (format #f
  66      "@item @code{~a}
  67 @findex ~a
  68 ~a
  69 @itemize
  70 ~{~a ~}
  71 @end itemize
  72 "
  73      name-sym
  74      name-sym
  75      (if (pair? docstring)
  76          (cadar docstring)
  77          (begin
  78            (ly:warning "context modification `~a' not documented." name-sym)
  79            "(undocumented; fixme)"))
  80      (map document-mod-list mod-list))))
  81
  82 (define (document-mod obj-pair)
  83   (and (ly:context-mod? (cdr obj-pair))
  84        (document-context-mod obj-pair)))
  85
  86 (define context-mods-doc-string
  87   (format #f
  88    "@table @asis
  89 ~a
  90 @end table
  91 "
  92    (string-join
  93     (filter-map
  94      document-mod
  95      (sort
  96       (ly:module->alist (current-module))
  97       identifier<?)))
  98    ""))