From: Han-Wen Nienhuys Date: Tue, 23 Jan 2007 14:59:23 +0000 (+0100) Subject: Scheme coverage fixes. X-Git-Tag: release/2.11.14-1~56 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c99eab889ab542b4a6e265ec207dba65342e39da;p=lilypond.git Scheme coverage fixes. --- diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 670e28e538..213d995c2c 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -52,10 +52,6 @@ (string-append "/" command " { /" fontname " " (ly:number->string scaling) " output-scale div selectfont } bind def\n")) - (define (standard-tex-font? x) - (or (equal? (substring x 0 2) "ms") - (equal? (substring x 0 2) "cm"))) - (define (font-load-command font) (let* ((specced-font-name (ly:font-name font)) (fontname (if specced-font-name @@ -70,10 +66,6 @@ (ops (ly:output-def-lookup paper 'output-scale)) (scaling (* ops magnification designsize))) - ;; Bluesky pfbs have UPCASE names (sigh.) - ;; FIXME - don't support Bluesky? - (if (standard-tex-font? fontname) - (set! fontname (string-upcase fontname))) (if (equal? fontname "unknown") (display (list font fontname))) (define-font plain fontname scaling))) diff --git a/scm/lily.scm b/scm/lily.scm index 183b71e490..a5aee5458b 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -628,7 +628,6 @@ The syntax is the same as `define*-public'." (let ((failed (lilypond-all files))) (if (ly:get-option 'trace-scheme-coverage) (begin - (coverage:disable) (coverage:show-all (lambda (f) (string-contains f "lilypond")) ))) diff --git a/scm/markup.scm b/scm/markup.scm index c786c16890..5efe02732a 100644 --- a/scm/markup.scm +++ b/scm/markup.scm @@ -350,9 +350,14 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg: (cdr arg))))) ;; -;; typecheck, and throw an error when something amiss. +;; +;; ;; (define (markup-thrower-typecheck arg) + "typecheck, and throw an error when something amiss. + +Uncovered - cheap-markup? is used." + (cond ((string? arg) #t) ((not (pair? arg)) (throw 'markup-format "Not a pair" arg)) diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 234faf41b5..049f27ea3a 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -628,11 +628,6 @@ SkipEvent. Useful for extracting parts from crowded scores" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; warn for bare chords at start. -(define (has-request-chord elts) - (reduce (lambda (x y) (or x y)) #f - (map (lambda (x) - (equal? (ly:music-property x 'name) 'RequestChord)) - elts))) (define-public (ly:music-message music msg) (let ((ip (ly:music-property music 'origin))) @@ -640,25 +635,6 @@ SkipEvent. Useful for extracting parts from crowded scores" (ly:input-message ip msg) (ly:warning msg)))) -(define (check-start-chords music) - "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), -without context specification. Called from parser." - (let ((es (ly:music-property music 'elements)) - (e (ly:music-property music 'element)) - (name (ly:music-property music 'name))) - (cond ((equal? name "Context_specced_music") #t) - ((equal? name "Simultaneous_music") - (if (has-request-chord es) - (ly:music-message music "Starting score with a chord.\nInsert an explicit \\context before chord") - (map check-start-chords es))) - ((equal? name "SequentialMusic") - (if (pair? es) - (check-start-chords (car es)))) - (else (if (ly:music? e) (check-start-chords e))))) - music) - - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; setting stuff for grace context. diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 594acedea7..b82c185e02 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -38,7 +38,7 @@ setcolor setrotation text - zigzag-line)) + )) (use-modules (guile) @@ -70,22 +70,6 @@ (define (numbers->string4 numlist) (string-join (map str4 numlist) " ")) -;; FIXME: lily-def -(define-public (ps-string-def prefix key val) - (ly:format "/ ~a~a (~a) def\n" - prefix - (symbol->string key) - (escape-parentheses val))) - -(define (ps-number-def prefix key val) - (let ((s (if (integer? val) - (ly:number->string val) - (ly:number->string (exact->inexact val))))) - (ly:format "/~a~a ~a def\n" - prefix - (symbol->string key) s))) - - ;;; ;;; Lily output interface, PostScript implementation --- cleanup and docme ;;; @@ -198,13 +182,6 @@ (cadddr location)) ""))))) -(define (lily-def key val) - (let ((prefix "lilypondlayout")) - (if (string=? - (substring key 0 (min (string-length prefix) (string-length key))) - prefix) - (format "/~a { ~a } bind def\n" key val) - (format "/~a (~a) def\n" key val)))) (define (named-glyph font glyph) (ly:format "~a /~a glyphshow " ;;Why is there a space at the end? @@ -300,17 +277,6 @@ (define (utf-8-string pango-font-description string) (ly:warning (_ "utf-8-string encountered in PS backend"))) - -(define (zigzag-line is-center zzw zzh thick dx dy) - (ly:format "~a ~4f ~4f ~4f 0 0 ~4f ~4f draw_zigzag_line" - (if is-center "true" "false") - zzw - zzh - thick - dx - dy)) - - (define (path thickness exps) (define (convert-path-exps exps) (if (pair? exps) diff --git a/scm/output-tex.scm b/scm/output-tex.scm index d9a97b9093..4be3278397 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -27,7 +27,6 @@ dashed-slur named-glyph dashed-line - zigzag-line comment repeat-slash placebox @@ -101,9 +100,6 @@ (define (dashed-line thick on off dx dy phase) (embedded-ps (list 'dashed-line thick on off dx dy phase))) -(define (zigzag-line centre? zzw zzh thick dx dy) - (embedded-ps (list 'zigzag-line centre? zzw zzh thick dx dy))) - (define (embedded-ps expr) (let ((ps-string (with-output-to-string @@ -180,4 +176,4 @@ (string-append "\\special{src:" (line-column-location location) "}") "")) - "")) \ No newline at end of file + "")) diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm index 9959afdbfe..fe17642c43 100644 --- a/scm/ps-to-png.scm +++ b/scm/ps-to-png.scm @@ -50,30 +50,6 @@ (define-public (gulp-file file-name . max-size) (ly:gulp-file file-name (if (pair? max-size) (car max-size)))) -(define BOUNDING-BOX-RE - "^%%BoundingBox: (-?[0-9]+) (-?[0-9]+) (-?[0-9]+) (-?[0-9]+)") - -(define (unused-found-broken-get-bbox file-name) - (let* ((bbox (string-append file-name ".bbox")) - ;; -sOutputFile does not work with bbox? - (cmd (format #t "gs\ - -sDEVICE=bbox\ - -q\ - -dNOPAUSE\ - ~S\ - -c showpage\ - -c quit 2>~S" - file-name bbox)) - (status (system cmd)) - (s (gulp-file bbox 10240)) - (m (string-match BOUNDING_BOX_RE s))) - - (if m - (list->vector - (map (lambda (x) (string->number (car x))) (vector->list m))) - #f))) - - ;; copy of ly:system. ly:* not available via lilypond-ps2png.scm (define (my-system be-verbose exit-on-error cmd) (define status 0) diff --git a/scm/to-xml.scm b/scm/to-xml.scm index 409247d0a5..437cc03b4a 100644 --- a/scm/to-xml.scm +++ b/scm/to-xml.scm @@ -89,19 +89,6 @@ is then separated. (numer . ,(car (ly:duration-factor d))) (denom . ,(cdr (ly:duration-factor d)))))) -(define (musicxml-pitch->xml-node p) - (make - #:name 'pitch - #:children - (list - (make - #:name 'step - #:value (list-ref '("C" "D" "E" "F" "G" "A" "B") - (ly:pitch-notename p))) - (make - #:name 'octave - #:value (number->string (ly:pitch-octave p)))))) - (define (pitch->xml-node p) (make #:name 'pitch @@ -250,7 +237,6 @@ is then separated. ;; ;; (display (dtd-header) port) - (define pitch->xml-node musicxml-pitch->xml-node) (define duration->xml-node musicxml-duration->xml-node) (display (open-tag 'music '((type . score)) '()) port)