Rewrite `ly-getcwd' for Guile 1.8 backward compat.

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index d62c70bb0ff471637ce3aabe05f7c01fc40e1295..8cfebbd0db26366f405b8f93712f82470eefbd52 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -1,9 +1,20 @@
-;;;; lily.scm -- top-level Scheme stuff
+;;;; This file is part of LilyPond, the GNU music typesetter.

 ;;;;
 ;;;;

-;;;;  source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org>

 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>

+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.

 
 ;; Internationalisation: (_i "to be translated") gets an entry in the
 ;; POT file; (gettext ...) must be invoked explicitly to do the actual
 
 ;; Internationalisation: (_i "to be translated") gets an entry in the
 ;; POT file; (gettext ...) must be invoked explicitly to do the actual


@@ -38,9 +49,12 @@
 "Render at higher resolution (using given factor)
 and scale down result to prevent jaggies in
 PNG images.")
 "Render at higher resolution (using given factor)
 and scale down result to prevent jaggies in
 PNG images.")

+    (aux-files #t 
+"Create .tex, .texi, .count files in the 
+EPS backend.")

     (backend ps
 "Select backend.  Possible values: 'eps, 'null,
     (backend ps
 "Select backend.  Possible values: 'eps, 'null,

-'ps, 'scm, 'svg.")
+'ps, 'scm, 'socket, 'svg.")

     (check-internal-types #f
 "Check every property assignment for types.")
     (clip-systems #f
     (check-internal-types #f
 "Check every property assignment for types.")
     (clip-systems #f


@@ -65,7 +79,7 @@ configurations.")
 "Debug cyclic callback chains.")
     (debug-skylines #f
 "Debug skylines.")
 "Debug cyclic callback chains.")
     (debug-skylines #f
 "Debug skylines.")

-    (delete-intermediate-files #f
+    (delete-intermediate-files #t

 "Delete unusable, intermediate PostScript files.")
     (dump-profile #f
 "Dump memory and time information for each file.")
 "Delete unusable, intermediate PostScript files.")
     (dump-profile #f
 "Dump memory and time information for each file.")


@@ -101,6 +115,9 @@ output to log file `FOO.log'.")
                         "midi")
 "Set the default file extension for MIDI output
 file to given string.")
                         "midi")
 "Set the default file extension for MIDI output
 file to given string.")

