-;;; festival.scm --- Festival singing mode output
-
-;; Copyright (C) 2006, 2007 Brailcom, o.p.s.
-
-;; Author: Milan Zamazal <pdm@brailcom.org>
-
-;; COPYRIGHT NOTICE
-
-;; This program 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 2 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-;; for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+;;;; song-util.scm --- Festival singing mode output
+;;;;
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2006, 2007 Brailcom, o.p.s.
+;;;; Author: Milan Zamazal <pdm@brailcom.org>
+;;;;
+;;;; 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.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
(define-module (scm song-util))
(lambda (record) ((record-predicate ,record) record)))
(set! ,$make-record
(lambda* (#:key ,@slots)
- ((record-constructor ,record) ,@(map car slots*))))
+ ((record-constructor ,record) ,@(map car slots*))))
(set! ,$copy-record
(lambda (record)
- (,$make-record ,@(apply
- append
- (map (lambda (slot)
- (list (symbol->keyword slot)
- (list (make-symbol reader-format slot) 'record)))
- (map car slots*))))))
+ (,$make-record ,@(append-map
+ (lambda (slot)
+ (list (symbol->keyword slot)
+ (list (make-symbol reader-format slot) 'record)))
+ (map car slots*)))))
,@(map (lambda (s)
`(set! ,(make-symbol reader-format (car s))
(record-accessor ,record (quote ,(car s)))))
(define-public (music-property-value? music property value)
- "Return true iff MUSIC's PROPERTY is equal to VALUE."
+ "Return @code{#t} iff @var{music}'s @var{property} is equal to
+@var{value}."
(equal? (ly:music-property music property) value))
(define-public (music-name? music name)
- "Return true iff MUSIC's name is NAME."
+ "Return @code{#t} iff @var{music}'s name is @var{name}."
(if (list? name)
(member (ly:music-property music 'name) name)
(music-property-value? music 'name name)))
(define-public (music-property? music property)
- "Return true iff MUSIC is a property setter and sets or unsets PROPERTY."
+ "Return @code{#t} iff @var{music} is a property setter and sets
+or unsets @var{property}."
(and (music-name? music '(PropertySet PropertyUnset))
(music-property-value? music 'symbol property)))
(define-public (music-has-property? music property)
- "Return true iff MUSIC contains PROPERTY."
+ "Return @code{#t} iff @var{music} contains @var{property}."
(not (eq? (ly:music-property music property) '())))
(define-public (property-value music)
- "Return value of a property setter MUSIC.
-If it unsets the property, return #f."
+ "Return value of a property setter @var{music}.
+If it unsets the property, return @code{#f}."
(if (music-name? music 'PropertyUnset)
#f
(ly:music-property music 'value)))
(define-public (music-elements music)
- "Return list of all MUSIC's top-level children."
+ "Return list of all @var{music}'s top-level children."
(let ((elt (ly:music-property music 'element))
- (elts (ly:music-property music 'elements)))
- (if (not (null? elt))
- (cons elt elts)
- elts)))
+ (elts (ly:music-property music 'elements))
+ (arts (ly:music-property music 'articulations)))
+ (if (pair? arts)
+ (set! elts (append elts arts)))
+ (if (null? elt)
+ elts
+ (cons elt elts))))
(define-public (find-child music predicate)
- "Find the first node in MUSIC that satisfies PREDICATE."
+ "Find the first node in @var{music} that satisfies @var{predicate}."
(define (find-child queue)
(if (null? queue)
#f
(find-child (list music)))
(define-public (find-child-named music name)
- "Return the first child in MUSIC that is named NAME."
+ "Return the first child in @var{music} that is named @var{name}."
(find-child music (lambda (elt) (music-name? elt name))))
(define-public (process-music music function)
- "Process all nodes of MUSIC (including MUSIC) in the DFS order.
-Apply FUNCTION on each of the nodes.
-If FUNCTION applied on a node returns true, don't process the node's subtree."
+ "Process all nodes of @var{music} (including @var{music}) in the DFS order.
+Apply @var{function} on each of the nodes. If @var{function} applied on a
+node returns @code{#t}, don't process the node's subtree.
+
+If a non-boolean is returned, it is considered the material to recurse."
(define (process-music queue)
(if (not (null? queue))
(let* ((elt (car queue))
(stop (function elt)))
- (process-music (if stop
- (cdr queue)
- (append (music-elements elt) (cdr queue)))))))
+ (process-music (if (boolean? stop)
+ (if stop
+ (cdr queue)
+ (append (music-elements elt) (cdr queue)))
+ ((if (cheap-list? stop) append cons)
+ stop (cdr queue)))))))
(process-music (list music)))
projects / lilypond.git / blobdiff