lilypond-data 2.14.2-4 / usr / share / lilypond / 2.14.2 / scm / lily.scm

;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; LilyPond is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.

;; Internationalisation: (_i "to be translated") gets an entry in the
;; POT file; (gettext ...) must be invoked explicitly 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)

(read-enable 'positions)

(define-public PLATFORM
  (string->symbol
   (string-downcase
    (car (string-tokenize (utsname:sysname (uname)))))))

(define scheme-options-definitions
  `(
    ;; NAMING: either

    ;; - [subject-]object-object-verb +"ing"
    ;; - [subject-]-verb-object-object

    ;; Avoid overlong lines in `lilypond -dhelp'!  Strings should not
    ;; be longer than 48 characters per line.

    (anti-alias-factor 1
"Render at higher resolution (using given factor)
and scale down result to prevent jaggies in
PNG images.")
    (aux-files #t
"Create .tex, .texi, .count files in the
EPS backend.")
    (backend ps
"Select backend.  Possible values: 'eps, 'null,
'ps, 'scm, 'socket, 'svg.")
    (check-internal-types #f
"Check every property assignment for types.")
    (clip-systems #f
"Generate cut-out snippets of a score.")
    (datadir #f
"LilyPond prefix for data files (read-only).")
    (debug-gc #f
"Dump memory debugging statistics.")
    (debug-gc-assert-parsed-dead #f
"For memory debugging: Ensure that all
references 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-page-breaking-scoring #f
"Dump scores for many different page breaking
configurations.")
    (debug-parser #f
"Debug the bison parser.")
    (debug-property-callbacks #f
"Debug cyclic callback chains.")
    (debug-skylines #f
"Debug skylines.")
    (delete-intermediate-files #t
"Delete unusable, intermediate PostScript files.")
    (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 left edge of the output EPS bounding box by
given amount (in mm).")
    (gs-load-fonts #f
"Load fonts via Ghostscript.")
    (gs-load-lily-fonts #f
"Load only LilyPond fonts via Ghostscript.")
    (gui #f
"Run LilyPond from a GUI and redirect stderr to
a log file.")
    (help #f
"Show this help.")
    (include-book-title-preview #t
"Include book titles in preview images.")
    (include-eps-fonts #t
"Include fonts in separate-system EPS files.")
    (include-settings #f
"Include file for global settings, included before the score is processed.")
    (job-count #f
"Process in parallel, using the given number of
jobs.")
    (log-file #f
"If string FOO is given as argument, redirect
output to log file `FOO.log'.")
    (midi-extension ,(if (eq? PLATFORM 'windows)
			 "mid"
			 "midi")
"Set the default file extension for MIDI output
file to given string.")
    (music-strings-to-paths #f
"Convert text strings to paths when glyphs belong
to a music font.")
    (old-relative #f
"Make \\relative mode for simultaneous music work
similar to chord syntax.")
    (point-and-click #t
"Add point & click links to PDF output.")
    (paper-size "a4"
"Set default paper size.")
    (pixmap-format "png16m"
"Set GhostScript's output format for pixel images.")
    (preview #f
"Create preview images also.")
    (print-pages #t
"Print pages in the normal way.")
    (protected-scheme-parsing #t
"Continue when errors in inline scheme are caught
in the parser.  If #f, halt on errors and print
a stack trace.")
    (profile-property-accesses #f
"Keep statistics of get_property() calls.")
    (resolution 101
"Set resolution for generating PNG pixmaps to
given value (in dpi).")
    (read-file-list #f
"Specify name of a file which contains a list of
input files to be processed.")
    (relative-includes #f
"When processing an \\include command, look for
the included file relative to the current file
(instead of the root file)")
    (safe #f
"Run in safer mode.")
    (separate-log-files #f
"For input files `FILE1.ly', `FILE2.ly', ...
output log data to files `FILE1.log',
`FILE2.log', ...")
    (show-available-fonts #f
"List available font names.")
    (strict-infinity-checking #f
"Force a crash on encountering Inf and NaN
floating point exceptions.")
    (strip-output-dir #t
"Don't use directories from input files while
constructing output file names.")
    (svg-woff #f
"Use woff font files in SVG backend.")
    (trace-memory-frequency #f
"Record Scheme cell usage this many times per
second.  Dump results to `FILE.stacks' and
`FILE.graph'.")
    (trace-scheme-coverage #f
"Record coverage of Scheme files in `FILE.cov'.")
    (verbose ,(ly:command-line-verbose?)
"Value of the --verbose flag (read-only).")
    (warning-as-error #f
"Change all warning and programming_error
messages into errors.")
    ))

;; Need to do this in the beginning.  Other parts of the Scheme
;; initialization depend on these options.

(for-each (lambda (x)
	    (ly:add-option (car x) (cadr x) (caddr x)))
	  scheme-options-definitions)

(for-each (lambda (x)
	    (ly:set-option (car x) (cdr x)))
	  (eval-string (ly:command-line-options)))

(debug-set! stack 0)

(if (defined? 'set-debug-cell-accesses!)
    (set-debug-cell-accesses! #f))

;;(set-debug-cell-accesses! 1000)

;;; Boolean thunk - are we integrating Guile V2.0 or higher with LilyPond?
(define-public (guile-v2)
  (string>? (version) "1.9.10"))

(use-modules (ice-9 regex)
	     (ice-9 safe)
	     (ice-9 format)
	     (ice-9 rdelim)
	     (ice-9 optargs)
	     (oop goops)
	     (srfi srfi-1)
	     (srfi srfi-13)
	     (srfi srfi-14)
	     (scm clip-region)
	     (scm memory-trace)
	     (scm coverage))

(define-public _ gettext)
;;; There are new modules defined in Guile V2.0 which we need to use.
;;
;;  Modules and scheme files loaded by lily.scm use currying
;;  in Guile V2 this needs a module which is not present in Guile V1.8
;;

(cond
  ((guile-v2)
   (if (ly:get-option 'verbose)
       (ly:message  (_ "Using (ice-9 curried-definitions) module\n")))
   (use-modules (ice-9 curried-definitions)))
  (else
    (if (ly:get-option 'verbose)
	(ly:message
	   (_ "Guile 1.8\n")))))

;; TODO add in modules for V1.8.7 deprecated in V2.0 and integrated
;; into Guile base code, like (ice-9 syncase).
;;

(define-public fancy-format
  format)

(define-public (ergonomic-simple-format dest . rest)
  "Like ice-9's @code{format}, but without the memory consumption."
  (if (string? dest)
      (apply simple-format (cons #f (cons dest rest)))
      (apply simple-format (cons dest rest))))

(define format
  ergonomic-simple-format)

;; my display
(define-public (myd k v)
  (display k)
  (display ": ")
  (display v)
  (display ", ")
  v)

(define-public (print . args)
  (apply format (cons (current-output-port) args)))


;;; General settings.
;;;
;;; Debugging evaluator is slower.  This should have a more sensible
;;; default.

(if (or (ly:get-option 'verbose)
	(ly:get-option 'trace-memory-frequency)
	(ly:get-option 'trace-scheme-coverage))
    (begin
      (ly:set-option 'protected-scheme-parsing #f)
      (debug-enable 'backtrace)
      (read-enable 'positions)))

(if (ly:get-option 'trace-scheme-coverage)
    (coverage:enable))

(define-public parser #f)

(define music-string-to-path-backends
  '(svg))

(if (memq (ly:get-option 'backend) music-string-to-path-backends)
    (ly:set-option 'music-strings-to-paths #t))


(define-public (ly:load x)
  (let* ((file-name (%search-load-path x)))
    (if (ly:get-option 'verbose)
	(ly:progress "[~A" file-name))
    (if (not file-name)
	(ly:error (_ "cannot find: ~A") x))
    (primitive-load-path file-name)  ;; to support Guile V2 autocompile
    (if (ly:get-option 'verbose)
	(ly:progress "]\n"))))

(define-public DOS
  (let ((platform (string-tokenize
		   (vector-ref (uname) 0) char-set:letter+digit)))
    (if (null? (cdr platform)) #f
	(member (string-downcase (cadr platform)) '("95" "98" "me")))))

(define (slashify x)
  (if (string-index x #\\)
      x
      (string-regexp-substitute
	"//*" "/"
	(string-regexp-substitute "\\\\" "/" x))))

(define-public (ly-getcwd)
  (if (eq? PLATFORM 'windows)
      (slashify (getcwd))
      (getcwd)))

(define-public (is-absolute? file-name)
  (let ((file-name-length (string-length file-name)))
    (if (= file-name-length 0)
	#f
	(or (eq? (string-ref file-name 0) #\/)
	    (and (eq? PLATFORM 'windows)
		 (> file-name-length 2)
		 (eq? (string-ref file-name 1) #\:)
		 (eq? (string-ref file-name 2) #\/))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; If necessary, emulate Guile V2 module_export_all! for Guile V1.8.n
(cond-expand
 ((not guile-v2)
  (define (module-export-all! mod)
    (define (fresh-interface!)
      (let ((iface (make-module)))
	(set-module-name! iface (module-name mod))
	;; for guile 2: (set-module-version! iface (module-version mod))
	(set-module-kind! iface 'interface)
	(set-module-public-interface! mod iface)
	iface))
    (let ((iface (or (module-public-interface mod)
		     (fresh-interface!))))
      (set-module-obarray! iface (module-obarray mod))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (type-check-list location signature arguments)
  "Typecheck a list of arguments against a list of type predicates.
Print a message at LOCATION if any predicate failed."
  (define (recursion-helper signature arguments count)
    (define (helper pred? arg count)
      (if (not (pred? arg))
	  (begin
	    (ly:input-message
	     location
	     (format
	      #f (_ "wrong type for argument ~a.  Expecting ~a, found ~s")
	      count (type-name pred?) arg))
	    #f)
	  #t))

    (if (null? signature)
	#t
	(and (helper (car signature) (car arguments) count)
	     (recursion-helper (cdr signature) (cdr arguments) (1+ count)))))
  (recursion-helper signature arguments 1))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Safe definitions utility

(define safe-objects
  (list))

(define-macro (define-safe-public arglist . body)
  "Define a variable, export it, and mark it as safe, i.e. usable in
LilyPond safe mode.  The syntax is the same as `define*-public'."
  (define (get-symbol arg)
    (if (pair? arg)
        (get-symbol (car arg))
        arg))

  (let ((safe-symbol (get-symbol arglist)))
    `(begin
       (define*-public ,arglist
         ,@body)
       (set! safe-objects (cons (cons ',safe-symbol ,safe-symbol)
                                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

(ly:set-default-scale (ly:make-scale #(0 1 2 5/2 7/2 9/2 11/2)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; other files.

(define init-scheme-files
  '("lily-library.scm"
    "file-cache.scm"
    "define-event-classes.scm"
    "define-music-callbacks.scm"
    "define-music-types.scm"
    "define-note-names.scm"
    "output-lib.scm"
    "c++.scm"
    "chord-ignatzek-names.scm"
    "chord-entry.scm"
    "chord-generic-names.scm"
    "stencil.scm"
    "markup.scm"
    "modal-transforms.scm"
    "music-functions.scm"
    "part-combiner.scm"
    "autochange.scm"
    "define-music-properties.scm"
    "time-signature-settings.scm"
    "auto-beam.scm"
    "bezier-tools.scm"
    "parser-ly-from-scheme.scm"
    "ly-syntax-constructors.scm"

    "define-context-properties.scm"
    ;; guile 1.9 wants markups defined before referenced
    "define-markup-commands.scm"

    "chord-name.scm"
    "translation-functions.scm"
    "script.scm"
    "midi.scm"
    "layout-beam.scm"
    "parser-clef.scm"
    "layout-slur.scm"
    "font.scm"
    "encoding.scm"

    "flag-styles.scm"
    "fret-diagrams.scm"
    "tablature.scm"
    "harp-pedals.scm"
    "define-woodwind-diagrams.scm"
    "display-woodwind-diagrams.scm"
    "predefined-fretboards.scm"
    "define-grob-properties.scm"
    "define-grobs.scm"
    "define-grob-interfaces.scm"
    "define-stencil-commands.scm"
    "titling.scm"

    "paper.scm"
    "backend-library.scm"
    "x11-color.scm"

    ;; must be after everything has been defined
    "safe-lily.scm"))

(for-each ly:load init-scheme-files)

(define-public r5rs-primary-predicates
  `((,boolean? . "boolean")
    (,char? . "character")
    (,number? . "number")
    (,pair? . "pair")
    (,port? . "port")
    (,procedure? . "procedure")
    (,string? . "string")
    (,symbol? . "symbol")
    (,vector? . "vector")))

(define-public r5rs-secondary-predicates
  `((,char-alphabetic? . "alphabetic character")
    (,char-lower-case? . "lower-case character")
    (,char-numeric? . "numeric character")
    (,char-upper-case? . "upper-case character")
    (,char-whitespace? . "whitespace character")

    (,complex? . "complex number")
    (,even? . "even number")
    (,exact? . "exact number")
    (,inexact? . "inexact number")
    (,integer? . "integer")
    (,negative? . "negative number")
    (,odd? . "odd number")
    (,positive? . "positive number")
    (,rational? . "rational number")
    (,real? . "real number")
    (,zero? . "zero")

    (,list? . "list")
    (,null? . "null")

    (,input-port? . "input port")
    (,output-port? . "output port")

    ;; would this ever be used?
    (,eof-object? . "end-of-file object")
    ))

(define-public guile-predicates
  `((,hash-table? . "hash table")
  ))

(define-public lilypond-scheme-predicates
  `((,boolean-or-symbol? . "boolean or symbol")
    (,color? . "color")
    (,cheap-list? . "list")
    (,grob-list? . "list of grobs")
    ;; this is built on cheap-list
    (,list-or-symbol? . "list or symbol")
    (,markup? . "markup")
    (,markup-command-list? . "markup command list")
    (,markup-list? . "markup list")
    (,moment-pair? . "pair of moment objects")
    (,number-or-grob? . "number or grob")
    (,number-or-pair? . "number or pair")
    (,number-or-string? . "number or string")
    (,number-pair? . "pair of numbers")
    (,rhythmic-location? . "rhythmic location")
    (,scheme? . "any type")
    (,string-or-pair? . "string or pair")
    (,string-or-symbol? . "string or symbol")
    ))

(define-public lilypond-exported-predicates
  `((,ly:box? . "box")
    (,ly:context? . "context")
    (,ly:dimension? . "dimension, in staff space")
    (,ly:dir? . "direction")
    (,ly:dispatcher? . "dispatcher")
    (,ly:duration? . "duration")
    (,ly:font-metric? . "font metric")
    (,ly:grob? . "graphical (layout) object")
    (,ly:grob-array? . "array of grobs")
    (,ly:input-location? . "input location")
    (,ly:item? . "item")
    (,ly:iterator? . "iterator")
    (,ly:lily-lexer? . "lily-lexer")
    (,ly:lily-parser? . "lily-parser")
    (,ly:listener? . "listener")
    (,ly:moment? . "moment")
    (,ly:music? . "music")
    (,ly:music-function? . "music function")
    (,ly:music-list? . "list of music objects")
    (,ly:music-output? . "music output")
    (,ly:otf-font? . "OpenType font")
    (,ly:output-def? . "output definition")
    (,ly:page-marker? . "page marker")
    (,ly:pango-font? . "pango font")
    (,ly:paper-book? . "paper book")
    (,ly:paper-system? . "paper-system Prob")
    (,ly:pitch? . "pitch")
    (,ly:prob? . "property object")
    (,ly:score? . "score")
    (,ly:simple-closure? . "simple closure")
    (,ly:skyline? . "skyline")
    (,ly:skyline-pair? . "pair of skylines")
    (,ly:source-file? . "source file")
    (,ly:spanner? . "spanner")
    (,ly:stencil? . "stencil")
    (,ly:stream-event? . "stream event")
    (,ly:translator? . "translator")
    (,ly:translator-group? . "translator group")
    ))


(set! type-p-name-alist
      (append r5rs-primary-predicates
              r5rs-secondary-predicates
              guile-predicates
              lilypond-scheme-predicates
              lilypond-exported-predicates))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; timing

(define (profile-measurements)
  (let* ((t (times))
	 (stats (gc-stats)))
    (list (- (+ (tms:cutime t)
		(tms:utime t))
	     (assoc-get 'gc-time-taken stats))
	  (assoc-get 'total-cells-allocated  stats 0))))

(define (dump-profile base last this)
  (let* ((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"
	    (if (ly:get-option 'dump-cpu-profile)
		(car diff)
		0)
	    (cadr diff))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; debug memory leaks

(define gc-dumping
  #f)

(define gc-protect-stat-count
  0)

(define-public (dump-live-object-stats outfile)
  (for-each (lambda (x)
	      (format outfile "~a: ~a\n" (car x) (cdr x)))
	    (sort (gc-live-object-stats)
		  (lambda (x y)
		    (string<? (car x) (car y))))))

(define-public (dump-gc-protects)
  (set! gc-protect-stat-count (1+ gc-protect-stat-count))
  (let* ((protects (sort (hash-table->alist (ly:protects))
			 (lambda (a b)
			   (< (object-address (car a))
			      (object-address (car b))))))
	 (out-file-name (string-append
			 "gcstat-" (number->string gc-protect-stat-count)
			 ".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)
		    (let ((x (car y))
			  (c (cdr y)))
		      (display
		       (format "~a (~a) = ~a\n" (object-address x) c x)
		       outfile)))
		  (filter
		   (lambda (x)
		     (not (symbol? (car x))))
		   protects))
	     outfile)
    (format outfile "\nprotected symbols: ~a\n"
	    (apply + (map (lambda (obj-count)
			    (if (symbol? (car obj-count))
				(cdr obj-count)
				0))
			  protects)))

    ;; (display (ly:smob-protects))
    (newline outfile)
    (if (defined? 'gc-live-object-stats)
	(let* ((stats #f))
	  (display "Live object statistics: GC'ing\n")
	  (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)
	  (set! stats (gc-live-object-stats))
	  (display "Dumping live object statistics.\n")
	  (dump-live-object-stats outfile)))
    (newline outfile)
    (let* ((stats (gc-stats)))
      (for-each (lambda (sym)
		  (display
		   (format "~a ~a ~a\n"
			   gc-protect-stat-count
			   sym
			   (assoc-get sym stats "?"))

		   outfile))
		'(protected-objects bytes-malloced cell-heap-size)))
    (set! gc-dumping #f)
    (close-port outfile)))

(define (check-memory)
  "Read `/proc/self' to check up on memory use."
  (define (gulp-file name)
    (let* ((file (open-input-file name))
	   (text (read-delimited "" file)))
      (close file)
      text))

  (let* ((stat (gulp-file "/proc/self/status"))
	 (lines (string-split stat #\newline))
	 (interesting (filter identity
			      (map
			       (lambda (l)
				 (string-match "^VmData:[ \t]*([0-9]*) kB" l))
			       lines)))
	 (mem (string->number (match:substring (car interesting) 1))))
    (display (format  "VMDATA: ~a\n" mem))
    (display (gc-stats))
    (if (> mem 100000)
	(begin (dump-gc-protects)
	       (raise 1)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (multi-fork count)
  "Split this process into COUNT helpers.  Returns either a list of
PIDs or the number of the process."
  (define (helper count acc)
    (if (> count 0)
	(let* ((pid (primitive-fork)))
	  (if (= pid 0)
	      (1- count)
	      (helper (1- count) (cons pid acc))))
	acc))

  (helper count '()))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define* (ly:exit status #:optional (silently #f))
  "Exit function for lilypond"
  (if (not silently)
      (case status
	((0) (ly:success (_ "Compilation successfully completed")))
	((1) (ly:warning (_ "Compilation completed with warnings or errors")))
	(else (ly:message ""))))
  (exit status))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-public (lilypond-main files)
  "Entry point for LilyPond."
  (eval-string (ly:command-line-code))
  (if (ly:get-option 'help)
      (begin (ly:option-usage)
	     (ly:exit 0 #t)))
  (if (ly:get-option 'show-available-fonts)
      (begin (ly:font-config-display-fonts)
	     (ly:exit 0 #t)))
  (if (ly:get-option 'gui)
      (gui-main files))
  (if (null? files)
      (begin (ly:usage)
	     (ly:exit 2 #t)))
  (if (ly:get-option 'read-file-list)
      (set! files
	    (filter (lambda (s)
		      (> (string-length s) 0))
		    (apply append
			   (map (lambda (f)
				  (string-split (ly:gulp-file f) #\nl))
				files)))))
  (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))
	     (joblist (multi-fork count))
	     (errors '()))
	(if (not (string-or-symbol? (ly:get-option 'log-file)))
	    (ly:set-option 'log-file "lilypond-multi-run"))
	(if (number? joblist)
	    (begin (ly:set-option
		    'log-file (format "~a-~a"
				      (ly:get-option 'log-file) joblist))
		   (set! files (vector-ref split-todo joblist)))
	    (begin (ly:progress "\nForking into jobs:  ~a\n" joblist)
		   (for-each
		    (lambda (pid)
		      (let* ((stat (cdr (waitpid pid))))
			(if (not (= stat 0))
			    (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"
					      (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))))
		    errors)
		   (if (pair? errors)
		       (ly:error "Children ~a exited with errors."
				 (map car errors)))
		   ;; must overwrite individual entries
		   (if (ly:get-option 'dump-profile)
		       (dump-profile "lily-run-total"
				     '(0 0) (profile-measurements)))
		   (if (null? errors)
		       (ly:exit 0 #f)
		       (ly:exit 1 #f))))))

  (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 (ly:error (_ "failed files: ~S") (string-join failed))
	       (ly:exit 1 #f))
	(begin
	  (ly:exit 0 #f)))))


(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))
			     (if (access? "/dev/stderr" W_OK)
				 "/dev/stderr"
				 "/dev/null")) "a") #f))
	 (do-measurements (ly:get-option 'dump-profile))
	 (handler (lambda (key failed-file)
		    (set! failed (append (list failed-file) failed)))))
    (gc)
    (for-each
     (lambda (x)
       (let* ((start-measurements (if do-measurements
				      (profile-measurements)
				      #f))
	      (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 "Processing ~a\n" base))
	 (if (ly:get-option 'trace-memory-frequency)
	     (mtrace:start-trace  (ly:get-option 'trace-memory-frequency)))
	 (lilypond-file handler x)
	 (if start-measurements
	     (dump-profile x start-measurements (profile-measurements)))
	 (if (ly:get-option 'trace-memory-frequency)
	     (begin (mtrace:stop-trace)
		    (mtrace:dump-results base)))
	 (for-each (lambda (s)
		     (ly:set-option (car s) (cdr s)))
		   all-settings)
	 (ly:set-option 'debug-gc-assert-parsed-dead #t)
	 (gc)
	 (ly:set-option 'debug-gc-assert-parsed-dead #f)
	 (if (ly:get-option 'debug-gc)
	     (dump-gc-protects)
             (ly:reset-all-fonts))))
     files)

    ;; Ensure a notice re failed files is written to aggregate logfile.
    (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)))
    failed))

(define (lilypond-file handler file-name)
  (catch 'ly-file-failed
	 (lambda () (ly:parse-file file-name))
	 (lambda (x . args) (handler x file-name))))

(use-modules (scm editor))

(define-public (gui-main files)
  (if (null? files)
      (gui-no-files-handler))
  (if (not (string? (ly:get-option 'log-file)))
      (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))
	(ly:stderr-redirect log-name "w")
	(ly:message "# -*-compilation-*-"))
      (let ((failed (lilypond-all files)))
	(if (pair? failed)
	    (begin
	      ;; ugh
	      (ly:stderr-redirect "foo" "r")
	      (system (get-editor-command log-name 0 0 0))
	      (ly:error (_ "failed files: ~S") (string-join failed))
	      ;; not reached?
	      (exit 1))
	    (ly:exit 0 #f)))))

(define (gui-no-files-handler)
  (let* ((ly (string-append (ly:effective-prefix) "/ly/"))
	 ;; FIXME: soft-code, localize
	 (welcome-ly (string-append ly "Welcome_to_LilyPond.ly"))
	 (cmd (get-editor-command welcome-ly 0 0 0)))
    (ly:message (_ "Invoking `~a'...\n") cmd)
    (system cmd)
    (ly:exit 1 #f)))