Implement \once as music function able to operate on complex stuff.

[lilypond.git] / scm / ly-syntax-constructors.scm

diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index 59eaee6d8ecbc927b996580761028943b837b77b..ee6140ab1fc9e932d5196b62ec89b43d4c80a7cc 100644 (file)
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -43,16 +43,37 @@
        m)))
 
 ;; Music function: Apply function and check return value.
-(define-ly-syntax (music-function parser loc pred default fun args)
-  (let ((m (apply fun parser loc args)))
-    (if (pred m)
-       m
+;; args are in reverse order, rest may specify additional ones
+;;
+;; If args is not a proper list, an error has been flagged earlier
+;; and no fallback value had been available.  In this case,
+;; we don't call the function but rather return the general
+;; fallback.
+(define-ly-syntax (music-function parser loc fun args . rest)
+  (let* ((sig (object-property fun 'music-function-signature))
+        (pred (if (pair? (car sig)) (caar sig) (car sig)))
+        (good (proper-list? args))
+        (m (and good (apply fun parser loc (reverse! args rest)))))
+    (if (and good (pred m))
        (begin
-         (ly:parser-error parser
-                          (format #f (_ "~a function cannot return ~a")
-                                  (type-name pred) m)
-                          loc)
-         default))))
+         (if (ly:music? m)
+             (set! (ly:music-property m 'origin) loc))
+         m)
+       (begin
+         (if good
+             (ly:parser-error parser
+                              (format #f (_ "~a function cannot return ~a")
+                                      (type-name pred) m)
+                              loc))
+         (and (pair? (car sig)) (cdar sig))))))
+
+(define-ly-syntax (argument-error parser location n pred arg)
+  (ly:parser-error
+   parser
+   (format #f
+          (_ "wrong type for argument ~a.  Expecting ~a, found ~s")
+          n (type-name pred) arg)
+   location))
 
 (define-ly-syntax-simple (void-music)
   (make-music 'Music))
@@ -149,14 +170,14 @@ into a @code{MultiMeasureTextEvent}."
              'element (repetition-function previous-chord location duration articulations)
              'origin location))
 
-(define-ly-syntax-simple (context-specification type id mus ops create-new)
+(define-ly-syntax-simple (context-specification type id ops create-new mus)
   (let* ((type-sym (if (symbol? type) type (string->symbol type)))
         (csm (context-spec-music mus type-sym id)))
     (set! (ly:music-property csm 'property-operations) ops)
     (if create-new (set! (ly:music-property csm 'create-new) #t))
     csm))
 
-(define-ly-syntax (property-operation parser location once ctx music-type symbol . args)
+(define-ly-syntax (property-operation parser location ctx music-type symbol . args)
   (let* ((props (case music-type
                  ((PropertySet) (list 'value (car args)))
                  ((PropertyUnset) '())
@@ -170,11 +191,10 @@ into a @code{MultiMeasureTextEvent}."
                       (list 'grob-property-path (car args))
                       (list 'grob-property-path args)))
                  (else (ly:error (_ "Invalid property operation ~a") music-type))))
-        (oprops (if once (cons* 'once once props) props))
         (m (apply make-music music-type
                   'symbol symbol
                   'origin location
-                  oprops)))
+                  props)))
     (make-music 'ContextSpeccedMusic
                'element m
                'context-type ctx