Issue 4997/5: Use Preinit in Engraver_group

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

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 9008831c722316ad8b45ed8835c0457548d66a69..214c095cf2c720c0429cb8dfc6b753acc1304b77 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--2014 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2015 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


@@ -37,17 +37,6 @@
 (define-public DOWN -1)
 (define-public CENTER 0)
 
 (define-public DOWN -1)
 (define-public CENTER 0)
 

-(define-safe-public DOUBLE-FLAT-QTS -4)
-(define-safe-public THREE-Q-FLAT-QTS -3)
-(define-safe-public FLAT-QTS -2)
-(define-safe-public SEMI-FLAT-QTS -1)
-(define-safe-public NATURAL-QTS 0)
-(define-safe-public SEMI-SHARP-QTS 1)
-(define-safe-public SHARP-QTS 2)
-(define-safe-public THREE-Q-SHARP-QTS 3)
-(define-safe-public DOUBLE-SHARP-QTS 4)
-(define-safe-public SEMI-TONE-QTS 2)
-

 (define-safe-public DOUBLE-FLAT  -1)
 (define-safe-public THREE-Q-FLAT -3/4)
 (define-safe-public FLAT -1/2)
 (define-safe-public DOUBLE-FLAT  -1)
 (define-safe-public THREE-Q-FLAT -3/4)
 (define-safe-public FLAT -1/2)


@@ -141,27 +130,25 @@ This supports historic use of @code{Completion_heads_engraver} to split
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; parser <-> output hooks.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; parser <-> output hooks.
 

