X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=c9914981a821f467254c3379e48b4e2cd7db85c0;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=ce1936fd9089a1cb914a06952623f5dae474438c;hpb=06179214e6e296a7befd73b6eb84d09ce5c98a19;p=lilypond.git

diff --git a/scm/lily.scm b/scm/lily.scm
index ce1936fd90..c9914981a8 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2008 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;; Internationalisation: (_i "to be translated") gets an entry in the
@@ -17,6 +17,11 @@
 (read-enable 'positions)
 (debug-enable 'debug)
 
+(define-public PLATFORM
+  (string->symbol
+   (string-downcase
+    (car (string-tokenize (utsname:sysname (uname)))))))
+
 (define scheme-options-definitions
   `(
 
@@ -40,7 +45,8 @@ ensure that all refs to parsed objects are dead.  This is an internal option, an
     (debug-skylines #f "debug skylines")
     (delete-intermediate-files #f
 			       "delete unusable PostScript files")
-    (dump-profile #f "dump timing information for each file")
+    (dump-profile #f "dump memory and time information for each file")
+    (dump-cpu-profile #f "dump timing information (system-dependent)")
     (dump-signatures #f "dump output signatures of each system.  Used for regression testing.")
     
     (eps-box-padding #f "Pad EPS bounding box left edge.  Guarantee alignment between systems in LaTeX.")
@@ -54,6 +60,10 @@ ensure that all refs to parsed objects are dead.  This is an internal option, an
     (include-eps-fonts #t "Include fonts in separate-system EPS files.")
     (job-count #f "Process in parallel") 
     (log-file #f "redirect output to log FILE.log")
+    (midi-extension ,(if (eq? PLATFORM 'windows)
+			 "mid"
+			 "midi")
+		    "set the default file extension for MIDI")
 
     (old-relative #f
 		  "relative for simultaneous music works
@@ -73,6 +83,7 @@ on errors, and print a stack trace.")
 
     (safe #f "Run safely")
     (strict-infinity-checking #f "If yes, crash on encountering Inf/NaN.")
+    (strip-output-dir #t "If yes, strip directories from input files.")
     (separate-log-files #f "Output to FILE.log per file.")
     (trace-memory-frequency #f "Record Scheme cell usage this many times per second, and dump to file.")
     (trace-scheme-coverage #f "Record coverage of Scheme files") 
@@ -139,7 +150,7 @@ on errors, and print a stack trace.")
 ;;; have a more sensible default.
 
 (if (or (ly:get-option 'verbose)
-	(ly:get-option 'trace-memory-frequencency)
+	(ly:get-option 'trace-memory-frequency)
 	(ly:get-option 'trace-scheme-coverage)
 	)
     (begin
@@ -157,14 +168,6 @@ on errors, and print a stack trace.")
 
 (define-public parser #f)
 
-(define-public (lilypond-version)
-  (string-join
-   (map (lambda (x) (if (symbol? x)
-			(symbol->string x)
-			(number->string x)))
-	(ly:version))
-   "."))
-
 
 ;; TeX C++ code actually hooks into TEX_STRING_HASHLIMIT 
 (define-public TEX_STRING_HASHLIMIT 10000000)
@@ -186,22 +189,6 @@ on errors, and print a stack trace.")
     (if (ly:get-option 'verbose)
 	(ly:progress "]"))))
 
-;; Cygwin
-;; #(CYGWIN_NT-5.1 Hostname 1.5.12(0.116/4/2) 2004-11-10 08:34 i686)
-;;
-;; Debian
-;; #(Linux hostname 2.4.27-1-686 #1 Fri Sep 3 06:28:00 UTC 2004 i686)
-;;
-;; Mingw
-;; #(Windows XP HOSTNAME build 2600 5.01 Service Pack 1 i686)
-;;
-
-;; ugh, code dup.
-(define-public PLATFORM
-  (string->symbol
-   (string-downcase
-    (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
-
 (define-public DOS
   (let ((platform (string-tokenize
 		   (vector-ref (uname) 0) char-set:letter+digit)))
@@ -291,6 +278,14 @@ The syntax is the same as `define*-public'."
                                 safe-objects))
        ,safe-symbol)))
 
+(define-safe-public (lilypond-version)
+  (string-join
+   (map (lambda (x) (if (symbol? x)
+			(symbol->string x)
+			(number->string x)))
+	(ly:version))
+   "."))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; init pitch system
 
