release commit

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index 7aa5cbdc17d4487cc446a3b7cb2469e38ae11e63..add6bfee8bd9f307017833c9b09c7597d3dac7fd 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -14,11 +14,15 @@
             )
 
 ;;; General settings
-;; debugging evaluator is slower.
+;;; debugging evaluator is slower.  This should
+;;; have a more sensible default.
 
-(debug-enable 'debug)
-;(debug-enable 'backtrace)
-(read-enable 'positions)
+
+(if (ly:get-option 'verbose)
+    (begin
+      (debug-enable 'debug)
+      (debug-enable 'backtrace)
+      (read-enable 'positions)))
 
 
 (define-public (line-column-location line col file)
@@ -34,6 +38,16 @@
 
 (define-public point-and-click #f)
 
+(define-public (lilypond-version)
+  (string-join
+   (map (lambda (x) (if (symbol? x)
+                       (symbol->string x)
+                       (number->string x)))
+               (ly:version))
+   "."))
+
+
+
 ;; cpp hack to get useful error message
 (define ifdef "First run this through cpp.")
 (define ifndef "First run this through cpp.")
@@ -52,6 +66,19 @@
 (define-public DOWN -1)
 (define-public CENTER 0)
 
+(define-public DOUBLE-FLAT -4)
+(define-public THREE-Q-FLAT -3)
+(define-public FLAT -2)
+(define-public SEMI-FLAT -1)
+(define-public NATURAL 0)
+(define-public SEMI-SHARP 1)
+(define-public SHARP 2)
+(define-public THREE-Q-SHARP 3)
+(define-public DOUBLE-SHARP 4)
+(define-public SEMI-TONE 2)
+
+(define-public ZERO-MOMENT (ly:make-moment 0 1)) 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; lily specific variables.
 (define-public default-script-alist '())
@@ -102,6 +129,33 @@
            handle
            (chain-assoc x (cdr alist-list))))))
 
+(define (chain-assoc-get x alist-list default)
+  (if (null? alist-list)
+      default
+      (let* ((handle (assoc x (car alist-list))))
+       (if (pair? handle)
+           (cdr handle)
+           (chain-assoc-get x (cdr alist-list) default)))))
+
+
+(define (map-alist-vals func list)
+  "map FUNC over the vals of  LIST, leaving the keys."
+  (if (null?  list)
+      '()
+      (cons (cons  (caar list) (func (cdar 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. "
+  (if (null?  list)
+      '()
+      (cons (cons (func (caar list)) (cdar list))
+           (map-alist-keys func (cdr list)))
+      ))
+ 
+
+
 ;;;;;;;;;;;;;;;;
 ; list
 
@@ -121,6 +175,7 @@
 
 ;; TODO: use the srfi-1 partition function.
 (define-public (uniq-list list)
+  "Uniq LIST, assuming that it is sorted"
   (if (null? list) '()
       (if (null? (cdr list))
          list
@@ -199,10 +254,14 @@ L1 is copied, L2 not.
   (remainder (+ a 1) 2))
   
 
-(define-public (widen-interval iv amount)
+(define-public (interval-widen iv amount)
    (cons (- (car iv) amount)
-         (+ (cdr iv) amount))
-)
+         (+ (cdr iv) amount)))
+
+(define-public (interval-union i1 i2)
+   (cons (min (car i1) (car i2))
+        (max (cdr i1) (cdr i2))))
+
 
 (define-public (write-me message x)
   "Return X.  Display MESSAGE and write X.  Handy for debugging, possibly turned off."
@@ -218,25 +277,15 @@ L1 is copied, L2 not.
   "map F to contents of X"
   (cons (f (car x)) (f (cdr x))))
 
-;; TODO: remove.
-(define-public (reduce-no-unit operator list)
-  "reduce OP [A, B, C, D, ... ] =
-   A op (B op (C ... ))
-"
-      (if (null? (cdr list)) (car list)
-         (operator (car list) (reduce-no-unit operator (cdr list)))))
 
-(define-public (list-insert-separator list between)
+(define-public (list-insert-separator lst between)
   "Create new list, inserting BETWEEN between elements of LIST"
-  (if (null? list)
-      '()
-      (if (null? (cdr list))
-         list
-         (cons (car list)
-               (cons between (list-insert-separator (cdr list) between)))
-  
-  )))
-
+  (define (conc x y )
+    (if (eq? y #f)
+       (list x)
+       (cons x  (cons between y))
+       ))
+  (fold-right conc #f lst))
 
 ;;;;;;;;;;;;;;;;
 ; other
@@ -253,7 +302,7 @@ L1 is copied, L2 not.
         (fn (%search-load-path x))
 
         )
-    (if (ly:verbose)
+    (if (ly:get-option 'verbose)
        (format (current-error-port) "[~A]" fn))
     (primitive-load fn)))
 
@@ -337,34 +386,36 @@ L1 is copied, L2 not.
 
 (set! type-p-name-alist
   `(
-   (,ly:dir? . "direction")
-   (,scheme? . "any type")
-   (,number-pair? . "pair of numbers")
-   (,ly:input-location? . "input location")   
-   (,ly:grob? . "grob (GRaphical OBject)")
+   (,boolean-or-symbol? . "boolean or symbol")
+   (,boolean? . "boolean")
+   (,char? . "char")
    (,grob-list? . "list of grobs")
-   (,ly:duration? . "duration")
-   (,pair? . "pair")
+   (,input-port? . "input port")
    (,integer? . "integer")
    (,list? . "list")
-   (,symbol? . "symbol")
-   (,string? . "string")
-   (,boolean? . "boolean")
-   (,ly:pitch? . "pitch")
-   (,ly:moment? . "moment")
+   (,ly:context? . "context")
    (,ly:dimension? . "dimension, in staff space")
+   (,ly:dir? . "direction")
+   (,ly:duration? . "duration")
+   (,ly:grob? . "grob (GRaphical OBject)")
    (,ly:input-location? . "input location")
-   (,music-list? . "list of music")
+   (,ly:input-location? . "input location")   
+   (,ly:moment? . "moment")
    (,ly:music? . "music")
+   (,ly:pitch? . "pitch")
+   (,ly:translator? . "translator")
+   (,markup-list? . "list of markups")
+   (,markup? . "markup")
+   (,music-list? . "list of music")
+   (,number-or-grob? . "number or grob")
+   (,number-or-string? . "number or string")
+   (,number-pair? . "pair of numbers")
    (,number? . "number")
-   (,char? . "char")
-   (,input-port? . "input port")
    (,output-port? . "output port")   
-   (,vector? . "vector")
+   (,pair? . "pair")
    (,procedure? . "procedure") 
-   (,boolean-or-symbol? . "boolean or symbol")
-   (,number-or-string? . "number or string")
-   (,markup? . "markup")
-   (,markup-list? . "list of markups")
-   (,number-or-grob? . "number or grob")
+   (,scheme? . "any type")
+   (,string? . "string")
+   (,symbol? . "symbol")
+   (,vector? . "vector")
    ))