Issue 2445: Add measure counter to LilyPond

scm/music-functions.scm

 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
 ;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 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
 ;;;; the Free Software Foundation, either version 3 of the License, or
 ;;;; (at your option) any later version.
 ;;;;
@@ skipping 366 matching lines @@
     (if (pair? es)
         (set! (ly:music-property music 'elements)
               (map unfold-repeats es)))
     (if (ly:music? e)
         (set! (ly:music-property music 'element)
               (unfold-repeats e)))
     music))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; property setting music objs.
+
+(define-safe-public (check-grob-path path #:optional parser location
+                                     #:key
+                                     (start 0)
+                                     default
+                                     (min 1)
+                                     max)
+  "Check a grob path specification @var{path}, a symbol list (or a
+single symbol), for validity and possibly complete it.  Returns the
+completed specification, or @code{#f} if invalid.  If optional
+@var{parser} is given, a syntax error is raised in that case,
+optionally using @var{location}.  If an optional keyword argument
+@code{#:start @var{start}} is given, the parsing starts at the given
+index in the sequence @samp{Context.Grob.property.sub-property...},
+with the default of @samp{0} implying the full path.
+
+If there is no valid first element of @var{path} fitting at the given
+path location, an optionally given @code{#:default @var{default}} is
+used as the respective element instead without checking it for
+validity at this position.
+
+The resulting path after possibly prepending @var{default} can be
+constrained in length by optional arguments @code{#:min @var{min}} and
+@code{#:max @var{max}}, defaulting to @samp{1} and unlimited,
+respectively."
+  (let ((path (if (symbol? path) (list path) path)))
+    ;; A Guile 1.x bug specific to optargs precludes moving the
+    ;; defines out of the let
+    (define (unspecial? s)
+      (not (or (object-property s 'is-grob?)
+               (object-property s 'backend-type?))))
+    (define (grob? s)
+      (object-property s 'is-grob?))
+    (define (property? s)
+      (object-property s 'backend-type?))
+    (define (check c p) (c p))
+
+    (let* ((checkers
+            (and (< start 3)
+                 (drop (list unspecial? grob? property?) start)))
+           (res
+            (cond
+             ((null? path)
+              ;; tricky.  Should we make use of the default when the
+              ;; list is empty?  In most cases, this question should be
+              ;; academical as an empty list can only be generated by
+              ;; Scheme and is likely an error.  We consider this a case
+              ;; of "no valid first element, and default given".
+              ;; Usually, invalid use cases should be caught later using
+              ;; the #:min argument, and if the user explicitly does not
+              ;; catch this, we just follow through.
+              (if default (list default) '()))
+             ((not checkers)
+              ;; no checkers, so we have a valid first element and just
+              ;; take the path as-is.
+              path)
+             (default
+               (if ((car checkers) (car path))
+                   (and (every check (cdr checkers) (cdr path))
+                        path)
+                   (and (every check (cdr checkers) path)
+                        (cons default path))))
+             (else
+              (and (every check checkers path)
+                   path)))))
+      (if (and res
+               (if max (<= min (length res) max)
+                   (<= min (length res))))
+          res
+          (begin
+            (if parser
+                (ly:parser-error parser
+                                 (format #f (_ "bad grob property path ~a")
+                                         path)
+                                 location))
+            #f)))))
 
 (define-public (make-grob-property-set grob gprop val)
   "Make a @code{Music} expression that sets @var{gprop} to @var{val} in
 @var{grob}.  Does a pop first, i.e., this is not an override."
   (make-music 'OverrideProperty
               'symbol grob
               'grob-property gprop
               'grob-value val
               'pop-first #t))
 
@@ skipping 1537 matching lines @@
          (num (ly:stencil-aligned-to num X (ly:grob-property grob 'self-alignment-X)))
          (num
            (ly:stencil-translate-axis
              num
              (+ (interval-length break-alignment-L-ext)
                 (* 0.5
                    (- (car break-alignment-R-ext)
                       (cdr break-alignment-L-ext))))
              X)))
     num))