;;;;
;;;; 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>
(if (defined? 'set-debug-cell-accesses!)
(set-debug-cell-accesses! #f))
-;;(set-debug-cell-accesses! 5000)
+;(set-debug-cell-accesses! 1000)
(use-modules (ice-9 regex)
(ice-9 safe)
+ (ice-9 optargs)
(oop goops)
- (srfi srfi-1) ; lists
- (srfi srfi-13)) ; strings
+ (srfi srfi-1) ;; lists
+ (srfi srfi-13)) ;; strings
;; my display
(debug-enable 'backtrace)
(read-enable 'positions)))
-(define-public (line-column-location file line col)
- "Print an input location, including column number ."
- (string-append (number->string line) ":"
- (number->string col) " " file))
+;; initialize defaults.
+(ly:set-option 'command-line-settings
+ '((resolution . 90)
+ (preview-include-book-title . #t)
+ ))
-(define-public (line-location file line col)
- "Print an input location, without column number ."
- (string-append (number->string line) " " file))
-
-(define-public point-and-click #f)
+(define-public tex-backend?
+ (member (ly:output-backend) '("texstr" "tex")))
(define-public parser #f)
(define-public _ ly:gettext))
(define-public (ly:load x)
- (let* ((fn (%search-load-path x)))
+ (let* ((file-name (%search-load-path x)))
+ (if (ly:get-option 'verbose)
+ (ly:progress "[~A" file-name))
+ (primitive-load file-name)
(if (ly:get-option 'verbose)
- (format (current-error-port) "[~A]" fn))
- (primitive-load fn)))
+ (ly:progress "]"))))
(define-public TEX_STRING_HASHLIMIT 10000000)
(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))
blank
bracket
char
+ circle
dashed-line
dashed-slur
dot
repeat-slash
round-filled-box
text
+ url-link
+ utf8-string
white-dot
white-text
embedded-ps
placebox
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"
+ "file-cache.scm"
"define-music-types.scm"
"output-lib.scm"
"c++.scm"
"chord-entry.scm"
"chord-generic-names.scm"
"stencil.scm"
- "new-markup.scm"
+ "markup.scm"
"bass-figure.scm"
"music-functions.scm"
"part-combiner.scm"
"titling.scm"
"paper.scm"
+ "backend-library.scm"
+ "x11-color.scm"
- ; last:
+ ;; must be after everything has been defined
"safe-lily.scm"))
protects))
outfile)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; backend helpers.
-
-(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 (postprocess-output paper-book module filename formats)
- (for-each (lambda (f)
- ((eval (string->symbol (string-append "convert-to-" f))
- module)
- paper-book filename))
-
- formats))
-
-(define-public (completize-formats formats)
- (if (member "png" formats)
- (set! formats (cons "ps" formats)))
- (if (member "pdf" formats)
- (set! formats (cons "ps" formats)))
-
- (uniq-list formats))
+(define-public (tweak-grob-property grob sym val)
+ (set! (ly:grob-property grob sym) val))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
(define-public (lilypond-main files)
"Entry point for LilyPond."
- (let* ((failed '())
- (handler (lambda (key arg) (set! failed (cons arg failed)))))
- (for-each
- (lambda (f)
- (catch 'ly-file-failed (lambda () (ly:parse-file f)) handler)
- (if #f
- (dump-gc-protects)))
- files)
-
+
+ (if (null? files)
+ (no-files-handler))
+
+ (let ((failed (lilypond-all files)))
(if (pair? failed)
(begin
- (newline (current-error-port))
- (display (_ "error: failed files: ") (current-error-port))
- (display (string-join failed) (current-error-port))
- (newline (current-error-port))
- (newline (current-error-port))
+ (ly:error (_ "failed files: ~S") (string-join failed))
(exit 1))
- (exit 0))))
+ (begin
+ ;; HACK: be sure to exit with single newline
+ (ly:message "")
+ (exit 0)))))
-(define-public (tweak-grob-property grob sym val)
- (set! (ly:grob-property grob sym) val))
+(define (no-files-handler)
+ (ly:usage)
+ (exit 2))
+
+(define-public (lilypond-all files)
+ (let* ((failed '())
+ (handler (lambda (key failed-file)
+ (set! failed (append (list failed-file) failed)))))
+ ;;(handler (lambda (key . arg) (set! failed (append arg failed)))))
+ (for-each (lambda (x) (lilypond-file handler x)) files)))
+
+(define (lilypond-file handler file-name)
+ (catch 'ly-file-failed
+ (lambda () (ly:parse-file file-name))
+ (lambda (x . args) (handler x file-name)))
+ ;;(lambda (x) (handler x f)))
+ (if #f
+ (dump-gc-protects)))
+
+(use-modules (scm editor))
+
+(define-public (gui-main files)
+ (if (null? files) (gui-no-files-handler))
+ (let* ((base (basename (car files) ".ly"))
+ (log-name (string-append base ".log"))
+ (log-file (open-file log-name "w")))
+ (display "# -*-compilation-*-" log-file)
+ (newline log-file)
+ (ly:message (_ "Redirecting output to ~a...") log-name)
+ (ly:port-move (fileno (current-error-port)) log-file)
+ (if (null? (lilypond-all files))
+ (exit 0)
+ (begin
+ (system (get-editor-command log-name 0 0))
+ (exit 1)))))
+
+(define (gui-no-files-handler)
+ (let* ((input (string-append
+ (string-regexp-substitute
+ "share/lilypond/" "share/doc/lilypond-"
+ (getenv "LILYPONDPREFIX"))
+ "-1/input"))
+ (ly (string-append input "/" "Welcome to LilyPond.ly"))
+ (cmd (get-editor-command ly 0 0)))
+ (system cmd)))
+
+;; FIXME
+;; (define lilypond-main gui-main)