X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmarkup-macros.scm;h=6c50ec51280e614796229fd565401b9474d16d07;hb=750b714488c5af6eae22d07163bba8b554734ac6;hp=a3d3a9d92739e9d26bec448301c52325364f9b22;hpb=c7d8081aeedd9d35cc2131c2e2a4ad34e9265245;p=lilypond.git

diff --git a/scm/markup-macros.scm b/scm/markup-macros.scm
index a3d3a9d927..6c50ec5128 100644
--- a/scm/markup-macros.scm
+++ b/scm/markup-macros.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2003--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -110,14 +110,14 @@ command.  There is no protection against circular definitions.
            (set! body (cddr body)))
     `(begin
        ;; define the COMMAND-markup function
-       ,(let* ((documentation (if (string? (car body))
-                                  (list (car body))
-                                  '()))
-               (real-body (if (or (null? documentation)
+       ,(let* ((documentation
+                (format #f "~a\n~a" (cddr args)
+                        (if (string? (car body)) (car body) "")))
+               (real-body (if (or (not (string? (car body)))
                                   (null? (cdr body)))
                               body (cdr body))))
           `(define-public (,command-name ,@args)
-             ,@documentation
+             ,documentation
              (let ,(map (lambda (prop-spec)
                           (let ((prop (car prop-spec))
                                 (default-value (if (null? (cdr prop-spec))
@@ -147,7 +147,7 @@ command.  There is no protection against circular definitions.
                                         ((not (null? (cdr prop-spec)))
                                          `(list ',(car prop-spec) ,(cadr prop-spec)))
                                         (else
-                                          `(list ',(car prop-spec)))))
+                                         `(list ',(car prop-spec)))))
                                 (if (pair? args)
                                     properties
                                     (list)))))
@@ -168,14 +168,14 @@ interpreted, returns a list of stencils instead of a single one"
            (set! body (cddr body)))
     `(begin
        ;; define the COMMAND-markup-list function
-       ,(let* ((documentation (if (string? (car body))
-                                  (list (car body))
-                                  '()))
-               (real-body (if (or (null? documentation)
+       ,(let* ((documentation
+                (format #f "~a\n~a" (cddr args)
+                        (if (string? (car body)) (car body) "")))
+               (real-body (if (or (not (string? (car body)))
                                   (null? (cdr body)))
                               body (cdr body))))
           `(define-public (,command-name ,@args)
-             ,@documentation
+             ,documentation
              (let ,(map (lambda (prop-spec)
                           (let ((prop (car prop-spec))
                                 (default-value (if (null? (cdr prop-spec))
@@ -197,7 +197,7 @@ interpreted, returns a list of stencils instead of a single one"
                                         ((not (null? (cdr prop-spec)))
                                          `(list ',(car prop-spec) ,(cadr prop-spec)))
                                         (else
-                                          `(list ',(car prop-spec)))))
+                                         `(list ',(car prop-spec)))))
                                 (if (pair? args)
                                     properties
                                     (list)))))
@@ -236,11 +236,11 @@ interpreted, returns a list of stencils instead of a single one"
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;; markup type predicates
 
-(define (markup-function? x)
+(define-public (markup-function? x)
   (and (markup-command-signature x)
        (not (object-property x 'markup-list-command))))
 
-(define (markup-list-function? x)
+(define-public (markup-list-function? x)
   (and (markup-command-signature x)
        (object-property x 'markup-list-command)))
 
@@ -384,10 +384,10 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
                       (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
                       (set! rest (cdr rest)))
                      (else
-                       ;; pick up one arg in `rest'
-                       (receive (a r) (compile-markup-arg rest)
-                                (set! args (cons a args))
-                                (set! rest r))))))))
+                      ;; pick up one arg in `rest'
+                      (receive (a r) (compile-markup-arg rest)
+                               (set! args (cons a args))
+                               (set! rest r))))))))
         ((and (pair? expr)
               (pair? (car expr))
               (keyword? (caar expr)))
@@ -398,9 +398,9 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
               (string? (car expr))) ;; expr === ("string" ...)
          (values `(make-simple-markup ,(car expr)) (cdr expr)))
         (else
-          ;; expr === (symbol ...) or ((funcall ...) ...)
-          (values (car expr)
-                  (cdr expr)))))
+         ;; expr === (symbol ...) or ((funcall ...) ...)
+         (values (car expr)
+                 (cdr expr)))))
 
 (define (compile-all-markup-args expr)
   "Transform `expr' into markup arguments"
@@ -454,20 +454,3 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
                (string->symbol (format #f "~a-markup-list" code)))))
     (and proc (markup-list-function? proc)
          (cons proc (markup-command-signature proc)))))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;;; used in parser.yy to map a list of markup commands on markup arguments
-(define-public (map-markup-command-list commands markups)
-  "`markups' being a list of markups, eg (markup1 markup2 markup3),
-and `commands' a list of commands with their scheme arguments, in reverse order,
-eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
- ((bold (raise 4 (italic markup1)))
-  (bold (raise 4 (italic markup2)))
-  (bold (raise 4 (italic markup3))))
-"
-  (map (lambda (arg)
-         (fold
-          (lambda (cmd prev) (append cmd (list prev)))
-          arg
-          commands))
-       markups))