+    (music-strings-to-paths #f
+"Convert text strings to paths when glyphs belong
+to a music font.")

     (old-relative #f
 "Make \\relative mode for simultaneous music work
 similar to chord syntax.")
     (old-relative #f
 "Make \\relative mode for simultaneous music work
 similar to chord syntax.")


@@ -111,7 +128,7 @@ similar to chord syntax.")
     (pixmap-format "png16m"
 "Set GhostScript's output format for pixel images.")
     (preview #f
     (pixmap-format "png16m"
 "Set GhostScript's output format for pixel images.")
     (preview #f

-"Create PNG and EPS preview images also.")
+"Create preview images also.")

     (print-pages #t
 "Print pages in the normal way.")
     (protected-scheme-parsing #t
     (print-pages #t
 "Print pages in the normal way.")
     (protected-scheme-parsing #t


@@ -152,6 +169,9 @@ second.  Dump results to `FILE.stacks' and
 "List available font names.")
     (verbose ,(ly:command-line-verbose?)
 "Value of the --verbose flag (read-only).")
 "List available font names.")
     (verbose ,(ly:command-line-verbose?)
 "Value of the --verbose flag (read-only).")

+    (warning-as-error #f
+"Change all warning and programming_error
+messages into errors.")

     ))
 
 ;; Need to do this in the beginning.  Other parts of the Scheme
     ))
 
 ;; Need to do this in the beginning.  Other parts of the Scheme


@@ -173,17 +193,17 @@ second.  Dump results to `FILE.stacks' and
                                        ;(set-debug-cell-accesses! 1000)
 
 (use-modules (ice-9 regex)
                                        ;(set-debug-cell-accesses! 1000)
 
 (use-modules (ice-9 regex)

-            (ice-9 safe)
-            (ice-9 format)
-            (ice-9 rdelim)
-             (ice-9 optargs)
-            (oop goops)
-            (srfi srfi-1)
-            (srfi srfi-13)
-            (srfi srfi-14)
-            (scm clip-region)
-            (scm memory-trace)
-            (scm coverage))
+              (ice-9 safe)
+              (ice-9 format)
+              (ice-9 rdelim)
+              (ice-9 optargs)
+              (oop goops)
+              (srfi srfi-1)
+              (srfi srfi-13)
+              (srfi srfi-14)
+              (scm clip-region)
+              (scm memory-trace)
+              (scm coverage))

 
 (define-public fancy-format
   format)
 
 (define-public fancy-format
   format)


@@ -228,11 +248,13 @@ second.  Dump results to `FILE.stacks' and
 
 (define-public parser #f)
 
 
 (define-public parser #f)
 

+(define music-string-to-path-backends
+  '(svg))

 
 

-;; gettext wrapper for guile < 1.7.2
-(if (defined? 'gettext)
-    (define-public _ gettext)
-    (define-public _ ly:gettext))
+(if (memq (ly:get-option 'backend) music-string-to-path-backends)
+    (ly:set-option 'music-strings-to-paths #t))
+
+(define-public _ gettext)

 
 (define-public (ly:load x)
   (let* ((file-name (%search-load-path x)))
 
 (define-public (ly:load x)
   (let* ((file-name (%search-load-path x)))


@@ -250,25 +272,17 @@ second.  Dump results to `FILE.stacks' and
     (if (null? (cdr platform)) #f
        (member (string-downcase (cadr platform)) '("95" "98" "me")))))
 
     (if (null? (cdr platform)) #f
        (member (string-downcase (cadr platform)) '("95" "98" "me")))))
 

-(case PLATFORM
-  ((windows)
-   (define native-getcwd
-     getcwd)
-
-   (define (slashify x)
-     (if (string-index x #\\)
-        x
-        (string-regexp-substitute
-         "//*" "/"
-         (string-regexp-substitute "\\\\" "/" x))))
-
-   ;; FIXME: this prints a warning.
-   (define-public (ly-getcwd)
-     (slashify (native-getcwd))))
+(define (slashify x)
+  (if (string-index x #\\)
+      x
+      (string-regexp-substitute
+       "//*" "/"
+       (string-regexp-substitute "\\\\" "/" x))))

 
 

-  (else
-   (define-public ly-getcwd
-     getcwd)))
+(define-public (ly-getcwd)
+  (if (eq? PLATFORM 'windows)
+      (slashify (getcwd))
+      (getcwd)))

 
 (define-public (is-absolute? file-name)
   (let ((file-name-length (string-length file-name)))
 
 (define-public (is-absolute? file-name)
   (let ((file-name-length (string-length file-name)))


@@ -303,16 +317,6 @@ Print a message at LOCATION if any predicate failed."
             (recursion-helper (cdr signature) (cdr arguments) (1+ count)))))
   (recursion-helper signature arguments 1))
 
             (recursion-helper (cdr signature) (cdr arguments) (1+ count)))))
   (recursion-helper signature arguments 1))
 

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;  output
-
-;; (define-public (output-framework) (write "hello\n"))
-
-(define output-ps-module
-  (make-module 1021 (list (resolve-interface '(scm output-ps)))))
-
-(define-public (ps-output-expression expr port)
-  (display (eval expr output-ps-module) port))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Safe definitions utility
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Safe definitions utility


@@ -368,6 +372,7 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
     "part-combiner.scm"
     "autochange.scm"
     "define-music-properties.scm"
     "part-combiner.scm"
     "autochange.scm"
     "define-music-properties.scm"

+    "beam-settings.scm"

     "auto-beam.scm"
     "chord-name.scm"
 
     "auto-beam.scm"
     "chord-name.scm"
 


@@ -398,6 +403,7 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
     "paper.scm"
     "backend-library.scm"
     "x11-color.scm"
     "paper.scm"
     "backend-library.scm"
     "x11-color.scm"

+    "tablature.scm"

 
     ;; must be after everything has been defined
     "safe-lily.scm"))
 
     ;; must be after everything has been defined
     "safe-lily.scm"))


@@ -405,29 +411,35 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
 (for-each ly:load init-scheme-files)
 
 (set! type-p-name-alist
 (for-each ly:load init-scheme-files)
 
 (set! type-p-name-alist

-      `((,boolean-or-symbol? . "boolean or symbol")
-       (,boolean? . "boolean")
+      `((,boolean? . "boolean")
+       (,boolean-or-symbol? . "boolean or symbol")

        (,char? . "char")
        (,grob-list? . "list of grobs")
        (,hash-table? . "hash table")
        (,input-port? . "input port")
        (,integer? . "integer")
        (,list? . "list")
        (,char? . "char")
        (,grob-list? . "list of grobs")
        (,hash-table? . "hash table")
        (,input-port? . "input port")
        (,integer? . "integer")
        (,list? . "list")

+       (,list-or-symbol? . "list or symbol")

        (,ly:context? . "context")
        (,ly:dimension? . "dimension, in staff space")
        (,ly:dir? . "direction")
        (,ly:duration? . "duration")
        (,ly:context? . "context")
        (,ly:dimension? . "dimension, in staff space")
        (,ly:dir? . "direction")
        (,ly:duration? . "duration")

+       (,ly:font-metric? . "font metric")

        (,ly:grob? . "layout object")
        (,ly:grob? . "layout object")

+       (,ly:grob-array? . "array of grobs")

        (,ly:input-location? . "input location")
        (,ly:moment? . "moment")
        (,ly:music? . "music")
        (,ly:input-location? . "input location")
        (,ly:moment? . "moment")
        (,ly:music? . "music")

+       (,ly:music-list? . "list of music objects")
+       (,ly:music-output? . "music output")

        (,ly:pitch? . "pitch")
        (,ly:translator? . "translator")
        (,ly:pitch? . "pitch")
        (,ly:translator? . "translator")

-       (,ly:font-metric? . "font metric")
+        (,ly:score? . "score")

        (,ly:simple-closure? . "simple closure")
        (,ly:simple-closure? . "simple closure")

+       (,ly:skyline-pair? . "pair of skylines")
+       (,ly:stencil? . "stencil")

        (,markup-list? . "list of markups")
        (,markup? . "markup")
        (,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-or-grob? . "number or grob")
        (,number-or-string? . "number or string")
        (,number-pair? . "pair of numbers")


@@ -435,9 +447,11 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
        (,output-port? . "output port")
        (,pair? . "pair")
        (,procedure? . "procedure")
        (,output-port? . "output port")
        (,pair? . "pair")
        (,procedure? . "procedure")

+       (,real? . "real number")

        (,rhythmic-location? . "rhythmic location")
        (,scheme? . "any type")
        (,string? . "string")
        (,rhythmic-location? . "rhythmic location")
        (,scheme? . "any type")
        (,string? . "string")

+       (,string-or-pair? . "string or pair")

        (,symbol? . "symbol")
        (,vector? . "vector")))
 
        (,symbol? . "symbol")
        (,vector? . "vector")))
 


@@ -449,8 +463,8 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
         (stats (gc-stats)))
     (list (- (+ (tms:cutime t)
                (tms:utime t))
         (stats (gc-stats)))
     (list (- (+ (tms:cutime t)
                (tms:utime t))

-            (ly:assoc-get 'gc-time-taken stats))
-         (ly:assoc-get 'total-cells-allocated  stats 0))))
+            (assoc-get 'gc-time-taken stats))
+         (assoc-get 'total-cells-allocated  stats 0))))

 
 (define (dump-profile base last this)
   (let* ((outname (format "~a.profile" (dir-basename base ".ly")))
 
 (define (dump-profile base last this)
   (let* ((outname (format "~a.profile" (dir-basename base ".ly")))


@@ -531,10 +545,8 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
                   (format "~a ~a ~a\n"
                           gc-protect-stat-count
                           sym
                   (format "~a ~a ~a\n"
                           gc-protect-stat-count
                           sym

-                          (let ((sym-stat (assoc sym stats)))
-                            (if sym-stat
-                                (cdr sym-stat)
-                                "?")))
+                          (assoc-get sym stats "?"))
+

                   outfile))
                '(protected-objects bytes-malloced cell-heap-size)))
     (set! gc-dumping #f)
                   outfile))
                '(protected-objects bytes-malloced cell-heap-size)))
     (set! gc-dumping #f)


@@ -706,8 +718,7 @@ PIDs or the number of the process."
         (ly:set-option 'debug-gc-assert-parsed-dead #f)
         (if (ly:get-option 'debug-gc)
             (dump-gc-protects)
         (ly:set-option 'debug-gc-assert-parsed-dead #f)
         (if (ly:get-option 'debug-gc)
             (dump-gc-protects)

-            (if (= (random 40) 1)
-                (ly:reset-all-fonts)))))
+            (ly:reset-all-fonts))))

      files)
 
     ;; we want the failed-files notice in the aggregrate logfile.
      files)
 
     ;; we want the failed-files notice in the aggregrate logfile.