Re: Issue 2917: Extend \keepWithTag to allow multiple tags (issue 6744070)

[dak]

Reviewers: lemzwerg,

Message:
On 2012/10/23 11:19:59, lemzwerg wrote:
> LGTM.  Any convert rules necessary?

Well, I abolish list-or-symbol? here on the assumption that nobody used
this peculiar and mostly ill-advised predicate.  That is somewhat
optimistic.  Converting list-or-symbol? automatically to
symbol-list-or-symbol?, however, would silently change its meaning.  So
I'd not really be all that comfortable with that.  If that predicate is
indeed needed, it is trivial to write.  One could retain it under the
old name, but it really is too unspecific to be of good use.

Description:
Issue 2917: Extend \keepWithTag to allow multiple tags

Also extends \removeWithTag accordingly.


There are also a few other commits from issue 2883 drawn in.  The set
is slightly larger than necessary for this issue, but I wanted to
avoid having to manually resolve merge conflicts.

Replace the rather fuzzy list-or-symbol? with symbol-list-or-symbol?

list-or-symbol? was previously used in the meaning of
symbol-list-or-symbol? only, and there is no point in not checking the
list members for actually being symbols, in order to avoid ugly
surprises later.

Add symbol-list-or-music? predicate

This is of interest for commands like \hide which accept either music
(to see an override) or a grob specification like Accidental or
Voice.Accidental.

Add symbol-list? predicate

Please review this at http://codereview.appspot.com/6744070/

Affected files:
  M ly/music-functions-init.ly
  M ly/property-init.ly
  M scm/c++.scm
  M scm/lily.scm


Index: ly/music-functions-init.ly
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index  
4fa31929d4ef9e2188ba5745612b092c870143e7..597a67673781f2ee32c2c637e2340fa66d2a0963  
100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -523,15 +523,21 @@ instrumentSwitch =


 keepWithTag =
-#(define-music-function (parser location tag music) (symbol? ly:music?)
-   (_i "Include only elements of @var{music} that are tagged with  
@var{tag}.")
+#(define-music-function (parser location tag music)
+   (symbol-list-or-symbol? ly:music?)
+   (_i "Include only elements of @var{music} that are either untagged
+or tagged with one of the tags in @var{tag}.  @var{tag} may be either
+a single symbol or a list of symbols.")
    (music-filter
-    (lambda (m)
-      (let* ((tags (ly:music-property m 'tags))
-            (res (memq tag tags)))
-       (or
-        (eq? tags '())
-        res)))
+    (if (symbol? tag)
+        (lambda (m)
+          (let ((music-tags (ly:music-property m 'tags)))
+            (or (null? music-tags)
+                (memq tag music-tags))))
+        (lambda (m)
+          (let ((music-tags (ly:music-property m 'tags)))
+            (or (null? music-tags)
+                (any (lambda (t) (memq t music-tags)) tag)))))
     music))

 key =
@@ -1019,13 +1025,19 @@ relative =
               'element music))

 removeWithTag =
-#(define-music-function (parser location tag music) (symbol? ly:music?)
-   (_i "Remove elements of @var{music} that are tagged with @var{tag}.")
+#(define-music-function (parser location tag music)
+   (symbol-list-or-symbol? ly:music?)
+   (_i "Remove elements of @var{music} that are tagged with one of the
+tags in @var{tag}.  @var{tag} may be either a single symbol or a list
+of symbols.")
    (music-filter
-    (lambda (m)
-      (let* ((tags (ly:music-property m 'tags))
-            (res (memq tag tags)))
-       (not res)))
+    (if (symbol? tag)
+        (lambda (m)
+          (not (memq tag (ly:music-property m 'tags))))
+        (lambda (m)
+          (let ((music-tags (ly:music-property m 'tags)))
+            (or (null? music-tags)
+                (not (any (lambda (t) (memq t music-tags)) tag))))))
     music))

 resetRelativeOctave =
@@ -1227,7 +1239,7 @@ the `parameters' assoc list.")

 styledNoteHeads =
 #(define-music-function (parser location style heads music)
-   (symbol? list-or-symbol? ly:music?)
+   (symbol? symbol-list-or-symbol? ly:music?)
    (_i "Set @var{heads} in @var{music} to @var{style}.")
    (style-note-heads heads style music))

Index: ly/property-init.ly
diff --git a/ly/property-init.ly b/ly/property-init.ly
index  
269648639b7d81b54b53b37aeb72cddf470b3a46..8e87421f74b467d2370a27437abaed8c68e21614  
100644
--- a/ly/property-init.ly
+++ b/ly/property-init.ly
@@ -376,7 +376,7 @@ back to the lilypond source statement.")
    (make-music 'SequentialMusic 'void #t))

 pointAndClickTypes =
-#(define-void-function (parser location types) (list-or-symbol?)
+#(define-void-function (parser location types) (symbol-list-or-symbol?)
   (_i "Set a type or list of types (such as @code{#'note-event}) for which  
point-and-click info is generated.")
   (ly:set-option 'point-and-click types))

Index: scm/c++.scm
diff --git a/scm/c++.scm b/scm/c++.scm
index  
444a3e9ba6534b9201c26937785bcbb4fc9e6a5d..8d1df2aed7487b22c742780e4f73c0c12833fbd2  
100644
--- a/scm/c++.scm
+++ b/scm/c++.scm
@@ -48,6 +48,14 @@
 (define-public (boolean-or-symbol? x)
   (or (boolean? x) (symbol? x)))

+(define-public (symbol-list? x)
+  (and (list? x) (every symbol? x)))
+
+(define-public (symbol-list-or-music? x)
+  (if (list? x)
+      (every symbol? x)
+      (ly:music? x)))
+
 (define-public (string-or-symbol? x)
   (or (string? x) (symbol? x)))

@@ -66,8 +74,10 @@
 (define-public (cheap-list? x)
   (or (pair? x) (null? x)))

-(define-public (list-or-symbol? x)
-  (or (cheap-list? x) (symbol? x)))
+(define-public (symbol-list-or-symbol? x)
+  (if (list? x)
+      (every symbol? x)
+      (symbol? x)))

 (define-public (scheme? x) #t)

Index: scm/lily.scm
diff --git a/scm/lily.scm b/scm/lily.scm
index  
d7c4bf65874c8766fe5a2dcd75bae743fb296258..1a5674df570336ae6ff30516bd4bbb979d30ca59  
100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -568,8 +568,6 @@ messages into errors.")
     (,fraction? . "fraction, as pair")
     (,grob-list? . "list of grobs")
     (,index? . "non-negative integer")
-    ;; this is built on cheap-list
-    (,list-or-symbol? . "list or symbol")
     (,markup? . "markup")
     (,markup-command-list? . "markup command list")
     (,markup-list? . "markup list")
@@ -584,6 +582,9 @@ messages into errors.")
     (,string-or-pair? . "string or pair")
     (,string-or-music? . "string or music")
     (,string-or-symbol? . "string or symbol")
+    (,symbol-list? . "symbol list")
+    (,symbol-list-or-music? . "symbol list or music")
+    (,symbol-list-or-symbol? . "symbol list or symbol")
     (,void? . "void")
     ))