;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
(string-downcase
(car (string-tokenize (utsname:sysname (uname)))))))
+;;
+;; Session-handling variables and procedures.
+;;
+;; A "session" corresponds to one .ly file processed on a LilyPond
+;; command line. Every session gets to see a reasonably fresh state
+;; of LilyPond and should work independently from previous files.
+;;
+;; Session management relies on cooperation, namely the user not
+;; trying to change variables and data structures internal to
+;; LilyPond. It is not proof against in-place modification of data
+;; structures (as they are just reinitialized with the original
+;; identities), and it is not proof against tampering with internals.
+;;
+;; As a consequence, session management is not sufficient for
+;; separating multiple independent .ly files in "-dsafe" mode: you
+;; should give each its own LilyPond process when reliable separation
+;; is mandatory.
+;;
+;; For standard tasks and programming practices, multiple sessions in
+;; the same LilyPond job should work reasonably independently and
+;; without "bleed-over" while still loading and compiling the
+;; relevant .scm and .ly files only once.
+;;
+
+(define lilypond-declarations '())
+(define after-session-hook (make-hook))
+
+(define-public (call-after-session thunk)
+ (if (ly:undead? lilypond-declarations)
+ (ly:error (_ "call-after-session used after session start")))
+ (add-hook! after-session-hook thunk #t))
+
+(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)
+ (begin
+ (for-each
+ (lambda (p) (variable-set! (cadr p) (cddr p)))
+ (ly:get-undead lilypond-declarations))
+ (run-hook after-session-hook))))
+
+(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
;; 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
+"Render at higher resolution
+(using given factor) and scale down result to prevent jaggies in
PNG images.")
- (aux-files #t
+ (aux-files
+ #t
"Create .tex, .texi, .count files in the
EPS backend.")
- (backend ps
+ (backend
+ ps
"Select backend. Possible values: 'eps, 'null,
'ps, 'scm, 'socket, 'svg.")
- (check-internal-types #f
+ (check-internal-types
+ #f
"Check every property assignment for types.")
- (clip-systems #f
+ (clip-systems
+ #f
"Generate cut-out snippets of a score.")
- (datadir #f
+ (datadir
+ #f
"LilyPond prefix for data files (read-only).")
- (debug-gc #f
+ (debug-gc
+ #f
"Dump memory debugging statistics.")
- (debug-gc-assert-parsed-dead #f
+ (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-lexer
+ #f
"Debug the flex lexer.")
- (debug-page-breaking-scoring #f
+ (debug-page-breaking-scoring
+ #f
"Dump scores for many different page breaking
configurations.")
- (debug-parser #f
+ (debug-parser
+ #f
"Debug the bison parser.")
- (debug-property-callbacks #f
+ (debug-property-callbacks
+ #f
"Debug cyclic callback chains.")
- (debug-skylines #f
+ (debug-skylines
+ #f
"Debug skylines.")
- (delete-intermediate-files #t
+ (delete-intermediate-files
+ #t
"Delete unusable, intermediate PostScript files.")
- (dump-profile #f
+ (dump-profile
+ #f
"Dump memory and time information for each file.")
- (dump-cpu-profile #f
+ (dump-cpu-profile
+ #f
"Dump timing information (system-dependent).")
- (dump-signatures #f
+ (dump-signatures
+ #f
"Dump output signatures of each system. Used for
regression testing.")
- (eps-box-padding #f
+ (eps-box-padding
+ #f
"Pad left edge of the output EPS bounding box by
given amount (in mm).")
- (gs-load-fonts #f
+ (gs-load-fonts
+ #f
"Load fonts via Ghostscript.")
- (gs-load-lily-fonts #f
+ (gs-load-lily-fonts
+ #f
"Load only LilyPond fonts via Ghostscript.")
- (gui #f
+ (gui
+ #f
"Run LilyPond from a GUI and redirect stderr to
a log file.")
- (help #f
+ (help
+ #f
"Show this help.")
- (include-book-title-preview #t
+ (include-book-title-preview
+ #t
"Include book titles in preview images.")
- (include-eps-fonts #t
+ (include-eps-fonts
+ #t
"Include fonts in separate-system EPS files.")
- (include-settings #f
+ (include-settings
+ #f
"Include file for global settings, included before the score is processed.")
- (job-count #f
+ (job-count
+ #f
"Process in parallel, using the given number of
jobs.")
- (log-file #f
+ (log-file
+ #f
"If string FOO is given as argument, redirect
output to log file `FOO.log'.")
- (max-markup-depth 1024
+ (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")
"Set the default file extension for MIDI output
file to given string.")
- (music-strings-to-paths #f
+ (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
+ (point-and-click
+ #t
"Add point & click links to PDF output.")
- (paper-size "a4"
+ (paper-size
+ "a4"
"Set default paper size.")
- (pixmap-format "png16m"
+ (pixmap-format
+ "png16m"
"Set GhostScript's output format for pixel images.")
- (preview #f
+ (preview
+ #f
"Create preview images also.")
- (print-pages #t
+ (print-pages
+ #t
"Print pages in the normal way.")
- (protected-scheme-parsing #t
+ (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
+ (profile-property-accesses
+ #f
"Keep statistics of get_property() calls.")
- (resolution 101
+ (resolution
+ 101
"Set resolution for generating PNG pixmaps to
given value (in dpi).")
- (read-file-list #f
+ (read-file-list
+ #f
"Specify name of a file which contains a list of
input files to be processed.")
- (relative-includes #f
+ (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
+ (safe
+ #f
"Run in safer mode.")
- (separate-log-files #f
+ (separate-log-files
+ #f
"For input files `FILE1.ly', `FILE2.ly', ...
output log data to files `FILE1.log',
`FILE2.log', ...")
- (show-available-fonts #f
+ (show-available-fonts
+ #f
"List available font names.")
- (strict-infinity-checking #f
+ (strict-infinity-checking
+ #f
"Force a crash on encountering Inf and NaN
floating point exceptions.")
- (strip-output-dir #t
+ (strip-output-dir
+ #t
"Don't use directories from input files while
constructing output file names.")
- (svg-woff #f
+ (svg-woff
+ #f
"Use woff font files in SVG backend.")
- (trace-memory-frequency #f
+ (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
+ (trace-scheme-coverage
+ #f
"Record coverage of Scheme files in `FILE.cov'.")
(verbose ,(ly:verbose-output?)
"Verbose output, i.e. loglevel at least DEBUG (read-only).")
- (warning-as-error #f
+ (warning-as-error
+ #f
"Change all warning and programming_error
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.
(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)
(fresh-interface!))))
(set-module-obarray! iface (module-obarray mod))))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (type-check-arg location arg args pred?)
- "Typecheck an argument after previous arguments.
-Print a message at LOCATION if predicate fails and return #f"
- (or (pred? arg)
- (begin
- (ly:input-warning
- location
- (_ "wrong type for argument ~a. Expecting ~a, found ~s")
- (1+ (length args)) (type-name pred?) arg)
- #f)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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
"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"
"define-note-names.scm"
"c++.scm"
"chord-entry.scm"
+ "skyline.scm"
"stencil.scm"
"define-markup-commands.scm"
"markup.scm"
"auto-beam.scm"
"chord-name.scm"
"bezier-tools.scm"
- "parser-ly-from-scheme.scm"
"ly-syntax-constructors.scm"
"define-context-properties.scm"
"font.scm"
"encoding.scm"
+ "bar-line.scm"
"flag-styles.scm"
"fret-diagrams.scm"
"tablature.scm"
"define-grobs.scm"
"define-grob-interfaces.scm"
"define-stencil-commands.scm"
+ "scheme-engravers.scm"
"titling.scm"
"text.scm"
`((,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? . "event")
+ (,ly:event? . "post event")
(,ly:font-metric? . "font metric")
(,ly:grob? . "graphical (layout) object")
(,ly:grob-array? . "array of grobs")
(,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")
))
(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)))
(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))
(ly:progress "Dumping live object statistics.\n")
(dump-live-object-stats outfile)))
(> (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)))
(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)))))
(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)
(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))