Change \tweak syntax to symbol syntax

[lilypond.git] / scm / lily-library.scm

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 4fa1605ed29b90811893cf269cdb12957b7c024e..854980012cea5d3da40df5b955bfde86c4e87a97 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;

-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; 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
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify


@@ -19,6 +19,9 @@
 ; for take, drop, take-while, list-index, and find-tail:
 (use-modules (srfi srfi-1))
 
 ; for take, drop, take-while, list-index, and find-tail:
 (use-modules (srfi srfi-1))
 

+; for define-safe-public when byte-compiling using Guile V2
+(use-modules (scm safe-utility-defs))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; constants.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; constants.
 


@@ -84,7 +87,7 @@
 ;; parser <-> output hooks.
 
 (define-public (collect-bookpart-for-book parser book-part)
 ;; parser <-> output hooks.
 
 (define-public (collect-bookpart-for-book parser book-part)

-  "Toplevel book-part handler"
+  "Toplevel book-part handler."

   (define (add-bookpart book-part)
     (ly:parser-define!
        parser 'toplevel-bookparts
   (define (add-bookpart book-part)
     (ly:parser-define!
        parser 'toplevel-bookparts


@@ -131,21 +134,21 @@
         (score-handler (scorify-music music parser)))))
 
 (define-public (collect-music-for-book parser music)
         (score-handler (scorify-music music parser)))))
 
 (define-public (collect-music-for-book parser music)

-  "Top-level music handler"
+  "Top-level music handler."

   (collect-music-aux (lambda (score)
                       (collect-scores-for-book parser score))
                      parser
                     music))
 
 (define-public (collect-book-music-for-book parser book music)
   (collect-music-aux (lambda (score)
                       (collect-scores-for-book parser score))
                      parser
                     music))
 
 (define-public (collect-book-music-for-book parser book music)

-  "Book music handler"
+  "Book music handler."

   (collect-music-aux (lambda (score)
                       (ly:book-add-score! book score))
                      parser
                     music))
 
 (define-public (scorify-music music parser)
   (collect-music-aux (lambda (score)
                       (ly:book-add-score! book score))
                      parser
                     music))
 
 (define-public (scorify-music music parser)

-  "Preprocess MUSIC."
+  "Preprocess @var{music}."

 
   (for-each (lambda (func)
              (set! music (func music parser)))
 
   (for-each (lambda (func)
              (set! music (func music parser)))


@@ -154,39 +157,39 @@
   (ly:make-score music))
 
 
   (ly:make-score music))
 
 

-(define (get-current-filename parser)
+(define (get-current-filename parser book)

   "return any suffix value for output filename allowing for settings by
 calls to bookOutputName function"
   "return any suffix value for output filename allowing for settings by
 calls to bookOutputName function"

-  (let ((book-filename (ly:parser-lookup parser 'book-filename)))
+  (let ((book-filename (paper-variable parser book 'output-filename)))

     (if (not book-filename)
        (ly:parser-output-name parser)
        book-filename)))
 
     (if (not book-filename)
        (ly:parser-output-name parser)
        book-filename)))
 

-(define (get-current-suffix parser)
+(define (get-current-suffix parser book)

   "return any suffix value for output filename allowing for settings by calls to
 bookoutput function"
   "return any suffix value for output filename allowing for settings by calls to
 bookoutput function"

-  (let ((book-output-suffix (ly:parser-lookup parser 'book-output-suffix)))
+  (let ((book-output-suffix (paper-variable parser book 'output-suffix)))

     (if (not (string? book-output-suffix))
        (ly:parser-lookup parser 'output-suffix)
        book-output-suffix)))
 
 (define-public current-outfile-name #f)  ; for use by regression tests
 
     (if (not (string? book-output-suffix))
        (ly:parser-lookup parser 'output-suffix)
        book-output-suffix)))
 
 (define-public current-outfile-name #f)  ; for use by regression tests
 

-(define (get-outfile-name parser)
+(define (get-outfile-name parser book)

   "return current filename for generating backend output files"
   ;; user can now override the base file name, so we have to use
   ;; the file-name concatenated with any potential output-suffix value
   ;; as the key to out internal a-list
   "return current filename for generating backend output files"
   ;; user can now override the base file name, so we have to use
   ;; the file-name concatenated with any potential output-suffix value
   ;; as the key to out internal a-list

-  (let* ((base-name (get-current-filename parser))
-        (output-suffix (get-current-suffix parser))
-        (alist-key (format "~a~a" base-name output-suffix))
+  (let* ((base-name (get-current-filename parser book))
+        (output-suffix (get-current-suffix parser book))
+        (alist-key (format #f "~a~a" base-name output-suffix))

         (counter-alist (ly:parser-lookup parser 'counter-alist))
         (output-count (assoc-get alist-key counter-alist 0))
         (result base-name))
     ;; Allow all ASCII alphanumerics, including accents
     (if (string? output-suffix)
         (set! result
         (counter-alist (ly:parser-lookup parser 'counter-alist))
         (output-count (assoc-get alist-key counter-alist 0))
         (result base-name))
     ;; Allow all ASCII alphanumerics, including accents
     (if (string? output-suffix)
         (set! result

-              (format "~a-~a"
+              (format #f "~a-~a"

                       result
                       (string-regexp-substitute
                        "[^-[:alnum:]]"
                       result
                       (string-regexp-substitute
                        "[^-[:alnum:]]"


@@ -206,7 +209,7 @@ bookoutput function"
 (define (print-book-with parser book process-procedure)
   (let* ((paper (ly:parser-lookup parser '$defaultpaper))
         (layout (ly:parser-lookup parser '$defaultlayout))
 (define (print-book-with parser book process-procedure)
   (let* ((paper (ly:parser-lookup parser '$defaultpaper))
         (layout (ly:parser-lookup parser '$defaultlayout))

-        (outfile-name (get-outfile-name parser)))
+        (outfile-name (get-outfile-name parser book)))

     (process-procedure book paper layout outfile-name)))
 
 (define-public (print-book-with-defaults parser book)
     (process-procedure book paper layout outfile-name)))
 
 (define-public (print-book-with-defaults parser book)


@@ -227,6 +230,24 @@ bookoutput function"
       (else
           ((ly:parser-lookup parser 'toplevel-score-handler) parser score))))
 
       (else
           ((ly:parser-lookup parser 'toplevel-score-handler) parser score))))
 

+(define-public paper-variable
+  (let
+      ((get-papers
+       (lambda (parser book)
+         (append (if (and book (ly:output-def? (ly:book-paper book)))
+                     (list (ly:book-paper book))
+                     '())
+                 (ly:parser-lookup parser '$papers)
+                 (list (ly:parser-lookup parser '$defaultpaper))))))
+    (make-procedure-with-setter
+     (lambda (parser book symbol)
+       (any (lambda (p) (ly:output-def-lookup p symbol #f))
+           (get-papers parser book)))
+     (lambda (parser book symbol value)
+       (ly:output-def-set-variable!
+       (car (get-papers parser book))
+       symbol value)))))
+

 (define-public (add-text parser text)
   (add-score parser (list text)))
 
 (define-public (add-text parser text)
   (add-score parser (list text)))
 


@@ -236,6 +257,127 @@ bookoutput function"
                      parser
                     music))
 
                      parser
                     music))
 

+(define-public (context-mod-from-music parser music)
+  (let ((warn #t) (mods (ly:make-context-mod)))
+    (let loop ((m music) (context #f))
+      (if (music-is-of-type? m 'layout-instruction-event)
+         (let ((symbol (cons context (ly:music-property m 'symbol))))
+           (ly:add-context-mod
+            mods
+            (case (ly:music-property m 'name)
+              ((PropertySet)
+               (list 'assign
+                     symbol
+                     (ly:music-property m 'value)))
+              ((PropertyUnset)
+               (list 'unset symbol))
+              ((OverrideProperty)
+               (cons* 'push
+                      symbol
+                      (ly:music-property m 'grob-value)
+                       (cond
+                        ((ly:music-property m 'grob-property #f) => list)
+                        (else
+                         (ly:music-property m 'grob-property-path)))))
+               ((RevertProperty)
+               (cons* 'pop
+                      symbol
+                       (cond
+                        ((ly:music-property m 'grob-property #f) => list)
+                        (else
+                         (ly:music-property m 'grob-property-path))))))))
+         (case (ly:music-property m 'name)
+           ((ApplyContext)
+            (ly:add-context-mod mods
+                                (list 'apply
+                                      (ly:music-property m 'procedure))))
+           ((ContextSpeccedMusic)
+            (loop (ly:music-property m 'element)
+                  (ly:music-property m 'context-type)))
+           (else
+            (let ((callback (ly:music-property m 'elements-callback)))
+              (if (procedure? callback)
+                  (fold loop context (callback m))
+                  (if (and warn (ly:duration? (ly:music-property m 'duration)))
+                      (begin
+                        (ly:music-warning
+                         music
+                         (_ "Music unsuitable for context-mod"))
+                        (set! warn #f))))))))
+      context)
+    mods))
+
+(define-public (context-defs-from-music parser output-def music)
+  (let ((warn #t))
+    (let loop ((m music) (mods #f))
+      ;; The parser turns all sets, overrides etc into something
+      ;; wrapped in ContextSpeccedMusic.  If we ever get a set,
+      ;; override etc that is not wrapped in ContextSpeccedMusic, the
+      ;; user has created it in Scheme himself without providing the
+      ;; required wrapping.  In that case, using #f in the place of a
+      ;; context modification results in a reasonably recognizable
+      ;; error.
+      (if (music-is-of-type? m 'layout-instruction-event)
+         (ly:add-context-mod
+          mods
+          (case (ly:music-property m 'name)
+            ((PropertySet)
+             (list 'assign
+                   (ly:music-property m 'symbol)
+                   (ly:music-property m 'value)))
+            ((PropertyUnset)
+             (list 'unset
+                   (ly:music-property m 'symbol)))
+            ((OverrideProperty)
+             (cons* 'push
+                    (ly:music-property m 'symbol)
+                    (ly:music-property m 'grob-value)
+                     (cond
+                      ((ly:music-property m 'grob-property #f) => list)
+                      (else
+                       (ly:music-property m 'grob-property-path)))))
+            ((RevertProperty)
+             (cons* 'pop
+                    (ly:music-property m 'symbol)
+                     (cond
+                      ((ly:music-property m 'grob-property #f) => list)
+                      (else
+                       (ly:music-property m 'grob-property-path)))))))
+         (case (ly:music-property m 'name)
+           ((ApplyContext)
+            (ly:add-context-mod mods
+                                (list 'apply
+                                      (ly:music-property m 'procedure))))
+           ((ContextSpeccedMusic)
+            ;; Use let* here to let defs catch up with modifications
+            ;; to the context defs made in the recursion
+            (let* ((mods (loop (ly:music-property m 'element)
+                               (ly:make-context-mod)))
+                   (defs (ly:output-find-context-def
+                          output-def (ly:music-property m 'context-type))))
+              (if (null? defs)
+                  (ly:music-warning
+                   music
+                   (ly:format (_ "Cannot find context-def \\~a")
+                              (ly:music-property m 'context-type)))
+                  (for-each
+                   (lambda (entry)
+                     (ly:output-def-set-variable!
+                      output-def (car entry)
+                      (ly:context-def-modify (cdr entry) mods)))
+                   defs))))
+           (else
+            (let ((callback (ly:music-property m 'elements-callback)))
+              (if (procedure? callback)
+                  (fold loop mods (callback m))
+                  (if (and warn (ly:duration? (ly:music-property m 'duration)))
+                      (begin
+                        (ly:music-warning
+                         music
+                         (_ "Music unsuitable for output-def"))
+                        (set! warn #f))))))))
+      mods)))
+

 
 ;;;;;;;;;;;;;;;;
 ;; alist
 
 ;;;;;;;;;;;;;;;;
 ;; alist


@@ -262,21 +404,22 @@ bookoutput function"
            (map-alist-vals func (cdr list)))))
 
 (define (map-alist-keys func list)
            (map-alist-vals func (cdr list)))))
 
 (define (map-alist-keys func list)

-  "map FUNC over the keys of an alist LIST, leaving the vals. "
+  "map FUNC over the keys of an alist LIST, leaving the vals."

   (if (null?  list)
       '()
       (cons (cons (func (caar list)) (cdar list))
            (map-alist-keys func (cdr list)))))
 
 (define-public (first-member members lst)
   (if (null?  list)
       '()
       (cons (cons (func (caar list)) (cdar list))
            (map-alist-keys func (cdr list)))))
 
 (define-public (first-member members lst)

-  "Return first successful MEMBER of member from MEMBERS in LST."
+  "Return first successful member (of member) from @var{members} in
+@var{lst}."

   (if (null? members)
       #f
       (let ((m (member (car members) lst)))
        (if m m (first-member (cdr members) lst)))))
 
 (define-public (first-assoc keys lst)
   (if (null? members)
       #f
       (let ((m (member (car members) lst)))
        (if m m (first-member (cdr members) lst)))))
 
 (define-public (first-assoc keys lst)

-  "Return first successful ASSOC of key from KEYS in LST."
+  "Return first successful assoc of key from @var{keys} in @var{lst}."

   (if (null? keys)
       #f
       (let ((k (assoc (car keys) lst)))
   (if (null? keys)
       #f
       (let ((k (assoc (car keys) lst)))


@@ -301,10 +444,14 @@ bookoutput function"
   (assoc-crawler key '() alist))
 
 (define-public (map-selected-alist-keys function keys alist)
   (assoc-crawler key '() alist))
 
 (define-public (map-selected-alist-keys function keys alist)

-  "Returns alist with function applied to all of the values in list keys.
-   For example:
-   @code{guile> (map-selected-alist-keys - '(a b) '((a . 1) (b . -2) (c . 3) (d . 4)))}
-   @code{((a . -1) (b . 2) (c . 3) (d . 4))}"
+  "Return @var{alist} with @var{function} applied to all of the values
+in list @var{keys}.
+
+For example:
+@example
+@code{guile> (map-selected-alist-keys - '(a b) '((a . 1) (b . -2) (c . 3) (d . 4)))}
+@code{((a . -1) (b . 2) (c . 3) (d . 4)}
+@end example"

    (define (map-selected-alist-keys-helper function key alist)
      (map
      (lambda (pair)
    (define (map-selected-alist-keys-helper function key alist)
      (map
      (lambda (pair)


@@ -383,7 +530,8 @@ bookoutput function"
   (helper lst 0))
 
 (define-public (count-list lst)
   (helper lst 0))
 
 (define-public (count-list lst)

-  "Given lst (E1 E2 .. ) return ((E1 . 1) (E2 . 2) ... )  "
+  "Given @var{lst} as @code{(E1 E2 .. )}, return
+@code{((E1 . 1) (E2 . 2) ... )}."

 
   (define (helper l acc count)
     (if (pair? l)
 
   (define (helper l acc count)
     (if (pair? l)


@@ -394,7 +542,7 @@ bookoutput function"
   (reverse (helper lst '() 1)))
 
 (define-public (list-join lst intermediate)
   (reverse (helper lst '() 1)))
 
 (define-public (list-join lst intermediate)

-  "put INTERMEDIATE  between all elts of LST."
+  "Put @var{intermediate} between all elts of @var{lst}."

 
   (fold-right
    (lambda (elem prev)
 
   (fold-right
    (lambda (elem prev)


@@ -420,7 +568,8 @@ bookoutput function"
   (lset-difference eq? a b))
 
 (define-public (uniq-list lst)
   (lset-difference eq? a b))
 
 (define-public (uniq-list lst)

-  "Uniq LST, assuming that it is sorted. Uses equal? for comparisons."
+  "Uniq @var{lst}, assuming that it is sorted.  Uses @code{equal?}
+for comparisons."

 
   (reverse!
    (fold (lambda (x acc)
 
   (reverse!
    (fold (lambda (x acc)


@@ -433,7 +582,7 @@ bookoutput function"
 
 (define (split-at-predicate pred lst)
   "Split LST into two lists at the first element that returns #f for
 
 (define (split-at-predicate pred lst)
   "Split LST into two lists at the first element that returns #f for

-  (PRED previous_element element). Return the two parts as a pair.
+  (PRED previous_element element).  Return the two parts as a pair.

   Example: (split-at-predicate < '(1 2 3 2 1)) ==> ((1 2 3) . (2 1))"
   (if (null? lst)
       (list lst)
   Example: (split-at-predicate < '(1 2 3 2 1)) ==> ((1 2 3) . (2 1))"
   (if (null? lst)
       (list lst)


@@ -445,9 +594,10 @@ bookoutput function"
             (list lst)))))
 
 (define-public (split-list-by-separator lst pred)
             (list lst)))))
 
 (define-public (split-list-by-separator lst pred)

-  "Split LST at each element that satisfies PRED, and return the parts
-  (with the separators removed) as a list of lists. Example:
-  (split-list-by-separator '(a 0 b c 1 d) number?) ==> ((a) (b c) (d))"
+  "Split @var{lst} at each element that satisfies @var{pred}, and return
+the parts (with the separators removed) as a list of lists.  For example,
+executing @samp{(split-list-by-separator '(a 0 b c 1 d) number?)} returns
+@samp{((a) (b c) (d))}."

   (let loop ((result '()) (lst lst))
     (if (and lst (not (null? lst)))
         (loop
   (let loop ((result '()) (lst lst))
     (if (and lst (not (null? lst)))
         (loop


@@ -483,7 +633,7 @@ bookoutput function"
   (cons (- expr) expr))
 
 (define-public (interval-length x)
   (cons (- expr) expr))
 
 (define-public (interval-length x)

-  "Length of the number-pair X, when an interval"
+  "Length of the number-pair @var{x}, if an interval."

   (max 0 (- (cdr x) (car x))))
 
 (define-public (ordered-cons a b)
   (max 0 (- (cdr x) (car x))))
 
 (define-public (ordered-cons a b)


@@ -494,14 +644,15 @@ bookoutput function"
   ((if (= dir RIGHT) cdr car) interval))
 
 (define-public (interval-index interval dir)
   ((if (= dir RIGHT) cdr car) interval))
 
 (define-public (interval-index interval dir)

-  "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)"
+  "Interpolate @var{interval} between between left (@var{dir}=-1) and
+right (@var{dir}=+1)."

 
   (* (+  (interval-start interval) (interval-end interval)
         (* dir (- (interval-end interval) (interval-start interval))))
      0.5))
 
 (define-public (interval-center x)
 
   (* (+  (interval-start interval) (interval-end interval)
         (* dir (- (interval-end interval) (interval-start interval))))
      0.5))
 
 (define-public (interval-center x)

-  "Center the number-pair X, when an interval"
+  "Center the number-pair @var{x}, if an interval."

   (if (interval-empty? x)
       0.0
       (/ (+ (car x) (cdr x)) 2)))
   (if (interval-empty? x)
       0.0
       (/ (+ (car x) (cdr x)) 2)))


@@ -513,6 +664,10 @@ bookoutput function"
 (define (other-axis a)
   (remainder (+ a 1) 2))
 
 (define (other-axis a)
   (remainder (+ a 1) 2))
 

+(define-public (interval-scale iv factor)
+  (cons (* (car iv) factor)
+    (* (cdr iv) factor)))
+

 (define-public (interval-widen iv amount)
   (cons (- (car iv) amount)
     (+ (cdr iv) amount)))
 (define-public (interval-widen iv amount)
   (cons (- (car iv) amount)
     (+ (cdr iv) amount)))


@@ -599,7 +754,7 @@ bookoutput function"
 (define-public THREE-PI-OVER-TWO (* 3 PI-OVER-TWO))
 
 (define-public (cyclic-base-value value cycle)
 (define-public THREE-PI-OVER-TWO (* 3 PI-OVER-TWO))
 
 (define-public (cyclic-base-value value cycle)

-  "Takes a value and modulo-maps it between 0 and base."
+  "Take @var{value} and modulo-maps it between 0 and base @var{cycle}."

   (if (< value 0)
       (cyclic-base-value (+ value cycle) cycle)
       (if (>= value cycle)
   (if (< value 0)
       (cyclic-base-value (+ value cycle) cycle)
       (if (>= value cycle)


@@ -607,17 +762,17 @@ bookoutput function"
           value)))
 
 (define-public (angle-0-2pi angle)
           value)))
 
 (define-public (angle-0-2pi angle)

-  "Takes an angle in radians and maps it between 0 and 2pi."
+  "Take @var{angle} (in radians) and maps it between 0 and 2pi."

   (cyclic-base-value angle TWO-PI))
 
 (define-public (angle-0-360 angle)
   (cyclic-base-value angle TWO-PI))
 
 (define-public (angle-0-360 angle)

-  "Takes an angle in radians and maps it between 0 and 2pi."
+  "Take @var{angle} (in degrees) and maps it between 0 and 360 degrees."

   (cyclic-base-value angle 360.0))
 
 (define-public PI-OVER-180  (/ PI 180))
 
 (define-public (degrees->radians angle-degrees)
   (cyclic-base-value angle 360.0))
 
 (define-public PI-OVER-180  (/ PI 180))
 
 (define-public (degrees->radians angle-degrees)

-  "Convert the given angle from degrees to radians"
+  "Convert the given angle from degrees to radians."

   (* angle-degrees PI-OVER-180))
 
 (define-public (ellipse-radius x-radius y-radius angle)
   (* angle-degrees PI-OVER-180))
 
 (define-public (ellipse-radius x-radius y-radius angle)


@@ -630,8 +785,9 @@ bookoutput function"
            (* (sin angle) (sin angle)))))))
 
 (define-public (polar->rectangular radius angle-in-degrees)
            (* (sin angle) (sin angle)))))))
 
 (define-public (polar->rectangular radius angle-in-degrees)

-  "Convert polar coordinate @code{radius} and @code{angle-in-degrees}
-   to (x-length . y-length)"
+  "Return polar coordinates (@var{radius}, @var{angle-in-degrees})
+as rectangular coordinates @ode{(x-length . y-length)}."
+

   (let ((complex (make-polar
                     radius
                     (degrees->radians angle-in-degrees))))
   (let ((complex (make-polar
                     radius
                     (degrees->radians angle-in-degrees))))


@@ -676,14 +832,15 @@ bookoutput function"
                 (ly:number->string (cdr c))))
 
 (define-public (dir-basename file . rest)
                 (ly:number->string (cdr c))))
 
 (define-public (dir-basename file . rest)

-  "Strip suffixes in REST, but leave directory component for FILE."
+  "Strip suffixes in @var{rest}, but leave directory component for
+@var{file}."

   (define (inverse-basename x y) (basename y x))
   (simple-format #f "~a/~a" (dirname file)
                 (fold inverse-basename file rest)))
 
 (define-public (write-me message x)
   (define (inverse-basename x y) (basename y x))
   (simple-format #f "~a/~a" (dirname file)
                 (fold inverse-basename file rest)))
 
 (define-public (write-me message x)

-  "Return X.  Display MESSAGE and write X.  Handy for debugging,
-possibly turned off."
+  "Return @var{x}.  Display @var{message} and write @var{x}.
+Handy for debugging, possibly turned off."

   (display message) (write x) (newline) x)
 ;;  x)
 
   (display message) (write x) (newline) x)
 ;;  x)
 


@@ -705,7 +862,7 @@ possibly turned off."
   (cons (f (car x)) (f (cdr x))))
 
 (define-public (list-insert-separator lst between)
   (cons (f (car x)) (f (cdr x))))
 
 (define-public (list-insert-separator lst between)

-  "Create new list, inserting BETWEEN between elements of LIST"
+  "Create new list, inserting @var{between} between elements of @var{lst}."

   (define (conc x y )
     (if (eq? y #f)
        (list x)
   (define (conc x y )
     (if (eq? y #f)
        (list x)


@@ -745,7 +902,7 @@ possibly turned off."
 
 (define-public (binary-search start end getter target-val)
   (_i "Find the index between @var{start} and @var{end} (an integer)
 
 (define-public (binary-search start end getter target-val)
   (_i "Find the index between @var{start} and @var{end} (an integer)

-which will produce the closest match to @var{target-val} when
+which produces the closest match to @var{target-val} if

 applied to function @var{getter}.")
   (if (<= end start)
       start
 applied to function @var{getter}.")
   (if (<= end start)
       start


@@ -771,9 +928,9 @@ applied to function @var{getter}.")
   (string<? (symbol->string (car lst)) (symbol->string (car r))))
 
 (define-public (eval-carefully symbol module . default)
   (string<? (symbol->string (car lst)) (symbol->string (car r))))
 
 (define-public (eval-carefully symbol module . default)

-  "Check if all symbols in expr SYMBOL are reachable
-   in module MODULE. In that case evaluate, otherwise
-   print a warning and set an optional DEFAULT."
+  "Check whether all symbols in expr @var{symbol} are reachable
+in module @var{module}.  In that case evaluate, otherwise
+print a warning and set an optional @var{default}."

   (let* ((unavailable? (lambda (sym)
                          (not (module-defined? module sym))))
         (sym-unavailable (if (pair? symbol)
   (let* ((unavailable? (lambda (sym)
                          (not (module-defined? module sym))))
         (sym-unavailable (if (pair? symbol)


@@ -841,17 +998,12 @@ applied to function @var{getter}.")
     scaling))
 
 (define-public (version-not-seen-message input-file-name)
     scaling))
 
 (define-public (version-not-seen-message input-file-name)

-  (ly:message
-   "~a:0: ~a ~a"
-    input-file-name
-    (_ "warning:")
-    (format #f
-           (_ "no \\version statement found, please add~afor future compatibility")
-           (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))
+  (ly:warning-located
+    (ly:format "~a:0" input-file-name)
+    (_ "no \\version statement found, please add~afor future compatibility")
+    (format #f "\n\n\\version ~s\n\n" (lilypond-version))))

 
 (define-public (old-relative-not-used-message input-file-name)
 
 (define-public (old-relative-not-used-message input-file-name)

-  (ly:message
-   "~a:0: ~a ~a"
-    input-file-name
-    (_ "warning:")
+  (ly:warning-located
+    (ly:format "~a:0" input-file-name)

     (_ "old relative compatibility not used")))
     (_ "old relative compatibility not used")))