X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=cd7b92964bdcfa21ea590ca5349c092fb94c87ca;hb=6cb2c5ec23dea45f3cba3a03dc0d9128b630742b;hp=55d989e2d2ba7d8260f90955bbf86d0cc720a9c6;hpb=a066a93ee74edebb9d238a1bac93c3bc7e8e6e4a;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index 55d989e2d2..cd7b92964b 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--2011 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -43,6 +43,89 @@ (string-downcase (car (string-tokenize (utsname:sysname (uname))))))) +(define lilypond-declarations '()) + +(defmacro-public define-session (name value) + "This defines a variable @var{name} with the starting value +@var{value} that is reinitialized at the start of each session. +A@tie{}session basically corresponds to one LilyPond file on the +command line. The value is recorded at the start of the first session +after loading all initialization files and before loading the user +file and is reinstated for all of the following sessions. This +happens just by replacing the value, not by copying structures, so you +should not destructively modify them. For example, lists defined in +this manner should be changed within a session only be adding material +to their front or replacing them altogether, not by modifying parts of +them. It is an error to call @code{define-session} after the first +session has started." + (define (add-session-variable name value) + (if (ly:undead? lilypond-declarations) + (ly:error (_ "define-session used after session start"))) + (let ((var (make-variable value))) + (module-add! (current-module) name var) + (set! lilypond-declarations (cons var lilypond-declarations)))) + `(,add-session-variable ',name ,value)) + +(defmacro-public define-session-public (name value) + "Like @code{define-session}, but also exports @var{name}." + `(begin + (define-session ,name ,value) + (export ,name))) + +(define (session-terminate) + (if (ly:undead? lilypond-declarations) + (for-each + (lambda (p) (variable-set! (cadr p) (cddr p))) + (ly:get-undead lilypond-declarations)))) + +(define lilypond-interfaces #f) + +(define-public (session-initialize thunk) + "Initialize this session. The first session in a LilyPond run is +initialized by calling @var{thunk}, then recording the values of all +variables in the current module as well as those defined with +@code{define-session}. Subsequent calls of @code{session-initialize} +ignore @var{thunk} and instead just reinitialize all recorded +variables to their value after the initial call of @var{thunk}." + +;; We need to save the variables of the current module along with +;; their values: functions defined in the module might refer to the +;; variables. + +;; The entries in lilypond-declarations consist of a cons* consisting +;; of symbol, variable, and value. Variables defined with +;; define-session have the symbol set to #f. + + (if (ly:undead? lilypond-declarations) + (begin + (module-use-interfaces! (current-module) (reverse lilypond-interfaces)) + (for-each + (lambda (p) + (let ((var (cadr p)) + (val (cddr p))) + (variable-set! var val) + (if (car p) + (module-add! (current-module) (car p) var)))) + (ly:get-undead lilypond-declarations))) + (begin + (thunk) + (set! lilypond-interfaces + (filter (lambda (m) (eq? 'interface (module-kind m))) + (module-uses (current-module)))) + (let ((decl (map! (lambda (v) + (cons* #f v (variable-ref v))) + lilypond-declarations))) + (module-for-each + (lambda (s v) + (let ((val (variable-ref v))) + (if (not (ly:lily-parser? val)) + (set! decl + (cons + (cons* s v val) + decl))))) + (current-module)) + (set! lilypond-declarations (ly:make-undead decl)))))) + (define scheme-options-definitions `( ;; NAMING: either @@ -120,6 +203,10 @@ jobs.") (log-file #f "If string FOO is given as argument, redirect output to log file `FOO.log'.") + (max-markup-depth 1024 +"Maximum depth for the markup tree. If a markup has more levels, +assume it will not terminate on its own, print a warning and return a +null markup instead.") (midi-extension ,(if (eq? PLATFORM 'windows) "mid" "midi") @@ -128,9 +215,6 @@ 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" @@ -215,7 +299,8 @@ messages into errors.") (srfi srfi-14) (scm clip-region) (scm memory-trace) - (scm coverage)) + (scm coverage) + (scm safe-utility-defs)) (define-public _ gettext) ;;; There are new modules defined in Guile V2.0 which we need to use. @@ -284,7 +369,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 (ly:load x) (let* ((file-name (%search-load-path x))) (ly:debug "[~A" file-name) @@ -340,50 +424,6 @@ messages into errors.") (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 @@ -410,7 +450,8 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "output-lib.scm")) ;; - Files containing definitions used later by other files later in load (define init-scheme-files-used - '("markup-macros.scm")) + '("markup-macros.scm" + "parser-ly-from-scheme.scm")) ;; - Main body of files to be loaded (define init-scheme-files-body '("file-cache.scm" @@ -420,6 +461,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "define-note-names.scm" "c++.scm" "chord-entry.scm" + "skyline.scm" "stencil.scm" "define-markup-commands.scm" "markup.scm" @@ -434,7 +476,6 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "auto-beam.scm" "chord-name.scm" "bezier-tools.scm" - "parser-ly-from-scheme.scm" "ly-syntax-constructors.scm" "define-context-properties.scm" @@ -447,6 +488,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "font.scm" "encoding.scm" + "bar-line.scm" "flag-styles.scm" "fret-diagrams.scm" "tablature.scm" @@ -458,7 +500,9 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "define-grobs.scm" "define-grob-interfaces.scm" "define-stencil-commands.scm" + "scheme-engravers.scm" "titling.scm" + "text.scm" "paper.scm" "backend-library.scm" @@ -526,30 +570,41 @@ LilyPond safe mode. The syntax is the same as `define*-public'." `((,boolean-or-symbol? . "boolean or symbol") (,color? . "color") (,cheap-list? . "list") + (,fraction? . "fraction, as pair") (,grob-list? . "list of grobs") - ;; this is built on cheap-list - (,list-or-symbol? . "list or symbol") + (,index? . "non-negative integer") (,markup? . "markup") (,markup-command-list? . "markup command list") (,markup-list? . "markup list") (,moment-pair? . "pair of moment objects") + (,number-list? . "number list") (,number-or-grob? . "number or grob") + (,number-or-markup? . "number or markup") (,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-music? . "string or music") (,string-or-symbol? . "string or symbol") + (,symbol-list? . "symbol list") + (,symbol-list-or-music? . "symbol list or music") + (,symbol-list-or-symbol? . "symbol list or symbol") + (,void? . "void") )) (define-public lilypond-exported-predicates - `((,ly:box? . "box") + `((,ly:book? . "book") + (,ly:box? . "box") (,ly:context? . "context") + (,ly:context-def? . "context definition") + (,ly:context-mod? . "context modification") (,ly:dimension? . "dimension, in staff space") (,ly:dir? . "direction") (,ly:dispatcher? . "dispatcher") (,ly:duration? . "duration") + (,ly:event? . "post event") (,ly:font-metric? . "font metric") (,ly:grob? . "graphical (layout) object") (,ly:grob-array? . "array of grobs") @@ -578,10 +633,12 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (,ly:skyline-pair? . "pair of skylines") (,ly:source-file? . "source file") (,ly:spanner? . "spanner") + (,ly:spring? . "spring") (,ly:stencil? . "stencil") (,ly:stream-event? . "stream event") (,ly:translator? . "translator") (,ly:translator-group? . "translator group") + (,ly:unpure-pure-container? . "unpure/pure container") )) @@ -624,6 +681,10 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (define gc-protect-stat-count 0) +;; Undead objects that should be ignored after the first time round +(define gc-zombies + (make-weak-key-hash-table 0)) + (define-public (dump-live-object-stats outfile) (for-each (lambda (x) (format outfile "~a: ~a\n" (car x) (cdr x))) @@ -642,7 +703,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." ".scm")) (outfile (open-file out-file-name "w"))) (set! gc-dumping #t) - (format #t "Dumping GC statistics ~a...\n" out-file-name) + (ly:progress "Dumping GC statistics ~a...\n" out-file-name) (for-each (lambda (y) (let ((x (car y)) (c (cdr y))) @@ -662,16 +723,23 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (newline outfile) (if (defined? 'gc-live-object-stats) (let* ((stats #f)) - (display "Live object statistics: GC'ing\n") + (ly:progress "Live object statistics: GC'ing\n") (ly:reset-all-fonts) (gc) (gc) - (display "Asserting dead objects\n") + (ly:progress "Asserting dead objects\n") (ly:set-option 'debug-gc-assert-parsed-dead #t) (gc) (ly:set-option 'debug-gc-assert-parsed-dead #f) + (for-each + (lambda (x) + (if (not (hashq-ref gc-zombies x)) + (begin + (ly:programming-error "Parsed object should be dead: ~a" x) + (hashq-set! gc-zombies x #t)))) + (ly:parsed-undead-list!)) (set! stats (gc-live-object-stats)) - (display "Dumping live object statistics.\n") + (ly:progress "Dumping live object statistics.\n") (dump-live-object-stats outfile))) (newline outfile) (let* ((stats (gc-stats))) @@ -702,7 +770,8 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (mem (string->number (match:substring (car interesting) 1)))) (format #t "VMDATA: ~a\n" mem) (display (gc-stats)) - (if (> mem 100000) + (newline) + (if (> mem 500000) (begin (dump-gc-protects) (raise 1))))) @@ -727,7 +796,7 @@ PIDs or the number of the process." "Exit function for lilypond" (if (not silently) (case status - ((0) (ly:success (_ "Compilation successfully completed"))) + ((0) (ly:basic-progress (_ "Success: compilation successfully completed"))) ((1) (ly:warning (_ "Compilation completed with warnings or errors"))) (else (ly:message "")))) (exit status)) @@ -754,7 +823,7 @@ PIDs or the number of the process." (> (string-length s) 0)) (apply append (map (lambda (f) - (string-split (ly:gulp-file f) #\nl)) + (string-split (string-delete (ly:gulp-file f) #\cr) #\nl)) files))))) (if (and (number? (ly:get-option 'job-count)) (>= (length files) (ly:get-option 'job-count))) @@ -825,10 +894,11 @@ PIDs or the number of the process." (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 #f "~a.log" (ly:get-option 'log-file)) - "/dev/stderr") "a") #f)) + (and separate-logs + (if (string-or-symbol? (ly:get-option 'log-file)) + (open-file (format #f "~a.log" (ly:get-option 'log-file)) + "a") + (fdes->outport 2)))) (do-measurements (ly:get-option 'dump-profile)) (handler (lambda (key failed-file) (set! failed (append (list failed-file) failed))))) @@ -847,6 +917,8 @@ PIDs or the number of the process." (if (ly:get-option 'trace-memory-frequency) (mtrace:start-trace (ly:get-option 'trace-memory-frequency))) (lilypond-file handler x) + (ly:check-expected-warnings) + (session-terminate) (if start-measurements (dump-profile x start-measurements (profile-measurements))) (if (ly:get-option 'trace-memory-frequency) @@ -858,9 +930,17 @@ PIDs or the number of the process." (ly:set-option 'debug-gc-assert-parsed-dead #t) (gc) (ly:set-option 'debug-gc-assert-parsed-dead #f) + (for-each + (lambda (x) + (if (not (hashq-ref gc-zombies x)) + (begin + (ly:programming-error "Parsed object should be dead: ~a" x) + (hashq-set! gc-zombies x #t)))) + (ly:parsed-undead-list!)) (if (ly:get-option 'debug-gc) (dump-gc-protects) - (ly:reset-all-fonts)))) + (ly:reset-all-fonts)) + (flush-all-ports))) files) ;; Ensure a notice re failed files is written to aggregate logfile.