;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 1998--2014 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2015 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
(define-public PLATFORM
(string->symbol
(string-downcase
- (car (string-tokenize (utsname:sysname (uname)))))))
+ (car (string-tokenize (utsname:sysname (uname)) char-set:letter)))))
+
+;; We don't use (srfi srfi-39) (parameter objects) here because that
+;; does not give us a name/handle to the underlying fluids themselves.
+
+(define %parser (make-fluid))
+(define %location (make-fluid))
+;; No public setters: should not get overwritten in action
+(define-public (*parser*) (fluid-ref %parser))
+(define-public (*location*) (fluid-ref %location))
+;; but properly scoped location should be fine
+(defmacro-public with-location (loc . body)
+ `(with-fluids ((,%location ,loc)) ,@body))
+
+;; It would be nice to convert occurences of parser/location to
+;; (*parser*)/(*location*) using the syncase module but it is utterly
+;; broken in GUILE 1 and would require changing a lot of unrelated
+;; innocuous constructs which just happen to fall apart with
+;; inscrutable error messages.
;;
;; Session-handling variables and procedures.
;;
(define lilypond-declarations '())
+(define lilypond-exports '())
(define after-session-hook (make-hook))
(define-public (call-after-session thunk)
(ly:error (_ "call-after-session used after session start")))
(add-hook! after-session-hook thunk #t))
-(defmacro-public define-session (name value)
+(define (make-session-variable name value)
+ (if (ly:undead? lilypond-declarations)
+ (ly:error (_ "define-session used after session start")))
+ (let ((var (module-make-local-var! (current-module) name)))
+ (if (variable-bound? var)
+ (ly:error (_ "symbol ~S redefined") name))
+ (variable-set! var value)
+ var))
+
+(defmacro 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
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))))
+ (set! lilypond-declarations
+ (cons (make-session-variable name value) lilypond-declarations)))
`(,add-session-variable ',name ,value))
-(defmacro-public define-session-public (name value)
- "Like @code{define-session}, but also exports @var{name}."
+(defmacro define-session-public (name value)
+ "Like @code{define-session}, but also exports @var{name} into parser modules."
+ (define (add-session-variable name value)
+ (set! lilypond-exports
+ (acons name (make-session-variable name value) lilypond-exports)))
`(begin
- (define-session ,name ,value)
+ ;; this is a bit icky: we place the variable right into every
+ ;; parser module so that both set! and define will affect the
+ ;; original variable in the (lily) module. However, we _also_
+ ;; export it normally from (lily) for the sake of other modules
+ ;; not sharing the name space of the parser.
+ (,add-session-variable ',name ,value)
(export ,name)))
(define (session-terminate)
(module-add! (current-module) (car p) var))))
(ly:get-undead lilypond-declarations)))
(begin
+ ;; import all public session variables natively into parser
+ ;; module. That makes them behave identically under define/set!
+ (for-each (lambda (v)
+ (module-add! (current-module) (car v) (cdr v)))
+ lilypond-exports)
+ ;; Initialize first session
(thunk)
+ ;; lilypond-exports is no longer needed since we will grab its
+ ;; values from (current-module).
+ (set! lilypond-exports #f)
(set! lilypond-interfaces
(filter (lambda (m) (eq? 'interface (module-kind m)))
(module-uses (current-module))))
(clip-systems
#f
"Generate cut-out snippets of a score.")
+ (crop
+ #f
+ "Match the size of the normal output to the typeset image.")
(datadir
#f
"LilyPond prefix for data files (read-only).")
#f
"Dump output signatures of each system. Used for
regression testing.")
+ (embed-source-code
+ #f
+ "Embed the source files inside the generated PDF document.")
(eps-box-padding
#f
"Pad left edge of the output EPS bounding box by
given amount (in mm).")
+ (font-export-dir
+ #f
+ "Directory for exporting fonts as PostScript files.")
(gs-load-fonts
#f
"Load fonts via Ghostscript.")
(gs-load-lily-fonts
#f
"Load only LilyPond fonts via Ghostscript.")
+ (gs-never-embed-fonts
+ #f
+ "Make Ghostscript embed only TrueType fonts and no other font format.")
(gui
#f
"Run LilyPond from a GUI and redirect stderr to
to a music font.")
(point-and-click
#t
- "Add point & click links to PDF output.")
+ "Add point & click links to PDF and SVG output.")
(paper-size
"a4"
"Set default paper size.")
(define-public (ergonomic-simple-format dest . rest)
"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))))
+ (apply simple-format #f dest rest)
+ (apply simple-format dest rest)))
(define format
ergonomic-simple-format)
v)
(define-public (print . args)
- (apply format (cons (current-output-port) args)))
+ (apply format (current-output-port) args))
;;; General settings.
(if (ly:get-option 'trace-scheme-coverage)
(coverage:enable))
-(define-public parser #f)
-
(define music-string-to-path-backends
'(svg))
(and (eq? PLATFORM 'windows)
(> file-name-length 2)
(eq? (string-ref file-name 1) #\:)
- (eq? (string-ref file-name 2) #\/))))))
+ (or (eq? (string-ref file-name 2) #\\)
+ (eq? (string-ref file-name 2) #\/)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; If necessary, emulate Guile V2 module_export_all! for Guile V1.8.n
"c++.scm"
"chord-entry.scm"
"skyline.scm"
- "stencil.scm"
- "define-markup-commands.scm"
"markup.scm"
+ "define-markup-commands.scm"
+ "stencil.scm"
"modal-transforms.scm"
"chord-generic-names.scm"
"chord-ignatzek-names.scm"
"part-combiner.scm"
"autochange.scm"
"define-music-properties.scm"
+ "time-signature.scm"
"time-signature-settings.scm"
"auto-beam.scm"
"chord-name.scm"
"bezier-tools.scm"
- "ly-syntax-constructors.scm"
"define-context-properties.scm"
"translation-functions.scm"
(,fraction? . "fraction, as pair")
(,grob-list? . "list of grobs")
(,index? . "non-negative integer")
+ (,key? . "index or symbol")
+ (,key-list? . "list of indexes or symbols")
+ (,key-list-or-music? . "key list or music")
+ (,key-list-or-symbol? . "key list or symbol")
(,markup? . "markup")
(,markup-command-list? . "markup command list")
(,markup-list? . "markup list")
(,ly:font-metric? . "font metric")
(,ly:grob? . "graphical (layout) object")
(,ly:grob-array? . "array of grobs")
+ (,ly:grob-properties? . "grob properties")
(,ly:input-location? . "input location")
(,ly:item? . "item")
(,ly:iterator? . "iterator")
(,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:stream-event? . "stream event")
(,ly:translator? . "translator")
(,ly:translator-group? . "translator group")
+ (,ly:undead? . "undead container")
(,ly:unpure-pure-container? . "unpure/pure container")
))
(define (dump-profile base last this)
(let* ((outname (format #f "~a.profile" (dir-basename base ".ly")))
- (diff (map (lambda (y) (apply - y)) (zip this last))))
- (ly:progress "\nWriting timing to ~a..." outname)
+ (diff (map - this last)))
+ (ly:progress "\nWriting timing to ~a...\n" outname)
(format (open-file outname "w")
"time: ~a\ncells: ~a\n"
(if (ly:get-option 'dump-cpu-profile)
(remove string-null?
(append-map
(lambda (f)
- (string-split (string-delete (ly:gulp-file f) #\cr) #\nl))
+ (string-split
+ (if (guile-v2)
+ (string-delete #\cr (ly:gulp-file f))
+ (string-delete (ly:gulp-file f) #\cr))
+ #\nl))
files))))
(if (and (number? (ly:get-option 'job-count))
(>= (length files) (ly:get-option 'job-count)))
projects / lilypond.git / blobdiff