]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/lily.scm
* scm/editor.scm: New module.
[lilypond.git] / scm / lily.scm
index ac39758fdb4d96cfb906967edaedf8bc02902f59..31d482a17e55663059bfac1affa63042868d5cb3 100644 (file)
@@ -2,20 +2,21 @@
 ;;;;
 ;;;;  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))
-
-(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)
+;; initialize defaults. 
+(ly:set-option 'command-line-settings
+              '((resolution . 90)
+                (preview-include-book-title . #t)
+                ))
 
 (define-public tex-backend?
   (member (ly:output-backend) '("texstr" "tex")))
     (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)
 
@@ -88,10 +86,11 @@ predicates. Print a message at LOCATION if any predicate failed."
       (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))
 
@@ -124,6 +123,7 @@ predicates. Print a message at LOCATION if any predicate failed."
     blank
     bracket
     char
+    circle
     dashed-line
     dashed-slur
     dot
@@ -137,6 +137,8 @@ predicates. Print a message at LOCATION if any predicate failed."
     repeat-slash
     round-filled-box
     text
+    url-link
+    utf8-string
     white-dot
     white-text
     embedded-ps
@@ -155,12 +157,33 @@ predicates. Print a message at LOCATION if any predicate failed."
     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"
@@ -168,7 +191,7 @@ predicates. Print a message at LOCATION if any predicate failed."
            "chord-entry.scm"
            "chord-generic-names.scm"
            "stencil.scm"
-           "new-markup.scm"
+           "markup.scm"
            "bass-figure.scm"
            "music-functions.scm"
            "part-combiner.scm"
@@ -198,7 +221,9 @@ predicates. Print a message at LOCATION if any predicate failed."
            
            "paper.scm"
            "backend-library.scm"
-                                       ; last:
+           "x11-color.scm"
+
+           ;; must be after everything has been defined
            "safe-lily.scm"))
 
 
@@ -270,29 +295,71 @@ predicates. Print a message at LOCATION if any predicate failed."
           protects))
      outfile)))
 
+(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)