@@ -335,8 +330,11 @@ The syntax is the same as `define*-public'."
 	    "font.scm"
 	    "encoding.scm"
 	    
+	    "flag-styles.scm"
 	    "fret-diagrams.scm"
-	    "define-markup-commands.scm"
+	    "harp-pedals.scm"
+	    "predefined-fretboards.scm"
+            "define-markup-commands.scm"
 	    "define-grob-properties.scm"
 	    "define-grobs.scm"
 	    "define-grob-interfaces.scm"
@@ -409,13 +407,15 @@ The syntax is the same as `define*-public'."
 
 (define (dump-profile base last this)
   (let*
-      ((outname (format "~a.profile" (basename base ".ly")))
+      ((outname (format "~a.profile" (dir-basename base ".ly")))
        (diff (map (lambda (y) (apply - y)) (zip this last))))
     
     (ly:progress "\nWriting timing to ~a..." outname)
     (format (open-file outname "w")
 	    "time: ~a\ncells: ~a\n"
-	    (car diff)
+	    (if (ly:get-option 'dump-cpu-profile)
+		(car diff)
+		0)
 	    (cadr diff)
 	    )))
 
@@ -542,6 +542,8 @@ The syntax is the same as `define*-public'."
 
 
 (define (multi-fork count)
+  "Split this process in COUNT helpers. Returns either a list of pids,
+or the number of the process."
   (define (helper count acc)
     (if (> count 0)
       (let*
@@ -556,7 +558,6 @@ The syntax is the same as `define*-public'."
 (define-public (lilypond-main files)
   "Entry point for LilyPond."
 
-
   (eval-string (ly:command-line-code))
 
   (if (ly:get-option 'help)
@@ -590,7 +591,6 @@ The syntax is the same as `define*-public'."
   
   (if (and (number? (ly:get-option 'job-count))
 	   (>= (length files) (ly:get-option 'job-count)))
-      
       (let*
 	  ((count (ly:get-option 'job-count))
 	   (split-todo (split-list files count)) 
@@ -602,8 +602,9 @@ The syntax is the same as `define*-public'."
 	
 	(if (number? joblist)
 	    (begin
-	      (ly:set-option 'log-file (format "~a-~a"
-					       (ly:get-option 'log-file) joblist))
+	      (ly:set-option
+	       'log-file (format "~a-~a"
+				 (ly:get-option 'log-file) joblist))
 	      (set! files (vector-ref split-todo joblist)))
 
 	    (begin
@@ -613,25 +614,29 @@ The syntax is the same as `define*-public'."
 		 (let* ((stat (cdr (waitpid pid))))
 		   
 		   (if (not (= stat 0))
-		       (set! errors (acons (list-element-index joblist pid) stat errors)))))
+		       (set! errors
+			     (acons (list-element-index joblist pid)
+				    stat errors)))))
 	       joblist)
 
 	      (for-each
 	       (lambda (x)
 		 (let* ((job (car x))
 			(state (cdr x))
-			(logfile  (format "~a-~a.log"
+			(logfile (format "~a-~a.log"
 					  (ly:get-option 'log-file) job))
 			(log (ly:gulp-file logfile))
 			(len (string-length log))
 			(tail (substring  log (max 0 (- len 1024)))))
 
 		   (if (status:term-sig state)
-		       (ly:message "\n\n~a\n"
-				   (format (_ "job ~a terminated with signal: ~a")
-					   job
-					   (status:term-sig state)))
-		       (ly:message (_ "logfile ~a (exit ~a):\n~a") logfile (status:exit-val state) tail))))
+		       (ly:message
+			"\n\n~a\n"
+			(format (_ "job ~a terminated with signal: ~a")
+				job (status:term-sig state)))
+		       (ly:message
+			(_ "logfile ~a (exit ~a):\n~a")
+			logfile (status:exit-val state) tail))))
 
 	       errors)
 
@@ -643,18 +648,15 @@ The syntax is the same as `define*-public'."
 		  (dump-profile "lily-run-total" '(0 0) (profile-measurements)))
 
 	    (exit (if (null? errors) 0 1))))))
-	      
 	   
   (if (string-or-symbol? (ly:get-option 'log-file))
       (ly:stderr-redirect (format "~a.log" (ly:get-option 'log-file)) "w"))
-
   
   (let ((failed (lilypond-all files)))
     (if (ly:get-option 'trace-scheme-coverage)
 	(begin
 	  (coverage:show-all (lambda (f) (string-contains f "lilypond"))
 			     )))
-	  
     
     (if (pair? failed)
 	(begin
@@ -668,6 +670,11 @@ The syntax is the same as `define*-public'."
 (define-public (lilypond-all files)
   (let* ((failed '())
 	 (separate-logs (ly:get-option 'separate-log-files))
+	 (ping-log
+	  (if separate-logs
+	      (open-file (if (string-or-symbol? (ly:get-option 'log-file))
+			     (format "~a.log" (ly:get-option 'log-file))
+			     "/dev/tty") "a") #f))
 	 (do-measurements (ly:get-option 'dump-profile))
 	 (handler (lambda (key failed-file)
 		    (set! failed (append (list failed-file) failed)))))
@@ -679,11 +686,14 @@ The syntax is the same as `define*-public'."
 	   ((start-measurements (if do-measurements
 				    (profile-measurements)
 				    #f))
-	    (base (basename x ".ly"))
+	    (base (dir-basename x ".ly"))
 	    (all-settings (ly:all-options)))
 
 	 (if separate-logs
 	     (ly:stderr-redirect (format "~a.log" base) "w"))
+	 (if ping-log
+	     (format ping-log "Procesing ~a\n" base))
+	      
 	 (if (ly:get-option 'trace-memory-frequency) 
 	     (mtrace:start-trace  (ly:get-option 'trace-memory-frequency)))
 	 
@@ -715,12 +725,9 @@ The syntax is the same as `define*-public'."
      files)
 
     ;; we want the failed-files notice in the aggregrate logfile.
-    (if (ly:get-option 'separate-logs)
-	(ly:stderr-redirect
-	 (if (string-or-symbol? (ly:get-option 'log-file))
-	     (format "~a.log" (ly:get-option 'log-file))
-	     "/dev/tty") "a"))
-
+    (if ping-log
+	(format ping-log "Failed files: ~a\n" failed))
+	 
     (if (ly:get-option 'dump-profile)
 	(dump-profile "lily-run-total" '(0 0) (profile-measurements)))
 
@@ -738,7 +745,7 @@ The syntax is the same as `define*-public'."
       (gui-no-files-handler))
 
   (if (not (string? (ly:get-option 'log-file)))
-      (let* ((base (basename (car files) ".ly"))
+      (let* ((base (dir-basename (car files) ".ly"))
 	     (log-name (string-append base ".log")))
 	(if (not (ly:get-option 'gui))
 	    (ly:message (_ "Redirecting output to ~a...") log-name))