X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=db729e6567beb0c6f3c8490107e6614dc22abba9;hb=35076a4426e7e60c40010bf94a3326372be5b418;hp=4c0f0abc943ac43fafcc7326aba8a57c6fbf0b00;hpb=210397d5e1d8a0b560bac8e683c8be957035b5b4;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index 4c0f0abc94..db729e6567 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -2,10 +2,54 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2005 Jan Nieuwenhuizen +;;;; (c) 1998--2006 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +(define (define-scheme-options) + (for-each (lambda (x) + (ly:add-option (car x) (cadr x) (caddr x))) + + `((point-and-click #t "use point & click") + (paper-size "a4" "the default paper size") + (midi-debug #f "generate human readable MIDI") + (internal-type-checking #f "check every property assignment for types") + (parse-protect #t "continue when finding errors in inline +scheme are caught in the parser. If off, halt +on errors, and print a stack trace.") + (profile-property-accesses #f "keep statistics of get_property() calls.") + (old-relative #f + "relative for simultaneous music works +similar to chord syntax") + (object-keys #f + "experimental mechanism for remembering tweaks") + (resolution 101 "resolution for generating bitmaps") + (anti-alias-factor 1 "render at higher resolution and scale down result\nto prevent jaggies in PNG") + (book-title-preview #t "include book-titles in preview images.") + (eps-font-include #f "Include fonts in separate-system EPS files.") + (gs-font-load #f + "load fonts via Ghostscript.") + (gui #f "running from gui; redirect stderr to log file") + (delete-intermediate-files #f + "delete unusable PostScript files") + (safe #f "Run safely") + (verbose ,(ly:command-line-verbose?) "value for the --verbose flag") + (strict-infinity-checking #f "If yes, crash on encountering Inf/NaN") + (ttf-verbosity 0 + "how much verbosity for TTF font embedding?") + (debug-gc #f + "dump GC protection info") + (show-available-fonts #f + "List font names available.") + ) + )) + + +;; need to do this in the beginning. Other parts of the +;; Scheme init depend on these options. +;; +(define-scheme-options) + (if (defined? 'set-debug-cell-accesses!) (set-debug-cell-accesses! #f)) @@ -15,8 +59,9 @@ (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 @@ -36,12 +81,6 @@ (debug-enable 'backtrace) (read-enable 'positions))) -;; 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"))) @@ -57,9 +96,6 @@ -;; cpp hack to get useful error message -(define ifdef "First run this through cpp.") -(define ifndef "First run this through cpp.") ;; gettext wrapper for guile < 1.7.2 (if (defined? 'gettext) @@ -74,7 +110,51 @@ (if (ly:get-option 'verbose) (ly:progress "]")))) -(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) +;; + +;; ugh, code dup. +(define-public PLATFORM + (string->symbol + (string-downcase + (car (string-tokenize (vector-ref (uname) 0) char-set:letter))))) + +(define-public DOS + (let ((platform (string-tokenize + (vector-ref (uname) 0) char-set:letter+digit))) + (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)))) + (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) #\/)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -114,49 +194,6 @@ predicates. Print a message at LOCATION if any predicate failed." (define-public (ps-output-expression expr port) (display (eval expr output-ps-module) port)) -;; TODO: generate this list by registering the stencil expressions -;; stencil expressions should have docstrings. -(define-public (ly:all-stencil-expressions) - "Return list of stencil expressions." - '(beam - bezier-sandwich - blank - bracket - char - circle - dashed-line - dashed-slur - dot - draw-line - ez-ball - filledbox - glyph-string - horizontal-line - named-glyph - polygon - repeat-slash - round-filled-box - text - url-link - utf8-string - white-dot - white-text - embedded-ps - zigzag-line)) - -;; TODO: -;; - generate this list by registering the output-backend-commands -;; output-backend-commands should have docstrings. -;; - remove hard copies in output-ps output-tex -(define-public (ly:all-output-backend-commands) - "Return list of output backend commands." - '( - comment - grob-cause - no-origin - placebox - unknown)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Safe definitions utility (define safe-objects (list)) @@ -192,22 +229,22 @@ The syntax is the same as `define*-public'." "chord-generic-names.scm" "stencil.scm" "markup.scm" - "bass-figure.scm" "music-functions.scm" "part-combiner.scm" + "autochange.scm" "define-music-properties.scm" "auto-beam.scm" "chord-name.scm" - "ly-from-scheme.scm" + "parser-ly-from-scheme.scm" "define-context-properties.scm" "translation-functions.scm" "script.scm" "midi.scm" - "beam.scm" - "clef.scm" - "slur.scm" + "layout-beam.scm" + "parser-clef.scm" + "layout-slur.scm" "font.scm" "encoding.scm" @@ -216,7 +253,8 @@ The syntax is the same as `define*-public'." "define-grob-properties.scm" "define-grobs.scm" "define-grob-interfaces.scm" - "page-layout.scm" + "define-stencil-commands.scm" + "layout-page-layout.scm" "titling.scm" "paper.scm" @@ -248,6 +286,7 @@ The syntax is the same as `define*-public'." (,ly:pitch? . "pitch") (,ly:translator? . "translator") (,ly:font-metric? . "font metric") + (,ly:simple-closure? . "simple closure") (,markup-list? . "list of markups") (,markup? . "markup") (,ly:music-list? . "list of music") @@ -274,46 +313,65 @@ The syntax is the same as `define*-public'." (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 (format "Dumping gc protected objs to ~a...\n" out-file-name)) (display - (filter - (lambda (x) (not (symbol? x))) - (map (lambda (y) - (let ((x (car y)) - (c (cdr y))) - - (string-append - (string-join - (map object->string (list (object-address x) c x)) - " ") - "\n"))) + (map (lambda (y) + (let ((x (car y)) + (c (cdr y))) + + (string-append + (string-join + (map object->string (list (object-address x) c x)) + " ") + "\n"))) + + (filter + (lambda (x) + (not (symbol? (car x)))) protects)) - outfile))) - + outfile) + +; (display (ly:smob-protects)) + (newline outfile) + (if (defined? 'gc-live-object-stats) + (let* ((stats #f)) + (display "Live object statistics: GC'ing\n") + (gc) + (gc) + + (set! stats (gc-live-object-stats)) + (display "Dumping live object statistics.\n") + + (for-each + (lambda (x) + (format outfile "~a: ~a\n" (car x) (cdr x))) + (sort (gc-live-object-stats) + (lambda (x y) + (string