($(outdir)/%.pdf): add DVIPS_FLAGS. This will

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index ba4fcd9eb3f600a8ca06d37d8c444ae8853af9d5..bd268611b329f2a3164af726b3f4452dcacde656 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -1,17 +1,20 @@
-;;; lily.scm -- implement Scheme output routines for TeX and PostScript
+;;;; lily.scm -- implement Scheme output routines for TeX and PostScript
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c)  1998--2003 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c)  1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 ;;; Library functions
 
 
 (use-modules (ice-9 regex)
-            (srfi srfi-1)              ;lists
-            (srfi srfi-13)             ;strings
-            )
+            (ice-9 safe)
+            (oop goops)
+            (srfi srfi-1)  ; lists
+            (srfi srfi-13)) ; strings
+
+(define-public safe-module (make-safe-module))
 
 (define-public (myd k v) (display k) (display ": ") (display v) (display ", "))
 
@@ -81,6 +84,9 @@
 
 (define-public ZERO-MOMENT (ly:make-moment 0 1)) 
 
+(define-public (moment-min a b)
+  (if (ly:moment<? a b) a b))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; lily specific variables.
 (define-public default-script-alist '())
@@ -156,6 +162,42 @@
            (map-alist-keys func (cdr list)))
       ))
  
+;;;;;;;;;;;;;;;;
+;; hash
+
+
+
+(if (not (defined? 'hash-table?))      ; guile 1.6 compat
+    (begin
+      (define hash-table? vector?)
+
+      (define-public (hash-table->alist t)
+       "Convert table t to list"
+       (apply append
+              (vector->list t)
+              )))
+
+    ;; native hashtabs.
+    (begin
+      (define-public (hash-table->alist t)
+
+       (hash-fold (lambda (k v acc) (acons  k v  acc))
+                  '() t)
+       )
+      ))
+
+;; todo: code dup with C++. 
+(define-public (alist->hash-table l)
+  "Convert alist to table"
+  (let
+      ((m (make-hash-table (length l))))
+
+    (map (lambda (k-v)
+          (hashq-set! m (car k-v) (cdr k-v)))
+        l)
+
+    m))
+       
 
 
 ;;;;;;;;;;;;;;;;
@@ -176,14 +218,20 @@
 
 
 ;; TODO: use the srfi-1 partition function.
-(define-public (uniq-list list)
+(define-public (uniq-list l)
+  
   "Uniq LIST, assuming that it is sorted"
-  (if (null? list) '()
-      (if (null? (cdr list))
-         list
-         (if (equal? (car list) (cadr list))
-             (uniq-list (cdr list))
-             (cons (car list) (uniq-list (cdr list)))))))
+  (define (helper acc l) 
+    (if (null? l)
+       acc
+       (if (null? (cdr l))
+           (cons (car l) acc)
+           (if (equal? (car l) (cadr l))
+               (helper acc (cdr l))
+               (helper (cons (car l) acc)  (cdr l)))
+           )))
+  (reverse! (helper '() l) '()))
+
 
 (define (split-at-predicate predicate l)
  "Split L = (a_1 a_2 ... a_k b_1 ... b_k)
@@ -325,7 +373,7 @@ L1 is copied, L2 not.
   `(
     ("tex" . ("TeX output. The default output form." ,tex-output-expression))
     ("ps" . ("Direct postscript. Requires setting GS_LIB and GS_FONTPATH" ,ps-output-expression))
-    ("scm" . ("Scheme dump: debug scheme molecule expressions" ,write))
+    ("scm" . ("Scheme dump: debug scheme stencil expressions" ,write))
     ("sketch" . ("Bare bones Sketch output." ,sketch-output-expression))
     ("sodipodi" . ("Bare bones Sodipodi output." ,sodipodi-output-expression))
     ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
@@ -359,10 +407,11 @@ L1 is copied, L2 not.
        "chord-ignatzek-names.scm"
        "chord-entry.scm"
        "chord-generic-names.scm"
-       "molecule.scm"
+       "stencil.scm"
        "new-markup.scm"
        "bass-figure.scm"
        "music-functions.scm"
+       "part-combiner.scm"
        "define-music-properties.scm"
        "auto-beam.scm"
        "chord-name.scm"
@@ -370,7 +419,6 @@ L1 is copied, L2 not.
        "define-translator-properties.scm"
        "translation-functions.scm"
        "script.scm"
-       "drums.scm"
        "midi.scm"
 
        "beam.scm"
@@ -378,24 +426,22 @@ L1 is copied, L2 not.
        "slur.scm"
        "font.scm"
        
+       "define-markup-commands.scm"
        "define-grob-properties.scm"
        "define-grobs.scm"
        "define-grob-interfaces.scm"
 
        "paper.scm"
-       "bla.scm"
        ))
 
 
-       
-
-
 (set! type-p-name-alist
   `(
    (,boolean-or-symbol? . "boolean or symbol")
    (,boolean? . "boolean")
    (,char? . "char")
    (,grob-list? . "list of grobs")
+   (,hash-table? . "hash table")
    (,input-port? . "input port")
    (,integer? . "integer")
    (,list? . "list")
@@ -403,7 +449,7 @@ L1 is copied, L2 not.
    (,ly:dimension? . "dimension, in staff space")
    (,ly:dir? . "direction")
    (,ly:duration? . "duration")
-   (,ly:grob? . "grob (GRaphical OBject)")
+   (,ly:grob? . "layout object")
    (,ly:input-location? . "input location")
    (,ly:input-location? . "input location")   
    (,ly:moment? . "moment")
@@ -425,3 +471,35 @@ L1 is copied, L2 not.
    (,symbol? . "symbol")
    (,vector? . "vector")
    ))
+
+
+;; debug mem leaks
+
+(define gc-protect-stat-count 0)
+(define-public (dump-gc-protects)
+  (set! gc-protect-stat-count (1+ gc-protect-stat-count) )
+  
+  (display 
+   (map (lambda (y)
+         (let
+             ((x (car y))
+              (c (cdr y)))
+
+           (string-append
+            (string-join
+             (map object->string (list (object-address x) c x))
+             " ")
+            "\n")))
+
+         (sort
+          (hash-table->alist (ly:protects))
+          (lambda (a b)
+            (< (object-address (car a))
+               (object-address (car b)))))
+         
+         )
+      (open-file (string-append
+              "gcstat-" (number->string gc-protect-stat-count)
+              ".scm"
+              ) "w")))
+