X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=85c2f07dd7b0a56dea795b15cdabd0d6e0c8ff1e;hb=0df564d0a0db8bfa46f06a7828d85bb9bda3ba71;hp=7a7e47cc56579aa50fb6ae999b1e001f02a78c97;hpb=9879bd7a67e4f72c6fa7f30eb355f2dc56f9a4bc;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index 7a7e47cc56..85c2f07dd7 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -2,10 +2,46 @@ ;;;; ;;;; 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") + (preview-include-book-title #t "include book-titles in preview images.") + (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") + (ttf-verbosity 0 + "how much verbosity for TTF font embedding?") + (debug-gc #f + "dump GC protection info")) + )) + +;; FIXME: stray statement +(define-scheme-options) + (if (defined? 'set-debug-cell-accesses!) (set-debug-cell-accesses! #f)) @@ -37,12 +73,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"))) @@ -58,9 +88,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) @@ -77,6 +104,52 @@ (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) #\/)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (type-check-list location signature arguments) @@ -115,49 +188,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)) @@ -193,22 +223,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" @@ -217,7 +247,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" @@ -249,6 +280,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") @@ -275,33 +307,58 @@ 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))) - -(define-public (tweak-grob-property grob sym val) - (set! (ly:grob-property grob sym) val)) + 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) + (stringsymbol - (string-downcase - (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))) - ((linux) #t) - ;; On mingw, use gui-main - ((windows) (define lilypond-main gui-main))) - -;;(if (ly:get-option 'quiet) -;; (define lilypond-main gui-main)) + (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 0))) + (ly:message (_ "Invoking `~a'...") cmd) + (system cmd) + (exit 1)))