X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=2028f1c20e652df058c538fd796f4051d0a45dc2;hb=07f7ea94c774c7b746a0e7b703bc4a709b73eabf;hp=c971758f0d2b7db2d22816196587e72536384493;hpb=1ecdd56060e34a00b2be6b38029b286a601ea6f8;p=lilypond.git

diff --git a/scm/lily.scm b/scm/lily.scm
index c971758f0d..2028f1c20e 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 <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
@@ -43,6 +43,121 @@
    (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
@@ -54,73 +169,100 @@
     ;; 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.")
@@ -129,63 +271,80 @@ 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.")
     ))
@@ -219,7 +378,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.
@@ -288,7 +448,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)
@@ -344,39 +503,6 @@ messages into errors.")
                      (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
@@ -403,7 +529,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"
@@ -413,6 +540,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"
@@ -427,7 +555,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"
@@ -440,6 +567,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"
@@ -451,6 +579,7 @@ 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"
 
@@ -520,31 +649,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? . "event")
+    (,ly:event? . "post event")
     (,ly:font-metric? . "font metric")
     (,ly:grob? . "graphical (layout) object")
     (,ly:grob-array? . "array of grobs")
@@ -573,10 +712,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")
     ))
 
 
@@ -619,6 +760,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)))
@@ -665,6 +810,13 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
           (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)))
@@ -750,7 +902,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)))
@@ -821,10 +973,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)))))
@@ -844,6 +997,7 @@ PIDs or the number of the process."
              (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)
@@ -855,6 +1009,13 @@ 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))