X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=203a449c8f00f1e9d9c7108cb7a8cd045077777f;hb=e90f0536f9be39ada0bef0aeb0d275dec3b2fb5b;hp=d62c70bb0ff471637ce3aabe05f7c01fc40e1295;hpb=a8c9e8a7ca320ab0df5fd32e717fd62cd7635ce6;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index d62c70bb0f..203a449c8f 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -1,9 +1,20 @@ -;;;; lily.scm -- top-level Scheme stuff +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 1998--2009 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +;;;; +;;;; 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 . ;; Internationalisation: (_i "to be translated") gets an entry in the ;; POT file; (gettext ...) must be invoked explicitly to do the actual @@ -17,7 +28,6 @@ (defmacro-public _i (x) x) (read-enable 'positions) -(debug-enable 'debug) (define-public PLATFORM (string->symbol @@ -38,9 +48,12 @@ "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, 'svg.") +'ps, 'scm, 'socket, 'svg.") (check-internal-types #f "Check every property assignment for types.") (clip-systems #f @@ -65,7 +78,7 @@ configurations.") "Debug cyclic callback chains.") (debug-skylines #f "Debug skylines.") - (delete-intermediate-files #f + (delete-intermediate-files #t "Delete unusable, intermediate PostScript files.") (dump-profile #f "Dump memory and time information for each file.") @@ -90,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.") @@ -101,6 +116,9 @@ output to log file `FOO.log'.") "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.") @@ -111,7 +129,7 @@ similar to chord syntax.") (pixmap-format "png16m" "Set GhostScript's output format for pixel images.") (preview #f -"Create PNG and EPS preview images also.") +"Create preview images also.") (print-pages #t "Print pages in the normal way.") (protected-scheme-parsing #t @@ -132,26 +150,31 @@ 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 +"Change all warning and programming_error +messages into errors.") )) ;; Need to do this in the beginning. Other parts of the Scheme @@ -170,13 +193,17 @@ second. Dump results to `FILE.stacks' and (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) + (ice-9 optargs) (oop goops) (srfi srfi-1) (srfi srfi-13) @@ -185,11 +212,32 @@ second. Dump results to `FILE.stacks' and (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)))) @@ -219,7 +267,6 @@ second. Dump results to `FILE.stacks' and (ly:get-option 'trace-scheme-coverage)) (begin (ly:set-option 'protected-scheme-parsing #f) - (debug-enable 'debug) (debug-enable 'backtrace) (read-enable 'positions))) @@ -228,11 +275,12 @@ second. Dump results to `FILE.stacks' and (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)) -;; gettext wrapper for guile < 1.7.2 -(if (defined? 'gettext) - (define-public _ gettext) - (define-public _ ly:gettext)) (define-public (ly:load x) (let* ((file-name (%search-load-path x))) @@ -240,7 +288,7 @@ second. Dump results to `FILE.stacks' and (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")))) @@ -250,25 +298,17 @@ second. Dump results to `FILE.stacks' and (if (null? (cdr platform)) #f (member (string-downcase (cadr platform)) '("95" "98" "me"))))) -(case PLATFORM - ((windows) - (define native-getcwd - getcwd) - - (define (slashify x) - (if (string-index x #\\) - x - (string-regexp-substitute - "//*" "/" - (string-regexp-substitute "\\\\" "/" x)))) +(define (slashify x) + (if (string-index x #\\) + x + (string-regexp-substitute + "//*" "/" + (string-regexp-substitute "\\\\" "/" x)))) - ;; FIXME: this prints a warning. - (define-public (ly-getcwd) - (slashify (native-getcwd)))) - - (else - (define-public ly-getcwd - getcwd))) +(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))) @@ -281,7 +321,22 @@ second. Dump results to `FILE.stacks' and (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." @@ -303,16 +358,6 @@ Print a message at LOCATION if any predicate failed." (recursion-helper (cdr signature) (cdr arguments) (1+ count))))) (recursion-helper signature arguments 1)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; output - -;; (define-public (output-framework) (write "hello\n")) - -(define output-ps-module - (make-module 1021 (list (resolve-interface '(scm output-ps))))) - -(define-public (ps-output-expression expr port) - (display (eval expr output-ps-module) port)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Safe definitions utility @@ -356,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" @@ -364,17 +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" + "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" @@ -386,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" @@ -404,42 +458,120 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (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 - `((,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") - (,ly:context? . "context") - (,ly:dimension? . "dimension, in staff space") - (,ly:dir? . "direction") - (,ly:duration? . "duration") - (,ly:grob? . "layout object") - (,ly:input-location? . "input location") - (,ly:moment? . "moment") - (,ly:music? . "music") - (,ly:pitch? . "pitch") - (,ly:translator? . "translator") - (,ly:font-metric? . "font metric") - (,ly:simple-closure? . "simple closure") - (,markup-list? . "list of markups") - (,markup? . "markup") - (,ly:music-list? . "list of music") - (,number-or-grob? . "number or grob") - (,number-or-string? . "number or string") - (,number-pair? . "pair of numbers") - (,number? . "number") - (,output-port? . "output port") - (,pair? . "pair") - (,procedure? . "procedure") - (,rhythmic-location? . "rhythmic location") - (,scheme? . "any type") - (,string? . "string") - (,symbol? . "symbol") - (,vector? . "vector"))) + (append r5rs-primary-predicates + r5rs-secondary-predicates + guile-predicates + lilypond-scheme-predicates + lilypond-exported-predicates)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; timing @@ -449,8 +581,8 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (stats (gc-stats))) (list (- (+ (tms:cutime t) (tms:utime t)) - (ly:assoc-get 'gc-time-taken stats)) - (ly:assoc-get 'total-cells-allocated stats 0)))) + (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"))) @@ -531,10 +663,8 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (format "~a ~a ~a\n" gc-protect-stat-count sym - (let ((sym-stat (assoc sym stats))) - (if sym-stat - (cdr sym-stat) - "?"))) + (assoc-get sym stats "?")) + outfile)) '(protected-objects bytes-malloced cell-heap-size))) (set! gc-dumping #f) @@ -579,20 +709,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) @@ -648,9 +789,10 @@ 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")) (let ((failed (lilypond-all files))) @@ -660,11 +802,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 '()) @@ -673,7 +814,7 @@ PIDs or the number of the process." (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)) + "/dev/stderr") "a") #f)) (do-measurements (ly:get-option 'dump-profile)) (handler (lambda (key failed-file) (set! failed (append (list failed-file) failed))))) @@ -700,17 +841,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) - (if (= (random 40) 1) - (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) @@ -743,7 +882,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/")) @@ -752,4 +891,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)))