X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=f3767ca9f5fb04e8231a2387ab2cf405272cfc70;hb=6f664e0e318a1651f6fe9317a842bf9c7f476f08;hp=25165c605de5736681c3b6ea802dc1caba1d307e;hpb=0563cb618fb3c564f27ce0edffe3359fc6102da6;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index 25165c605d..f3767ca9f5 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -2,37 +2,79 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2005 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; (c) 1998--2006 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys -(for-each (lambda (x) - (ly:add-option (car x) (cadr x) (caddr x))) +(define (define-scheme-options) + (for-each (lambda (x) + (ly:add-option (car x) (cadr x) (caddr x))) - '((point-and-click #t "use point & click") - (midi-debug #f "generate human readable MIDI") - (internal-type-checking #f "check every property assignment for types") - (parse-protect #t "continue when finding errors in inline + `( + + ;; NAMING: either + + ;; - [subject-]object-object-verb +"ing" + ;; - [subject-]-verb-object-object + + (anti-alias-factor 1 "render at higher resolution and scale down result\nto prevent jaggies in PNG") + (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-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-tweaks #f "dump page layout and tweaks for each score having the tweak-key layout property set.") + (gs-load-fonts #f + "load fonts via Ghostscript.") + (include-book-title-preview #t "include book-titles in preview images.") + (include-eps-fonts #t "Include fonts in separate-system EPS files.") + + (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") + + (old-relative #f + "relative for simultaneous music works +similar to chord syntax") + (object-keys #f + "experimental mechanism for remembering tweaks") + (point-and-click #t "use point & click") + (paper-size "a4" "the default paper size") + (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.") - (old-relative #f - "relative for simultaneous music works -similar to chord syntax") + (profile-property-accesses #f "keep statistics of get_property() calls.") + + (resolution 101 "resolution for generating PNG bitmaps") + (read-file-list #f "Read files to be processed from command line arguments") + + (safe #f "Run safely") + (strict-infinity-checking #f "If yes, crash on encountering Inf/NaN") - (resolution 101 "resolution for generating bitmaps") - (anti-alias-factor 1 "render at higher resolution and scale down result\nto prevent jaggies in PNG") - (preview-include-book-title #t "include book-titles in preview images.") - (gs-font-load #f - "load fonts via Ghostscript.") - (delete-intermediate-files #f - "delete unusable PostScript files") - (verbose #f "value for the --verbose flag") - (ttf-verbosity 0 + (ttf-verbosity 0 "how much verbosity for TTF font embedding?") - (debug-gc #f - "dump GC protection info"))) + + (show-available-fonts #f + "List font names available.") + + (verbose ,(ly:command-line-verbose?) "value for the --verbose flag") + ))) +;; need to do this in the beginning. Other parts of the +;; Scheme init depend on these options. +;; +(define-scheme-options) + +(debug-set! stack 0) + (if (defined? 'set-debug-cell-accesses!) (set-debug-cell-accesses! #f)) @@ -44,7 +86,10 @@ similar to chord syntax") (oop goops) (srfi srfi-1) (srfi srfi-13) - (srfi srfi-14)) + (srfi srfi-14) + (scm clip-region) + + ) ;; my display @@ -64,7 +109,6 @@ similar to chord syntax") (debug-enable 'backtrace) (read-enable 'positions))) - (define-public tex-backend? (member (ly:output-backend) '("texstr" "tex"))) @@ -79,10 +123,10 @@ similar to chord syntax") ".")) +;; TeX C++ code actually hooks into TEX_STRING_HASHLIMIT +(define-public TEX_STRING_HASHLIMIT 10000000) + -;; cpp hack to get useful error message -(define ifdef "First run this through cpp.") -(define ifndef "First run this through cpp.") ;; gettext wrapper for guile < 1.7.2 (if (defined? 'gettext) @@ -93,12 +137,12 @@ similar to chord syntax") (let* ((file-name (%search-load-path x))) (if (ly:get-option 'verbose) (ly:progress "[~A" file-name)) + (if (not file-name) + (ly:error (_ "Can't find ~A" x))) (primitive-load file-name) (if (ly:get-option 'verbose) (ly:progress "]")))) -(define-public TEX_STRING_HASHLIMIT 10000000) - ;; Cygwin ;; #(CYGWIN_NT-5.1 Hostname 1.5.12(0.116/4/2) 2004-11-10 08:34 i686) ;; @@ -115,6 +159,12 @@ similar to chord syntax") (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))) + (if (null? (cdr platform)) #f + (member (string-downcase (cadr platform)) '("95" "98" "me"))))) + (case PLATFORM ((windows) (define native-getcwd getcwd) @@ -144,6 +194,7 @@ similar to chord syntax") (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)) @@ -161,6 +212,7 @@ predicates. Print a message at LOCATION if any predicate failed." #t (and (helper (car signature) (car arguments) count) (recursion-helper (cdr signature) (cdr arguments) (1+ count))))) + (recursion-helper signature arguments 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -196,7 +248,13 @@ The syntax is the same as `define*-public'." safe-objects)) ,safe-symbol))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; init pitch system +(ly:set-default-scale (ly:make-scale #(0 2 4 5 7 9 11))) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; other files. @@ -204,6 +262,7 @@ The syntax is the same as `define*-public'." ;; load-from-path '("lily-library.scm" "file-cache.scm" + "define-event-classes.scm" "define-music-types.scm" "output-lib.scm" "c++.scm" @@ -212,7 +271,6 @@ The syntax is the same as `define*-public'." "chord-generic-names.scm" "stencil.scm" "markup.scm" - "bass-figure.scm" "music-functions.scm" "part-combiner.scm" "autochange.scm" @@ -220,15 +278,16 @@ The syntax is the same as `define*-public'." "auto-beam.scm" "chord-name.scm" - "ly-from-scheme.scm" + "parser-ly-from-scheme.scm" + "ly-syntax-constructors.scm" "define-context-properties.scm" "translation-functions.scm" "script.scm" "midi.scm" - "beam.scm" - "clef.scm" - "slur.scm" + "layout-beam.scm" + "parser-clef.scm" + "layout-slur.scm" "font.scm" "encoding.scm" @@ -238,7 +297,6 @@ The syntax is the same as `define*-public'." "define-grobs.scm" "define-grob-interfaces.scm" "define-stencil-commands.scm" - "page-layout.scm" "titling.scm" "paper.scm" @@ -270,6 +328,7 @@ The syntax is the same as `define*-public'." (,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") @@ -279,7 +338,8 @@ The syntax is the same as `define*-public'." (,number? . "number") (,output-port? . "output port") (,pair? . "pair") - (,procedure? . "procedure") + (,procedure? . "procedure") + (,rhythmic-location? . "rhythmic location") (,scheme? . "any type") (,string? . "string") (,symbol? . "symbol") @@ -304,47 +364,54 @@ The syntax is the same as `define*-public'." (display (format "Dumping gc protected objs to ~a...\n" out-file-name)) (display - (filter - (lambda (x) (not (symbol? x))) - (map (lambda (y) - (let ((x (car y)) - (c (cdr y))) - - (string-append - (string-join - (map object->string (list (object-address x) c x)) - " ") - "\n"))) + (map (lambda (y) + (let ((x (car y)) + (c (cdr y))) + + (string-append + (string-join + (map object->string (list (object-address x) c x)) + " ") + "\n"))) + + (filter + (lambda (x) + (not (symbol? (car x)))) protects)) outfile) +; (display (ly:smob-protects)) + (newline outfile) (if (defined? 'gc-live-object-stats) - (let* - ((stats #f)) - + (let* ((stats #f)) (display "Live object statistics: GC'ing\n") (gc) (gc) - + (ly:set-option 'debug-gc-assert-parsed-dead #t) + (gc) + (set! stats (gc-live-object-stats)) (display "Dumping live object statistics.\n") - + (for-each (lambda (x) (format outfile "~a: ~a\n" (car x) (cdr x))) (sort (gc-live-object-stats) (lambda (x y) - (string (string-length s) 0)) + (apply append + (map (lambda (f) (string-split (ly:gulp-file f) #\nl)) + files))) + )) + + (if (ly:get-option 'show-available-fonts) + (begin + (ly:font-config-display-fonts) + (exit 0) + )) + (let* ((failed '()) (handler (lambda (key failed-file) (set! failed (append (list failed-file) failed))))) - ;;(handler (lambda (key . arg) (set! failed (append arg failed))))) - (for-each (lambda (x) (lilypond-file handler x)) files) + + (for-each + (lambda (x) + (ly:set-option 'debug-gc-assert-parsed-dead #f) + (lilypond-file handler x) + (ly:clear-anonymous-modules) + (if (ly:get-option 'debug-gc) + (dump-gc-protects))) + + files) failed)) (define (lilypond-file handler file-name) (catch 'ly-file-failed (lambda () (ly:parse-file file-name)) - (lambda (x . args) (handler x file-name))) - - (if (ly:get-option 'debug-gc) - (dump-gc-protects))) + (lambda (x . args) (handler x file-name)))) (use-modules (scm editor)) -(define-public (running-from-gui?) - (let ((have-tty? (isatty? (current-input-port)))) - ;; If no TTY and not using safe, assume running from GUI. - (cond - ((eq? PLATFORM 'windows) - ;; This only works for i586-mingw32msvc-gcc -mwindows - (not (string-match "standard input" - (format #f "~S" (current-input-port))))) - ((eq? PLATFORM 'darwin) #f) - (else - (not have-tty?))))) - (define-public (gui-main files) (if (null? files) (gui-no-files-handler)) (let* ((base (basename (car files) ".ly")) (log-name (string-append base ".log"))) - (if (not (running-from-gui?)) + (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 @@ -421,7 +494,3 @@ The syntax is the same as `define*-public'." (ly:message (_ "Invoking `~a'...") cmd) (system cmd) (exit 1))) - -(or (not (running-from-gui?)) - (ly:get-option 'safe) - (define lilypond-main gui-main))