From 2188505a75fb36893b0ec261c6bc194a201ec66e Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Thu, 25 Oct 2012 14:42:25 +0200
Subject: [PATCH] Implement function check-grob-path for checking/extending
 grob path specs

From the function documentation string:

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.
---
 scm/music-functions.scm | 76 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 017e7bd3a8..23a797779d 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -385,6 +385,82 @@ beats to be distinguished."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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."
-- 
2.39.2