X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=75e6da5349077ef08cb64f9d83665a88f4af6fae;hb=4f73dc31d42627f022d5efc9b241571c0ea1d4cb;hp=65f885bbf87e1a76921c7f3e8e98900e2b0c980c;hpb=6dbb7c4cfab2a0c2ce47f229592efc0ffc7d519a;p=lilypond.git

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 65f885bbf8..75e6da5349 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -229,13 +229,13 @@ which often can be read back in order to generate an equivalent expression."
 (use-modules (srfi srfi-39)
              (scm display-lily))
 
-(define*-public (display-lily-music expr parser #:optional (port (current-output-port))
+(define*-public (display-lily-music expr #:optional (port (current-output-port))
                                     #:key force-duration)
   "Display the music expression using LilyPond syntax"
   (memoize-clef-names supported-clefs)
   (parameterize ((*indent* 0)
                  (*omit-duration* #f))
-                (display (music->lily-string expr parser) port)
+                (display (music->lily-string expr) port)
                 (newline port)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -406,7 +406,7 @@ beats to be distinguished."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; property setting music objs.
 
-(define-safe-public (check-grob-path path #:optional parser location
+(define-safe-public (check-grob-path path #:optional location
                                      #:key
                                      (start 0)
                                      default
@@ -475,11 +475,10 @@ respectively."
                    (<= min (length res))))
           res
           (begin
-            (if parser
-                (ly:parser-error parser
-                                 (format #f (_ "bad grob property path ~a")
-                                         path)
-                                 location))
+            (ly:parser-error
+             (format #f (_ "bad grob property path ~a")
+                     path)
+             location)
             #f)))))
 
 (define-public (make-grob-property-set grob gprop val)
@@ -546,6 +545,14 @@ in @var{grob}."
       (Voice Slur direction ,DOWN))
     general-grace-settings))
 
+;; Getting a unique context id name
+
+(define-session unique-counter -1)
+(define-safe-public (get-next-unique-voice-name)
+  (set! unique-counter (1+ unique-counter))
+  (format #f "uniqueContext~s" unique-counter))
+
+
 (define-safe-public (make-voice-props-set n)
   (make-sequential-music
    (append
@@ -1040,10 +1047,9 @@ actually fully cloned."
 
 (defmacro-public def-grace-function (start stop . docstring)
   "Helper macro for defining grace music"
-  `(define-music-function (parser location music) (ly:music?)
+  `(define-music-function (music) (ly:music?)
      ,@docstring
      (make-music 'GraceMusic
-                 'origin location
                  'element (make-music 'SequentialMusic
                                       'elements (list (ly:music-deep-copy ,start)
                                                       music
@@ -1052,7 +1058,7 @@ actually fully cloned."
 (defmacro-public define-syntax-function (type args signature . body)
   "Helper macro for `ly:make-music-function'.
 Syntax:
-  (define-syntax-function result-type? (parser location arg1 arg2 ...) (arg1-type arg2-type ...)
+  (define-syntax-function result-type? (arg1 arg2 ...) (arg1-type arg2-type ...)
     ...function body...)
 
 argX-type can take one of the forms @code{predicate?} for mandatory
@@ -1067,21 +1073,28 @@ parameter of different type.
 predicates, to be used in case of a type error in arguments or
 result."
 
+  (define (has-parser/location? arg where)
+    (let loop ((arg arg))
+      (if (list? arg)
+          (any loop arg)
+          (memq arg where))))
   (define (currying-lambda args doc-string? body)
     (if (and (pair? args)
              (pair? (car args)))
         (currying-lambda (car args) doc-string?
                          `((lambda ,(cdr args) ,@body)))
-        `(lambda ,args
-           ,(format #f "~a\n~a" (cddr args) (or doc-string? ""))
-           ,@body)))
-
-  (set! signature (map (lambda (pred)
-                         (if (pair? pred)
-                             `(cons ,(car pred)
-                                    ,(and (pair? (cdr pred)) (cadr pred)))
-                             pred))
-                       (cons type signature)))
+        (let* ((compatibility? (if (list? args)
+                                   (= (length args) (+ 2 (length signature)))
+                                   (and (pair? args) (pair? (cdr args))
+                                        (eq? (car args) 'parser))))
+               (realargs (if compatibility? (cddr args) args)))
+          `(lambda ,realargs
+             ,(format #f "~a\n~a" realargs (or doc-string? ""))
+             ,@(if (and compatibility?
+                        (has-parser/location? body (take args 2)))
+                   `((let ((,(car args) (*parser*)) (,(cadr args) (*location*)))
+                       ,@body))
+                   body)))))
 
   (let ((docstring
          (and (pair? body) (pair? (cdr body))
@@ -1096,13 +1109,18 @@ result."
     ;; When the music function definition contains an i10n doc string,
     ;; (_i "doc string"), keep the literal string only
     `(ly:make-music-function
-      (list ,@signature)
+      (list ,@(map (lambda (pred)
+                     (if (pair? pred)
+                         `(cons ,(car pred)
+                                ,(and (pair? (cdr pred)) (cadr pred)))
+                         pred))
+                   (cons type signature)))
       ,(currying-lambda args docstring (if docstring (cdr body) body)))))
 
 (defmacro-public define-music-function rest
   "Defining macro returning music functions.
 Syntax:
-  (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+  (define-music-function (arg1 arg2 ...) (arg1-type? arg2-type? ...)
     ...function body...)
 
 argX-type can take one of the forms @code{predicate?} for mandatory
@@ -1122,7 +1140,7 @@ set to the @code{location} parameter."
 (defmacro-public define-scheme-function rest
   "Defining macro returning Scheme functions.
 Syntax:
-  (define-scheme-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+  (define-scheme-function (arg1 arg2 ...) (arg1-type? arg2-type? ...)
     ...function body...)
 
 argX-type can take one of the forms @code{predicate?} for mandatory
@@ -1150,7 +1168,7 @@ the return value."
 (defmacro-public define-event-function rest
   "Defining macro returning event functions.
 Syntax:
-  (define-event-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+  (define-event-function (arg1 arg2 ...) (arg1-type? arg2-type? ...)
     ...function body...)
 
 argX-type can take one of the forms @code{predicate?} for mandatory
@@ -1276,7 +1294,7 @@ then revert skipTypesetting."
     (context-spec-music (make-property-set 'skipTypesetting (not bool))
                         'Score))))
 
-(define (skip-as-needed music parser)
+(define (skip-as-needed music)
   "Replace MUSIC by
  << {  \\set skipTypesetting = ##f
  LENGTHOF(\\showFirstLength)
@@ -1289,8 +1307,8 @@ then revert skipTypesetting."
  the 'length property of the music is
  overridden to speed up compiling."
   (let*
-      ((show-last (ly:parser-lookup parser 'showLastLength))
-       (show-first (ly:parser-lookup parser 'showFirstLength))
+      ((show-last (ly:parser-lookup 'showLastLength))
+       (show-first (ly:parser-lookup 'showFirstLength))
        (show-last-length (and (ly:music? show-last)
                               (ly:music-length show-last)))
        (show-first-length (and (ly:music? show-first)
@@ -1340,24 +1358,21 @@ then revert skipTypesetting."
 
 (define-session-public toplevel-music-functions
   (list
-   (lambda (music parser) (expand-repeat-chords!
-                           (cons 'rhythmic-event
-                                 (ly:parser-lookup parser '$chord-repeat-events))
-                           music))
-   (lambda (music parser) (expand-repeat-notes! music))
-   (lambda (music parser) (voicify-music music))
-   (lambda (x parser) (music-map music-check-error x))
-   (lambda (x parser) (music-map precompute-music-length x))
-   (lambda (music parser)
-
-     (music-map (quote-substitute (ly:parser-lookup parser 'musicQuotes))  music))
+   (lambda (music) (expand-repeat-chords!
+                    (cons 'rhythmic-event
+                          (ly:parser-lookup '$chord-repeat-events))
+                    music))
+   expand-repeat-notes!
+   voicify-music
+   (lambda (x) (music-map music-check-error x))
+   (lambda (x) (music-map precompute-music-length x))
+   (lambda (music)
+     (music-map (quote-substitute (ly:parser-lookup 'musicQuotes))  music))
 
    ;; switch-on-debugging
-   (lambda (x parser) (music-map cue-substitute x))
+   (lambda (x) (music-map cue-substitute x))
 
-   (lambda (x parser)
-     (skip-as-needed x parser)
-     )))
+   skip-as-needed))
 
 ;;;;;;;;;;
 ;;; general purpose music functions
@@ -1973,12 +1988,10 @@ recursing into matches themselves."
          (any (lambda (t) (music-is-of-type? m t)) type))
        (lambda (m) (music-is-of-type? m type)))))
 
-(define*-public (event-chord-wrap! music #:optional parser)
+(define*-public (event-chord-wrap! music)
   "Wrap isolated rhythmic events and non-postevent events in
-@var{music} inside of an @code{EventChord}.  If the optional
-@var{parser} argument is given, chord repeats @samp{q} are expanded
-using the default settings.  Otherwise, you need to cater for them
-yourself."
+@var{music} inside of an @code{EventChord}.  Chord repeats @samp{q}
+are expanded using the default settings of the parser."
   (map-some-music
    (lambda (m)
      (cond ((music-is-of-type? m 'event-chord)
@@ -1995,12 +2008,10 @@ yourself."
                   (set! (ly:music-property m 'articulations) '()))
               (make-event-chord (cons m arts))))
            (else #f)))
-   (if parser
-       (expand-repeat-chords!
-        (cons 'rhythmic-event
-              (ly:parser-lookup parser '$chord-repeat-events))
-        music)
-       music)))
+   (expand-repeat-chords!
+    (cons 'rhythmic-event
+          (ly:parser-lookup '$chord-repeat-events))
+    music)))
 
 (define-public (event-chord-notes event-chord)
   "Return a list of all notes from @var{event-chord}."