]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/lily.scm
Merge branch 'master' of git+ssh://jneem@git.sv.gnu.org/srv/git/lilypond
[lilypond.git] / scm / lily.scm
index 32ab98e88e2a486b72c88d054380da72f3e9063b..401017181cb39d460a5453caa72ae343cfb3788e 100644 (file)
@@ -5,6 +5,14 @@
 ;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
+;; Internationalisation: (_i "to be translated") gets an entry in the
+;; POT file (gettext ) must be invoked explicitely to do the actual
+;; "translation".
+;;(define-macro (_i x) x)
+;;(define-macro-public _i (x) x)
+;;(define-public-macro _i (x) x)
+;; Abbrv-PWR!
+(defmacro-public _i (x) x)
 
 (define (define-scheme-options)
   (for-each (lambda (x)
              (check-internal-types #f "check every property assignment for types")
              (clip-systems #f "Generate cut-out snippets of a score")
              (debug-gc #f "dump memory debugging statistics")
-             (debug-gc-assert-parsed-dead
-              #f "for memory debugging: ensure that all refs to parsed objects are dead.")
+             (debug-gc-assert-parsed-dead #f "for memory debugging:
+ensure that all refs to parsed objects are dead.  This is an internal option, and is switched on automatically for -ddebug-gc.") 
              (debug-lexer #f "debug the flex lexer")
              (debug-midi #f "generate human readable MIDI")
              (debug-parser #f "debug the bison parser")
              (debug-skylines #f "debug skylines")
              (delete-intermediate-files #f
                                         "delete unusable PostScript files")
-             (dump-signatures #f "dump output signatures of each system")
+             (dump-profile #f "dump timing information for each file")
              (dump-tweaks #f "dump page layout and tweaks for each score having the tweak-key layout property set.")
+             (dump-signatures #f "dump output signatures of each system")
+             
+             (eps-box-padding #f "Pad EPS bounding box left edge by this much to guarantee alignment between systems")
+
              (gs-load-fonts #f
                            "load fonts via Ghostscript.")
+             (gui #f "running from gui; redirect stderr to log file")
+
              (include-book-title-preview #t "include book-titles in preview images.")
              (include-eps-fonts #t "Include fonts in separate-system EPS files.")
              (job-count #f "Process in parallel") 
-
-             (eps-box-padding #f "Pad EPS bounding box left edge by this much to guarantee alignment between systems")
-
-             (gui #f "running from gui; redirect stderr to log file")
              (log-file #f "redirect output to log FILE.log")
+
              (old-relative #f
                            "relative for simultaneous music works
 similar to chord syntax")
@@ -48,6 +59,7 @@ similar to chord syntax")
                           "experimental mechanism for remembering tweaks")
              (point-and-click #t "use point & click")
              (paper-size "a4" "the default paper size")
+             (pixmap-format "png16m" "GS format to use for pixel images")
              (protected-scheme-parsing #t "continue when finding errors in inline
 scheme are caught in the parser. If off, halt 
 on errors, and print a stack trace.")
@@ -106,6 +118,7 @@ on errors, and print a stack trace.")
 
 (if (ly:get-option 'verbose)
     (begin
+      (ly:set-option 'protected-scheme-parsing #f)
       (debug-enable 'debug)
       (debug-enable 'backtrace)
       (read-enable 'positions)))
@@ -139,7 +152,7 @@ on errors, and print a stack trace.")
     (if (ly:get-option 'verbose)
        (ly:progress "[~A" file-name))
     (if (not file-name)
-       (ly:error (_ "Can't find ~A") x))
+       (ly:error (_ "cannot find: ~A") x))
     (primitive-load file-name)
     (if (ly:get-option 'verbose)
        (ly:progress "]"))))
@@ -252,7 +265,7 @@ The syntax is the same as `define*-public'."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; init pitch system
 
-(ly:set-default-scale (ly:make-scale #(0 2 4 5 7 9 11)))
+(ly:set-default-scale (ly:make-scale #(0 1 2 5/2 7/2 9/2 11/2)))
 
 
 
@@ -346,9 +359,36 @@ The syntax is the same as `define*-public'."
        (,symbol? . "symbol")
        (,vector? . "vector")))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; timing
+
+(define (profile-measurements)
+  (let* ((t (times))
+        (stats (gc-stats)))
 
+    (list
+     (- (tms:utime t)
+       (ly:assoc-get 'gc-time-taken stats))
+
+     ;; difficult to put memory amount stats into here.
+     
+     )))
+
+(define (dump-profile name last this)
+  (let*
+      ((outname (format "~a.profile" (basename name ".ly")))
+       (diff (map (lambda (y) (apply - y)) (zip this last))))
+    
+    (ly:progress "\nWriting timing to ~a..." outname)
+    (format (open-file outname "w")
+           "time: ~a"
+           (car diff))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; debug mem leaks
 
+(define gc-dumping #f)
 (define gc-protect-stat-count 0)
 (define-public (dump-gc-protects)
   (set! gc-protect-stat-count (1+ gc-protect-stat-count))
@@ -363,6 +403,7 @@ The syntax is the same as `define*-public'."
                         ".scm"))
         (outfile    (open-file  out-file-name  "w")))
 
+    (set! gc-dumping #t)
     (display (format "Dumping GC statistics ~a...\n" out-file-name))
     (display
      (map (lambda (y)
@@ -390,6 +431,7 @@ The syntax is the same as `define*-public'."
          (ly:reset-all-fonts)
          (gc)
          (gc)
+         (display "Asserting dead objects\n")
          (ly:set-option 'debug-gc-assert-parsed-dead #t)
          (gc)
          (ly:set-option 'debug-gc-assert-parsed-dead #f)
@@ -423,6 +465,8 @@ The syntax is the same as `define*-public'."
        '(protected-objects bytes-malloced cell-heap-size
                           
                           )))
+
+    (set! gc-dumping #f)
     
     ))
 
@@ -532,12 +576,20 @@ The syntax is the same as `define*-public'."
        ))
   
   (let* ((failed '())
+        (start-measurements #f)
         (handler (lambda (key failed-file)
                    (set! failed (append (list failed-file) failed)))))
 
     (for-each
      (lambda (x)
+
+       (gc)
+       (set! start-measurements (profile-measurements))
        (lilypond-file handler x)
+       (if (ly:get-option 'dump-profile)
+          (dump-profile x start-measurements (profile-measurements)))
+       
+       
        (ly:clear-anonymous-modules)
        (if (ly:get-option 'debug-gc)
           (dump-gc-protects)