-;;;; lily.scm -- implement Scheme output routines for TeX and PostScript
+;;;; lily.scm -- toplevel Scheme stuff
;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
-;;; Library functions
-
(if (defined? 'set-debug-cell-accesses!)
(set-debug-cell-accesses! #f))
-;(set-debug-cell-accesses! 5000)
+;;(set-debug-cell-accesses! 5000)
(use-modules (ice-9 regex)
(ice-9 safe)
+ (ice-9 optargs)
(oop goops)
(srfi srfi-1) ; lists
(srfi srfi-13)) ; strings
-; my display
-
+;; my display
(define-public (myd k v) (display k) (display ": ") (display v) (display ", "))
(define-public (print . args)
(apply format (cons (current-output-port) args)))
-
+
;;; General settings
;;; debugging evaluator is slower. This should
(define-public point-and-click #f)
+(define-public tex-backend?
+ (member (ly:output-backend) '("texstr" "tex")))
+
(define-public parser #f)
(define-public (lilypond-version)
(map (lambda (x) (if (symbol? x)
(symbol->string x)
(number->string x)))
- (ly:version))
+ (ly:version))
"."))
(format (current-error-port) "[~A]" fn))
(primitive-load fn)))
+(define-public TEX_STRING_HASHLIMIT 10000000)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (type-check-list location signature arguments)
(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))
+ (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 (cdr signature) (cdr arguments) (1+ count)))))
(recursion-helper signature arguments 1))
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; output
-
+
;;(define-public (output-framework) (write "hello\n"))
(define output-tex-module
draw-line
ez-ball
filledbox
+ glyph-string
horizontal-line
+ named-glyph
polygon
repeat-slash
round-filled-box
text
+ url-link
white-dot
white-text
- zigzag-line
- ))
+ embedded-ps
+ zigzag-line))
;; TODO:
;; - generate this list by registering the output-backend-commands
grob-cause
no-origin
placebox
- unknown
- ))
+ unknown))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Safe definitions utility
+(define safe-objects (list))
+
+(define-macro (define-safe-public arglist . body)
+ "Define a variable, export it, and mark it as safe, ie 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)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; other files.
(for-each ly:load
- ;; load-from-path
- '("lily-library.scm"
- "define-music-types.scm"
- "output-lib.scm"
- "c++.scm"
- "chord-ignatzek-names.scm"
- "chord-entry.scm"
- "chord-generic-names.scm"
- "stencil.scm"
- "new-markup.scm"
- "bass-figure.scm"
- "music-functions.scm"
- "part-combiner.scm"
- "define-music-properties.scm"
- "auto-beam.scm"
- "chord-name.scm"
-
- "ly-from-scheme.scm"
-
- "define-context-properties.scm"
- "translation-functions.scm"
- "script.scm"
- "midi.scm"
- "beam.scm"
- "clef.scm"
- "slur.scm"
- "font.scm"
- "encoding.scm"
-
- "fret-diagrams.scm"
- "define-markup-commands.scm"
- "define-grob-properties.scm"
- "define-grobs.scm"
- "define-grob-interfaces.scm"
- "page-layout.scm"
- "titling.scm"
-
- "paper.scm"
-
- ; last:
- "safe-lily.scm"
- ))
+ ;; load-from-path
+ '("lily-library.scm"
+ "file-cache.scm"
+ "define-music-types.scm"
+ "output-lib.scm"
+ "c++.scm"
+ "chord-ignatzek-names.scm"
+ "chord-entry.scm"
+ "chord-generic-names.scm"
+ "stencil.scm"
+ "new-markup.scm"
+ "bass-figure.scm"
+ "music-functions.scm"
+ "part-combiner.scm"
+ "define-music-properties.scm"
+ "auto-beam.scm"
+ "chord-name.scm"
+
+ "ly-from-scheme.scm"
+
+ "define-context-properties.scm"
+ "translation-functions.scm"
+ "script.scm"
+ "midi.scm"
+ "beam.scm"
+ "clef.scm"
+ "slur.scm"
+ "font.scm"
+ "encoding.scm"
+
+ "fret-diagrams.scm"
+ "define-markup-commands.scm"
+ "define-grob-properties.scm"
+ "define-grobs.scm"
+ "define-grob-interfaces.scm"
+ "page-layout.scm"
+ "titling.scm"
+
+ "paper.scm"
+ "backend-library.scm"
+ ; last:
+ "safe-lily.scm"))
(set! type-p-name-alist
- `(
- (,boolean-or-symbol? . "boolean or symbol")
- (,boolean? . "boolean")
- (,char? . "char")
- (,grob-list? . "list of grobs")
- (,hash-table? . "hash table")
- (,input-port? . "input port")
- (,integer? . "integer")
- (,list? . "list")
- (,ly:context? . "context")
- (,ly:dimension? . "dimension, in staff space")
- (,ly:dir? . "direction")
- (,ly:duration? . "duration")
- (,ly:grob? . "layout object")
- (,ly:input-location? . "input location")
- (,ly:moment? . "moment")
- (,ly:music? . "music")
- (,ly:pitch? . "pitch")
- (,ly:translator? . "translator")
- (,ly:font-metric? . "font metric")
- (,markup-list? . "list of markups")
- (,markup? . "markup")
- (,ly:music-list? . "list of music")
- (,number-or-grob? . "number or grob")
- (,number-or-string? . "number or string")
- (,number-pair? . "pair of numbers")
- (,number? . "number")
- (,output-port? . "output port")
- (,pair? . "pair")
- (,procedure? . "procedure")
- (,scheme? . "any type")
- (,string? . "string")
- (,symbol? . "symbol")
- (,vector? . "vector")
- ))
+ `(
+ (,boolean-or-symbol? . "boolean or symbol")
+ (,boolean? . "boolean")
+ (,char? . "char")
+ (,grob-list? . "list of grobs")
+ (,hash-table? . "hash table")
+ (,input-port? . "input port")
+ (,integer? . "integer")
+ (,list? . "list")
+ (,ly:context? . "context")
+ (,ly:dimension? . "dimension, in staff space")
+ (,ly:dir? . "direction")
+ (,ly:duration? . "duration")
+ (,ly:grob? . "layout object")
+ (,ly:input-location? . "input location")
+ (,ly:moment? . "moment")
+ (,ly:music? . "music")
+ (,ly:pitch? . "pitch")
+ (,ly:translator? . "translator")
+ (,ly:font-metric? . "font metric")
+ (,markup-list? . "list of markups")
+ (,markup? . "markup")
+ (,ly:music-list? . "list of music")
+ (,number-or-grob? . "number or grob")
+ (,number-or-string? . "number or string")
+ (,number-pair? . "pair of numbers")
+ (,number? . "number")
+ (,output-port? . "output port")
+ (,pair? . "pair")
+ (,procedure? . "procedure")
+ (,scheme? . "any type")
+ (,string? . "string")
+ (,symbol? . "symbol")
+ (,vector? . "vector")))
;; debug mem leaks
(define gc-protect-stat-count 0)
(define-public (dump-gc-protects)
- (set! gc-protect-stat-count (1+ gc-protect-stat-count) )
- (let*
- ((protects (sort
- (hash-table->alist (ly:protects))
- (lambda (a b)
- (< (object-address (car a))
- (object-address (car b))))))
- (outfile (open-file (string-append
- "gcstat-" (number->string gc-protect-stat-count)
- ".scm"
- ) "w")))
-
- (display "DUMPING...\n")
+ (set! gc-protect-stat-count (1+ gc-protect-stat-count))
+ (let* ((protects (sort
+ (hash-table->alist (ly:protects))
+ (lambda (a b)
+ (< (object-address (car a))
+ (object-address (car b))))))
+ (out-file-name (string-append
+ "gcstat-" (number->string gc-protect-stat-count)
+ ".scm"))
+ (outfile (open-file out-file-name "w")))
+
+ (display "Dumping gc protected objs to ...\n")
(display
(filter
(lambda (x) (not (symbol? x)))
(map (lambda (y)
- (let
- ((x (car y))
- (c (cdr y)))
+ (let ((x (car y))
+ (c (cdr y)))
(string-append
(string-join
outfile)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-public (ly:system command)
- (let*
- ((status 0)
-
- (silenced
- (string-append command (if (ly:get-option 'verbose)
- ""
- " > /dev/null 2>&1 "))))
-
- (if (ly:get-option 'verbose)
- (format (current-error-port) (_ "Invoking `~a'...\n") command))
-
- (set! status (system silenced))
- (if (> status 0)
- (begin
- (format (current-error-port)
- (_ "Error invoking `~a'. Return value ~a") silenced status)
- (newline (current-error-port))))))
-
-(define-public (sanitize-command-option str)
- (string-append
- "\""
- (regexp-substitute/global #f "[^- 0-9,.a-zA-Z'\"\\]" str 'pre 'post)
- "\""))
-
-(define-public (postscript->pdf papersizename name)
- (let* ((cmd (string-append "ps2pdf "
- (string-append
- " -sPAPERSIZE="
- (sanitize-command-option papersizename)
- " "
- name)))
- (pdf-name (string-append (basename name ".ps") ".pdf" )))
-
- (if (access? pdf-name W_OK)
- (delete-file pdf-name))
-
- (format (current-error-port) (_ "Converting to `~a'...") pdf-name)
- (ly:system cmd)))
-
-(define-public (postscript->png resolution name)
- (let
- ((cmd (string-append
- "ps2png --resolution="
- (if (number? resolution)
- (number->string resolution)
- "90 ")
- (if (ly:get-option 'verbose)
- "--verbose "
- " ")
- name)))
- (ly:system cmd)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (lilypond-main files)
"Entry point for LilyPond."
(for-each
(lambda (f)
(catch 'ly-file-failed (lambda () (ly:parse-file f)) handler)
-;;; (dump-gc-protects)
- )
+ (if #f
+ (dump-gc-protects)))
files)
-
+
(if (pair? failed)
(begin
(newline (current-error-port))
(exit 1))
(exit 0))))
-
(define-public (tweak-grob-property grob sym val)
- (set! (ly:grob-property grob sym) val))
+ (set! (ly:grob-property grob sym) val))
projects / lilypond.git / blobdiff