X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=17c8d1776b2a2d436aa16798115f392170ea13c7;hb=bb8a0a5387af94dd2702877256334b160575a730;hp=2b6ca651b4adbc83a3e911b25b6acc65fb4ef3cf;hpb=eb98dcb8ece687486640a5dc3ec3aa2395ec31cf;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index 2b6ca651b4..17c8d1776b 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -28,7 +28,6 @@ (defmacro-public _i (x) x) (read-enable 'positions) -(debug-enable 'debug) (define-public PLATFORM (string->symbol @@ -104,6 +103,8 @@ a log file.") "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.") @@ -149,24 +150,26 @@ 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.") - (separate-log-files #f -"For input files `FILE1.ly', `FILE2.ly', ... -output log data to files `FILE1.log', -`FILE2.log', ...") + (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'.") - (show-available-fonts #f -"List available font names.") (verbose ,(ly:command-line-verbose?) "Value of the --verbose flag (read-only).") (warning-as-error #f @@ -190,26 +193,51 @@ messages into errors.") (if (defined? 'set-debug-cell-accesses!) (set-debug-cell-accesses! #f)) - ;(set-debug-cell-accesses! 1000) +;;(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)) + (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 format, but without the memory consumption." + "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)))) @@ -239,7 +267,6 @@ messages into errors.") (ly:get-option 'trace-scheme-coverage)) (begin (ly:set-option 'protected-scheme-parsing #f) - (debug-enable 'debug) (debug-enable 'backtrace) (read-enable 'positions))) @@ -254,7 +281,6 @@ messages into errors.") (if (memq (ly:get-option 'backend) music-string-to-path-backends) (ly:set-option 'music-strings-to-paths #t)) -(define-public _ gettext) (define-public (ly:load x) (let* ((file-name (%search-load-path x))) @@ -262,7 +288,7 @@ messages into errors.") (ly:progress "[~A" file-name)) (if (not file-name) (ly:error (_ "cannot find: ~A") x)) - (primitive-load file-name) + (primitive-load-path file-name) ;; to support Guile V2 autocompile (if (ly:get-option 'verbose) (ly:progress "]\n")))) @@ -295,7 +321,22 @@ messages into errors.") (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." @@ -360,7 +401,9 @@ LilyPond safe mode. The syntax is the same as `define*-public'." '("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" @@ -368,18 +411,22 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "chord-generic-names.scm" "stencil.scm" "markup.scm" + "modal-transforms.scm" "music-functions.scm" "part-combiner.scm" "autochange.scm" "define-music-properties.scm" - "beam-settings.scm" + "time-signature-settings.scm" "auto-beam.scm" - "chord-name.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" @@ -391,9 +438,11 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "flag-styles.scm" "fret-diagrams.scm" + "tablature.scm" "harp-pedals.scm" + "define-woodwind-diagrams.scm" + "display-woodwind-diagrams.scm" "predefined-fretboards.scm" - "define-markup-commands.scm" "define-grob-properties.scm" "define-grobs.scm" "define-grob-interfaces.scm" @@ -403,7 +452,6 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "paper.scm" "backend-library.scm" "x11-color.scm" - "tablature.scm" ;; must be after everything has been defined "safe-lily.scm")) @@ -466,6 +514,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (,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") @@ -536,7 +585,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (assoc-get 'total-cells-allocated stats 0)))) (define (dump-profile base last this) - (let* ((outname (format "~a.profile" (dir-basename base ".ly"))) + (let* ((outname (format #f "~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") @@ -573,18 +622,15 @@ LilyPond safe mode. 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) - (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 #t "Dumping GC statistics ~a...\n" out-file-name) + (for-each (lambda (y) + (let ((x (car y)) + (c (cdr y))) + (format outfile "~a (~a) = ~a\n" (object-address x) c x))) + (filter + (lambda (x) + (not (symbol? (car x)))) + protects)) (format outfile "\nprotected symbols: ~a\n" (apply + (map (lambda (obj-count) (if (symbol? (car obj-count)) @@ -610,13 +656,10 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (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)) + (format outfile "~a ~a ~a\n" + gc-protect-stat-count + sym + (assoc-get sym stats "?"))) '(protected-objects bytes-malloced cell-heap-size))) (set! gc-dumping #f) (close-port outfile))) @@ -637,7 +680,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (string-match "^VmData:[ \t]*([0-9]*) kB" l)) lines))) (mem (string->number (match:substring (car interesting) 1)))) - (display (format "VMDATA: ~a\n" mem)) + (format #t "VMDATA: ~a\n" mem) (display (gc-stats)) (if (> mem 100000) (begin (dump-gc-protects) @@ -660,20 +703,31 @@ PIDs or the number of the process." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(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) - (exit 0))) + (ly:exit 0 #t))) (if (ly:get-option 'show-available-fonts) (begin (ly:font-config-display-fonts) - (exit 0))) + (ly:exit 0 #t))) (if (ly:get-option 'gui) (gui-main files)) (if (null? files) (begin (ly:usage) - (exit 2))) + (ly:exit 2 #t))) (if (ly:get-option 'read-file-list) (set! files (filter (lambda (s) @@ -692,7 +746,7 @@ PIDs or the number of the process." (ly:set-option 'log-file "lilypond-multi-run")) (if (number? joblist) (begin (ly:set-option - 'log-file (format "~a-~a" + 'log-file (format #f "~a-~a" (ly:get-option 'log-file) joblist)) (set! files (vector-ref split-todo joblist))) (begin (ly:progress "\nForking into jobs: ~a\n" joblist) @@ -708,7 +762,7 @@ PIDs or the number of the process." (lambda (x) (let* ((job (car x)) (state (cdr x)) - (logfile (format "~a-~a.log" + (logfile (format #f "~a-~a.log" (ly:get-option 'log-file) job)) (log (ly:gulp-file logfile)) (len (string-length log)) @@ -716,7 +770,7 @@ PIDs or the number of the process." (if (status:term-sig state) (ly:message "\n\n~a\n" - (format (_ "job ~a terminated with signal: ~a") + (format #f (_ "job ~a terminated with signal: ~a") job (status:term-sig state))) (ly:message (_ "logfile ~a (exit ~a):\n~a") @@ -729,11 +783,12 @@ PIDs or the number of the process." (if (ly:get-option 'dump-profile) (dump-profile "lily-run-total" '(0 0) (profile-measurements))) - (exit (if (null? errors) - 0 - 1)))))) + (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")) + (ly:stderr-redirect (format #f "~a.log" (ly:get-option 'log-file)) "w")) (let ((failed (lilypond-all files))) (if (ly:get-option 'trace-scheme-coverage) (begin @@ -741,11 +796,10 @@ PIDs or the number of the process." (string-contains f "lilypond"))))) (if (pair? failed) (begin (ly:error (_ "failed files: ~S") (string-join failed)) - (exit 1)) + (ly:exit 1 #f)) (begin - ;; HACK: be sure to exit with single newline - (ly:message "") - (exit 0))))) + (ly:exit 0 #f))))) + (define-public (lilypond-all files) (let* ((failed '()) @@ -753,8 +807,8 @@ PIDs or the number of the process." (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)) + (format #f "~a.log" (ly:get-option 'log-file)) + "/dev/stderr") "a") #f)) (do-measurements (ly:get-option 'dump-profile)) (handler (lambda (key failed-file) (set! failed (append (list failed-file) failed))))) @@ -767,7 +821,7 @@ PIDs or the number of the process." (base (dir-basename x ".ly")) (all-settings (ly:all-options))) (if separate-logs - (ly:stderr-redirect (format "~a.log" base) "w")) + (ly:stderr-redirect (format #f "~a.log" base) "w")) (if ping-log (format ping-log "Processing ~a\n" base)) (if (ly:get-option 'trace-memory-frequency) @@ -781,16 +835,15 @@ PIDs or the number of the process." (for-each (lambda (s) (ly:set-option (car s) (cdr s))) all-settings) - (ly:clear-anonymous-modules) (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)))) + (ly:reset-all-fonts)))) files) - ;; we want the failed-files notice in the aggregrate logfile. + ;; 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) @@ -823,7 +876,7 @@ PIDs or the number of the process." (ly:error (_ "failed files: ~S") (string-join failed)) ;; not reached? (exit 1)) - (exit 0))))) + (ly:exit 0 #f))))) (define (gui-no-files-handler) (let* ((ly (string-append (ly:effective-prefix) "/ly/")) @@ -832,4 +885,4 @@ PIDs or the number of the process." (cmd (get-editor-command welcome-ly 0 0 0))) (ly:message (_ "Invoking `~a'...\n") cmd) (system cmd) - (exit 1))) + (ly:exit 1 #f)))