-(define-public (collect-bookpart-for-book parser book-part)
+(define-public (collect-bookpart-for-book book-part)

   "Toplevel book-part handler."
   (define (add-bookpart book-part)
   "Toplevel book-part handler."
   (define (add-bookpart book-part)

-    (ly:parser-define!
-     parser 'toplevel-bookparts
-     (cons book-part (ly:parser-lookup parser 'toplevel-bookparts))))
+    (ly:parser-define! 'toplevel-bookparts
+     (cons book-part (ly:parser-lookup 'toplevel-bookparts))))

   ;; If toplevel scores have been found before this \bookpart,
   ;; add them first to a dedicated bookpart
   ;; If toplevel scores have been found before this \bookpart,
   ;; add them first to a dedicated bookpart

-  (if (pair? (ly:parser-lookup parser 'toplevel-scores))
+  (if (pair? (ly:parser-lookup 'toplevel-scores))

       (begin
         (add-bookpart (ly:make-book-part
       (begin
         (add-bookpart (ly:make-book-part

-                       (ly:parser-lookup parser 'toplevel-scores)))
-        (ly:parser-define! parser 'toplevel-scores (list))))
+                       (ly:parser-lookup 'toplevel-scores)))
+        (ly:parser-define! 'toplevel-scores (list))))

   (add-bookpart book-part))
 
   (add-bookpart book-part))
 

-(define-public (collect-scores-for-book parser score)
-  (ly:parser-define!
-   parser 'toplevel-scores
-   (cons score (ly:parser-lookup parser 'toplevel-scores))))
+(define-public (collect-scores-for-book score)
+  (ly:parser-define! 'toplevel-scores
+   (cons score (ly:parser-lookup 'toplevel-scores))))

 
 

-(define-public (collect-music-aux score-handler parser music)
+(define-public (collect-music-aux score-handler music)

   (define (music-property symbol)
     (ly:music-property music symbol #f))
   (cond ((music-property 'page-marker)
   (define (music-property symbol)
     (ly:music-property music symbol #f))
   (cond ((music-property 'page-marker)


@@ -182,54 +169,52 @@ This supports historic use of @code{Completion_heads_engraver} to split
         ((not (music-property 'void))
          ;; a regular music expression: make a score with this music
          ;; void music is discarded
         ((not (music-property 'void))
          ;; a regular music expression: make a score with this music
          ;; void music is discarded

-         (score-handler (scorify-music music parser)))))
+         (score-handler (scorify-music music)))))

 
 

-(define-public (collect-music-for-book parser music)
+(define-public (collect-music-for-book music)

   "Top-level music handler."
   (collect-music-aux (lambda (score)
   "Top-level music handler."
   (collect-music-aux (lambda (score)

-                       (collect-scores-for-book parser score))
-                     parser
+                       (collect-scores-for-book score))

                      music))
 
                      music))
 

-(define-public (collect-book-music-for-book parser book music)
+(define-public (collect-book-music-for-book book music)

   "Book music handler."
   (collect-music-aux (lambda (score)
                        (ly:book-add-score! book score))
   "Book music handler."
   (collect-music-aux (lambda (score)
                        (ly:book-add-score! book score))

-                     parser

                      music))
 
                      music))
 

-(define-public (scorify-music music parser)
+(define-public (scorify-music music)

   "Preprocess @var{music}."
   (ly:make-score
   "Preprocess @var{music}."
   (ly:make-score

-   (fold (lambda (f m) (f m parser))
+   (fold (lambda (f m) (f m))

          music
          toplevel-music-functions)))
 
          music
          toplevel-music-functions)))
 

-(define (get-current-filename parser book)
+(define (get-current-filename 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"

-  (or (paper-variable parser book 'output-filename)
-      (ly:parser-output-name parser)))
+  (or (paper-variable book 'output-filename)
+      (ly:parser-output-name)))

 
 

-(define (get-current-suffix parser book)
+(define (get-current-suffix 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 (paper-variable parser book 'output-suffix)))
+  (let ((book-output-suffix (paper-variable book 'output-suffix)))

     (if (not (string? book-output-suffix))
     (if (not (string? book-output-suffix))

-        (ly:parser-lookup parser 'output-suffix)
+        (ly:parser-lookup 'output-suffix)

         book-output-suffix)))
 
 (define-public current-outfile-name #f)  ; for use by regression tests
 
         book-output-suffix)))
 
 (define-public current-outfile-name #f)  ; for use by regression tests
 

-(define (get-outfile-name parser book)
+(define (get-outfile-name 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 book))
-         (output-suffix (get-current-suffix parser book))
+  (let* ((base-name (get-current-filename book))
+         (output-suffix (get-current-suffix book))

          (alist-key (format #f "~a~a" base-name output-suffix))
          (alist-key (format #f "~a~a" base-name output-suffix))

-         (counter-alist (ly:parser-lookup parser 'counter-alist))
+         (counter-alist (ly:parser-lookup 'counter-alist))

          (output-count (assoc-get alist-key counter-alist 0))
          (result base-name))
     ;; Allow all ASCII alphanumerics, including accents
          (output-count (assoc-get alist-key counter-alist 0))
          (result base-name))
     ;; Allow all ASCII alphanumerics, including accents


@@ -246,64 +231,62 @@ bookoutput function"
     (if (> output-count 0)
         (set! result (format #f "~a-~a" result output-count)))
 
     (if (> output-count 0)
         (set! result (format #f "~a-~a" result output-count)))
 

-    (ly:parser-define!
-     parser 'counter-alist
+    (ly:parser-define! 'counter-alist

      (assoc-set! counter-alist alist-key (1+ output-count)))
     (set! current-outfile-name result)
     result))
 
      (assoc-set! counter-alist alist-key (1+ output-count)))
     (set! current-outfile-name result)
     result))
 

-(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 book)))
+(define (print-book-with book process-procedure)
+  (let* ((paper (ly:parser-lookup '$defaultpaper))
+         (layout (ly:parser-lookup '$defaultlayout))
+         (outfile-name (get-outfile-name book)))

     (process-procedure book paper layout outfile-name)))
 
     (process-procedure book paper layout outfile-name)))
 

-(define-public (print-book-with-defaults parser book)
-  (print-book-with parser book ly:book-process))
+(define-public (print-book-with-defaults book)
+  (print-book-with book ly:book-process))

 
 

-(define-public (print-book-with-defaults-as-systems parser book)
-  (print-book-with parser book ly:book-process-to-systems))
+(define-public (print-book-with-defaults-as-systems book)
+  (print-book-with book ly:book-process-to-systems))

 
 ;; Add a score to the current bookpart, book or toplevel
 
 ;; Add a score to the current bookpart, book or toplevel

-(define-public (add-score parser score)
+(define-public (add-score score)

   (cond
   (cond

-   ((ly:parser-lookup parser '$current-bookpart)
-    ((ly:parser-lookup parser 'bookpart-score-handler)
-     (ly:parser-lookup parser '$current-bookpart) score))
-   ((ly:parser-lookup parser '$current-book)
-    ((ly:parser-lookup parser 'book-score-handler)
-     (ly:parser-lookup parser '$current-book) score))
+   ((ly:parser-lookup '$current-bookpart)
+    ((ly:parser-lookup 'bookpart-score-handler)
+     (ly:parser-lookup '$current-bookpart) score))
+   ((ly:parser-lookup '$current-book)
+    ((ly:parser-lookup 'book-score-handler)
+     (ly:parser-lookup '$current-book) score))

    (else
    (else

-    ((ly:parser-lookup parser 'toplevel-score-handler) parser score))))
+    ((ly:parser-lookup 'toplevel-score-handler) score))))

 
 (define-public paper-variable
   (let
       ((get-papers
 
 (define-public paper-variable
   (let
       ((get-papers

-        (lambda (parser book)
+        (lambda (book)

           (append (if (and book (ly:output-def? (ly:book-paper book)))
                       (list (ly:book-paper 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))))))
+                  (ly:parser-lookup '$papers)
+                  (list (ly:parser-lookup '$defaultpaper))))))

     (make-procedure-with-setter
     (make-procedure-with-setter

-     (lambda (parser book symbol)
+     (lambda (book symbol)

        (any (lambda (p) (ly:output-def-lookup p symbol #f))
        (any (lambda (p) (ly:output-def-lookup p symbol #f))

-            (get-papers parser book)))
-     (lambda (parser book symbol value)
+            (get-papers book)))
+     (lambda (book symbol value)

        (ly:output-def-set-variable!
        (ly:output-def-set-variable!

-        (car (get-papers parser book))
+        (car (get-papers book))

         symbol value)))))
 
         symbol value)))))
 

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

 
 

-(define-public (add-music parser music)
+(define-public (add-music music)

   (collect-music-aux (lambda (score)
   (collect-music-aux (lambda (score)

-                       (add-score parser score))
-                     parser
+                       (add-score score))

                      music))
 
                      music))
 

-(define-public (context-mod-from-music parser music)
+(define-public (context-mod-from-music music)

   (let ((warn #t) (mods (ly:make-context-mod)))
     (let loop ((m music))
       (if (music-is-of-type? m 'layout-instruction-event)
   (let ((warn #t) (mods (ly:make-context-mod)))
     (let loop ((m music))
       (if (music-is-of-type? m 'layout-instruction-event)


@@ -351,7 +334,7 @@ bookoutput function"
                          (set! warn #f)))))))))
     mods))
 
                          (set! warn #f)))))))))
     mods))
 

-(define-public (context-defs-from-music parser output-def music)
+(define-public (context-defs-from-music output-def music)

   (let ((warn #t))
     (let loop ((m music) (mods #f))
       ;; The parser turns all sets, overrides etc into something
   (let ((warn #t))
     (let loop ((m music) (mods #f))
       ;; The parser turns all sets, overrides etc into something


@@ -724,20 +707,16 @@ right (@var{dir}=+1)."
 (define-public (coord-scale coordinate amount)
   (coord-operation * amount coordinate))
 
 (define-public (coord-scale coordinate amount)
   (coord-operation * amount coordinate))
 

-(define-public (coord-rotate coordinate degrees-in-radians)
-  (let*
-      ((coordinate
-        (cons
-         (exact->inexact (coord-x coordinate))
-         (exact->inexact (coord-y coordinate))))
-       (radius
-        (sqrt
-         (+ (* (coord-x coordinate) (coord-x coordinate))
-            (* (coord-y coordinate) (coord-y coordinate)))))
-       (angle (angle-0-2pi (atan (coord-y coordinate) (coord-x coordinate)))))
-    (cons
-     (* radius (cos (+ angle degrees-in-radians)))
-     (* radius (sin (+ angle degrees-in-radians))))))
+(define-public (coord-rotate coordinate angle-in-radians)
+  (coord-rotated coordinate (/ angle-in-radians PI-OVER-180)))
+
+(define-public (coord-rotated coordinate direction)
+  ;; Same, in degrees or with a given direction
+  (let ((dir (ly:directed direction)))
+    (cons (- (* (car dir) (car coordinate))
+             (* (cdr dir) (cdr coordinate)))
+          (+ (* (car dir) (cdr coordinate))
+             (* (cdr dir) (car coordinate))))))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; trig
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; trig


@@ -752,11 +731,11 @@ right (@var{dir}=+1)."
 
 (define-public (cyclic-base-value value cycle)
   "Take @var{value} and modulo-maps it between 0 and base @var{cycle}."
 
 (define-public (cyclic-base-value value cycle)
   "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)
-          (cyclic-base-value (- value cycle) cycle)
-          value)))
+  (cond ((< value 0)
+         (cyclic-base-value (+ value cycle) cycle))
+        ((>= value cycle)
+         (cyclic-base-value (- value cycle) cycle))
+        (else value)))

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


@@ -783,14 +762,8 @@ right (@var{dir}=+1)."
 
 (define-public (polar->rectangular radius angle-in-degrees)
   "Return polar coordinates (@var{radius}, @var{angle-in-degrees})
 
 (define-public (polar->rectangular radius angle-in-degrees)
   "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))))
-    (cons
-     (real-part complex)
-     (imag-part complex))))
+as rectangular coordinates @code{(x-length . y-length)}."
+  (ly:directed angle-in-degrees radius))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; string
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; string


@@ -803,6 +776,12 @@ as rectangular coordinates @ode{(x-length . y-length)}."
 (define-public (string-startswith s prefix)
   (equal? prefix (substring s 0 (min (string-length s) (string-length prefix)))))
 
 (define-public (string-startswith s prefix)
   (equal? prefix (substring s 0 (min (string-length s) (string-length prefix)))))
 

+(define-public (remove-whitespace strg)
+"Remove characters satisfying @code{char-whitespace?} from string @var{strg}"
+  (string-delete
+    strg
+    char-whitespace?))
+

 (define-public (string-encode-integer i)
   (cond
    ((= i  0) "o")
 (define-public (string-encode-integer i)
   (cond
    ((= i  0) "o")


@@ -1039,3 +1018,10 @@ print a warning and set an optional @var{default}."
    (ly:format "~a:1" input-file-name)
    (_ "no \\version statement found, please add~afor future compatibility")
    (format #f "\n\n\\version ~s\n\n" (lilypond-version))))
    (ly:format "~a:1" input-file-name)
    (_ "no \\version statement found, please add~afor future compatibility")
    (format #f "\n\n\\version ~s\n\n" (lilypond-version))))

+
+(define-public (output-module? module)
+  "Returns @code{#t} if @var{module} belongs to an output module
+usually carrying context definitions (@code{\\midi} or
+@code{\\layout})."
+  (or (module-ref module 'is-midi #f)
+      (module-ref module 'is-layout #f)))