(ice-9 safe)
(ice-9 optargs)
(oop goops)
- (srfi srfi-1) ; lists
- (srfi srfi-13)) ; strings
+ (srfi srfi-1)
+ (srfi srfi-13)
+ (srfi srfi-14))
;; my display
(define-public TEX_STRING_HASHLIMIT 10000000)
+;; Cygwin
+;; #(CYGWIN_NT-5.1 Hostname 1.5.12(0.116/4/2) 2004-11-10 08:34 i686)
+;;
+;; Debian
+;; #(Linux hostname 2.4.27-1-686 #1 Fri Sep 3 06:28:00 UTC 2004 i686)
+;;
+;; Mingw
+;; #(Windows XP HOSTNAME build 2600 5.01 Service Pack 1 i686)
+;;
+(define-public PLATFORM
+ (string->symbol
+ (string-downcase
+ (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
+
+(case PLATFORM
+ ((windows)
+ (define native-getcwd getcwd)
+ (define (slashify x)
+ (if (string-index x #\/)
+ x
+ (string-regexp-substitute "\\\\" "/" x)))
+ ;; FIXME: this prints a warning.
+ (define-public (ly-getcwd)
+ (slashify (native-getcwd))))
+ (else (define-public ly-getcwd getcwd)))
+
+(define-public (is-absolute? file-name)
+ (let ((file-name-length (string-length file-name)))
+ (if (= file-name-length 0)
+ #f
+ (or (eq? (string-ref file-name 0) #\/)
+ (and (eq? PLATFORM 'windows)
+ (> file-name-length 2)
+ (eq? (string-ref file-name 1) #\:)
+ (eq? (string-ref file-name 2) #\/))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (type-check-list location signature arguments)
dashed-slur
dot
draw-line
- ez-ball
filledbox
glyph-string
- horizontal-line
named-glyph
polygon
repeat-slash
protects))
outfile)))
+(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-main files)
"Entry point for LilyPond."
(if (null? files)
(no-files-handler))
- (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 (f)
- (catch 'ly-file-failed
- (lambda () (ly:parse-file f))
- (lambda (x . args) (handler x f)))
- ;;(lambda (x) (handler x f)))
- (if #f
- (dump-gc-protects)))
- files)
-
+ (let ((failed (lilypond-all files)))
(if (pair? failed)
(begin
(ly:error (_ "failed files: ~S") (string-join failed))
(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)
+ failed))
+
+(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 (running-from-gui?)
+ (let ((have-tty? (isatty? (current-input-port))))
+ ;; If no TTY and not using safe, assume running from GUI.
+ (cond
+ ((eq? PLATFORM 'windows)
+ ;; This only works for i586-mingw32msvc-gcc -mwindows
+ (not (string-match "standard input"
+ (format #f "~S" (current-input-port)))))
+ ((eq? PLATFORM 'darwin) #f)
+ (else
+ (not have-tty?)))))
+
+(define-public (gui-main files)
+ (if (null? files) (gui-no-files-handler))
+ (let* ((base (basename (car files) ".ly"))
+ (log-name (string-append base ".log")))
+ (if (not (running-from-gui?))
+ (ly:message (_ "Redirecting output to ~a...") log-name))
+ (ly:stderr-redirect log-name "w")
+ (ly:message "# -*-compilation-*-")
+ (let ((failed (lilypond-all files)))
+ (if (pair? failed)
+ (begin
+ ;; ugh
+ (ly:stderr-redirect "foo" "r")
+ (system (get-editor-command log-name 0 0))
+ (ly:error (_ "failed files: ~S") (string-join failed))
+ ;; not reached?
+ (exit 1))
+ (exit 0)))))
+
+(define (gui-no-files-handler)
+ (let* ((ly (string-append (ly:effective-prefix) "/ly/"))
+ ;; FIXME: soft-code, localize
+ (welcome-ly (string-append ly "Welcome_to_LilyPond.ly"))
+ (cmd (get-editor-command welcome-ly 0 0)))
+ (ly:message (_ "Invoking `~a'...") cmd)
+ (system cmd)
+ (exit 1)))
+
+(or (not (running-from-gui?))
+ (ly:get-option 'safe)
+ (define lilypond-main gui-main))