From dde989437f822ff637a191cfd76b1a9e943dbac5 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Michael=20K=C3=A4ppler?= Date: Thu, 17 Sep 2009 12:45:43 +0200 Subject: [PATCH] Turn assoc calls into secure assoc-get calls. * Second stage: Move those assoc calls to assoc-get which need only little code modification * Remove ly:assoc-get and ly:chain-assoc-get calls in *.scm. They are leftover from the time when those C procedures were not exported to Scheme. --- scm/c++.scm | 4 +- scm/define-markup-commands.scm | 111 ++++++++++++++------------- scm/define-music-display-methods.scm | 11 ++- scm/define-music-types.scm | 22 +++--- scm/document-backend.scm | 6 +- scm/document-translation.scm | 5 +- scm/documentation-lib.scm | 6 +- scm/fret-diagrams.scm | 10 +-- scm/lily.scm | 10 +-- scm/midi.scm | 27 ++++--- scm/music-functions.scm | 6 +- scm/output-lib.scm | 10 +-- scm/paper.scm | 32 ++++---- scm/parser-clef.scm | 12 +-- scm/song.scm | 10 +-- 15 files changed, 136 insertions(+), 146 deletions(-) diff --git a/scm/c++.scm b/scm/c++.scm index 3381a9e898..bccd15ed02 100644 --- a/scm/c++.scm +++ b/scm/c++.scm @@ -63,6 +63,4 @@ (type-name (match-predicate obj type-p-name-alist))) (define-public (type-name predicate) - (let ((entry (assoc predicate type-p-name-alist))) - (if (pair? entry) (cdr entry) - "unknown"))) + (assoc-get predicate type-p-name-alist "unknown")) diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 53d71aa916..933bfb27fb 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -1,14 +1,14 @@ ;;;; define-markup-commands.scm -- markup commands ;;;; ;;;; source file of the GNU LilyPond music typesetter -;;;; +;;;; ;;;; (c) 2000--2009 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen ;;; markup commands ;;; * each markup function should have a doc string with -;; syntax, description and example. +;; syntax, description and example. (use-modules (ice-9 regex)) @@ -163,7 +163,7 @@ Create a beam with the specified parameters. (half (/ thickness 2))) (ly:make-stencil - `(polygon ',(list + `(polygon ',(list 0 (/ thickness -2) width (+ (* width slope) (/ thickness -2)) width (+ (* width slope) (/ thickness 2)) @@ -279,7 +279,7 @@ c4^\\markup { } } c,8. c16 c4 r -@end lilypond" +@end lilypond" (let ((th (* (ly:output-def-lookup layout 'line-thickness) thickness)) (pad (* (magstep font-size) box-padding)) @@ -429,12 +429,12 @@ Use a stencil as markup. "Extract the bbox from STRING, or return #f if not present." (let* ((match (regexp-exec bbox-regexp string))) - + (if match (map (lambda (x) (string->number (match:substring match x))) (cdr (iota 5))) - + #f))) (define-builtin-markup-command (epsfile layout props axis size file-name) @@ -622,7 +622,7 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols. (join-stencil (interpret-markup layout props tie-str)) ) - (interpret-markup layout + (interpret-markup layout (prepend-alist-chain 'word-space (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5) @@ -645,10 +645,10 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols. Return a list of paddings." (cond ((null? text-widths) '()) - + ;; special case first padding ((= (length text-widths) word-count) - (cons + (cons (- (- (/ line-width (1- word-count)) (car text-widths)) (/ (car (cdr text-widths)) 2)) (get-fill-space word-count line-width (cdr text-widths)))) @@ -657,7 +657,7 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols. (list (- (/ line-width (1- word-count)) (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0)) (else - (cons + (cons (- (/ line-width (1- word-count)) (/ (+ (car text-widths) (car (cdr text-widths))) 2)) (get-fill-space word-count line-width (cdr text-widths)))))) @@ -707,14 +707,14 @@ If there are no arguments, return an empty stencil. (line-width (or line-width (ly:output-def-lookup layout 'line-width))) (fill-space (cond - ((= word-count 1) + ((= word-count 1) (list (/ (- line-width text-width) 2) (/ (- line-width text-width) 2))) ((= word-count 2) (list (- line-width text-width))) - (else + (else (get-fill-space word-count line-width text-widths)))) (fill-space-normal (map (lambda (x) @@ -722,7 +722,7 @@ If there are no arguments, return an empty stencil. word-space x)) fill-space)) - + (line-stencils (if (= word-count 1) (list point-stencil @@ -737,7 +737,7 @@ If there are no arguments, return an empty stencil. empty-stencil (stack-stencils-padding-list X RIGHT fill-space-normal line-stencils)))) - + (define-builtin-markup-command (line layout props args) (markup-list?) align @@ -803,7 +803,7 @@ equivalent to @code{\"fi\"}. (define (wordwrap-stencils stencils justify base-space line-width text-dir) - "Perform simple wordwrap, return stencil of each line." + "Perform simple wordwrap, return stencil of each line." (define space (if justify ;; justify only stretches lines. (* 0.7 base-space) @@ -833,7 +833,7 @@ equivalent to @code{\"fi\"}. line-stencils)))) (line-word-space (cond ((not justify) space) ;; don't stretch last line of paragraph. - ;; hmmm . bug - will overstretch the last line in some case. + ;; hmmm . bug - will overstretch the last line in some case. ((null? (cdr line-break)) base-space) ((null? line-stencils) 0.0) @@ -948,7 +948,7 @@ the line width, where @var{X} is the number of staff spaces. ((baseline-skip) wordwrap-string-internal-markup-list) "Wordwrap a string. Paragraphs may be separated with double newlines. - + @lilypond[verbatim,quote] \\markup { \\override #'(line-width . 40) @@ -974,7 +974,7 @@ the line width, where @var{X} is the number of staff spaces. ((baseline-skip) wordwrap-string-internal-markup-list) "Justify a string. Paragraphs may be separated with double newlines - + @lilypond[verbatim,quote] \\markup { \\override #'(line-width . 40) @@ -999,7 +999,7 @@ the line width, where @var{X} is the number of staff spaces. align () "Wordwrap the data which has been assigned to @var{symbol}. - + @lilypond[verbatim,quote] \\header { title = \"My title\" @@ -1033,7 +1033,7 @@ the line width, where @var{X} is the number of staff spaces. align () "Justify the data which has been assigned to @var{symbol}. - + @lilypond[verbatim,quote] \\header { title = \"My title\" @@ -1093,7 +1093,7 @@ curly braces as an argument; the follow example will not compile: ;; ;; TODO: should extract baseline-skip from each argument somehow.. -;; +;; (define-builtin-markup-command (column layout props args) (markup-list?) align @@ -1155,7 +1155,7 @@ setting of the @code{direction} layout property. (define (general-column align-dir baseline mols) "Stack @var{mols} vertically, aligned to @var{align-dir} horizontally." - + (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols))) (stack-lines -1 0.0 baseline aligned-mols))) @@ -1184,7 +1184,7 @@ Put @code{args} in a centered column. align ((baseline-skip)) " -@cindex text columns, left-aligned +@cindex text columns, left-aligned Put @code{args} in a left-aligned column. @@ -1392,7 +1392,7 @@ alignment accordingly. " @cindex setting extent of text objects -Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}." +Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}." (let* ((m (interpret-markup layout props arg))) (ly:make-stencil (ly:stencil-expr m) x y))) @@ -1401,7 +1401,7 @@ Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}." align () "Add padding @var{amount} all around @var{arg}. - + @lilypond[verbatim,quote] \\markup { \\box { @@ -1465,7 +1465,7 @@ Add padding @var{amount} around @var{arg} in the X@tie{}direction. other () "Make @var{arg} transparent. - + @lilypond[verbatim,quote] \\markup { \\transparent { @@ -1642,7 +1642,7 @@ may be any property supported by @rinternals{font-interface}, font () "Decrease the font size relative to the current setting. - + @lilypond[verbatim,quote] \\markup { \\fontsize #3.5 { @@ -1771,7 +1771,7 @@ Use @code{\\fontsize} otherwise. } @end lilypond" (interpret-markup - layout + layout (prepend-alist-chain 'font-size (magnification->font-size sz) props) arg)) @@ -1780,7 +1780,7 @@ Use @code{\\fontsize} otherwise. font () "Switch to bold font-series. - + @lilypond[verbatim,quote] \\markup { default @@ -1796,7 +1796,7 @@ Use @code{\\fontsize} otherwise. font () "Switch to the sans serif font family. - + @lilypond[verbatim,quote] \\markup { default @@ -1830,7 +1830,7 @@ some punctuation; it has no letters. font () "Set font family to @code{roman}. - + @lilypond[verbatim,quote] \\markup { \\sans \\bold { @@ -1883,7 +1883,7 @@ some punctuation; it has no letters. font () "Set font size to default. - + @lilypond[verbatim,quote] \\markup { \\teeny { @@ -1904,7 +1904,7 @@ some punctuation; it has no letters. font () "Set font size to -1. - + @lilypond[verbatim,quote] \\markup { default @@ -1920,7 +1920,7 @@ some punctuation; it has no letters. font () "Set font size to -2. - + @lilypond[verbatim,quote] \\markup { default @@ -1936,7 +1936,7 @@ some punctuation; it has no letters. font () "Set font size to -3. - + @lilypond[verbatim,quote] \\markup { default @@ -1952,7 +1952,7 @@ some punctuation; it has no letters. font () "Set @code{font-shape} to @code{caps} - + Note: @code{\\fontCaps} requires the installation and selection of fonts which support the @code{caps} font shape." (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg)) @@ -2046,7 +2046,7 @@ done in a different font. The recommended font for this is bold and italic. font () "Use a text font instead of music symbol or music alphabet font. - + @lilypond[verbatim,quote] \\markup { \\number { @@ -2084,7 +2084,7 @@ done in a different font. The recommended font for this is bold and italic. font () "Use @code{font-family} typewriter for @var{arg}. - + @lilypond[verbatim,quote] \\markup { default @@ -2196,7 +2196,7 @@ normal text font, no matter what font was used earlier. \\sesquisharp } @end lilypond" - (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist "")))) + (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist "")))) (define-builtin-markup-command (sharp layout props) () @@ -2369,7 +2369,7 @@ the possible glyphs. (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic) (font-name . #f)) - + props))) (glyph (ly:font-get-glyph font glyph-name))) (if (null? (ly:stencil-expr glyph)) @@ -2383,7 +2383,7 @@ the possible glyphs. other () "Lookup a glyph by name. - + @lilypond[verbatim,quote] \\markup { \\override #'(font-encoding . fetaBraces) { @@ -2427,7 +2427,7 @@ format require the prefix @code{#x}. (define (number->markletter-string vec n) "Double letters for big marks." (let* ((lst (vector-length vec))) - + (if (>= n lst) (string-append (number->markletter-string vec (1- (quotient n lst))) (number->markletter-string vec (remainder n lst))) @@ -2513,7 +2513,7 @@ and continue with double letters. (num-y (interval-widen (cons center center) (abs dy))) (is-sane (and (interval-sane? num-x) (interval-sane? num-y))) (slash-stencil (if is-sane - (make-line-stencil thickness + (make-line-stencil thickness (car num-x) (- (interval-center num-y) dy) (cdr num-x) (+ (interval-center num-y) dy)) #f))) @@ -2569,7 +2569,7 @@ figured bass notation. (slashed-digit-internal layout props num #f font-size thickness)) ;; eyeglasses -(define eyeglassesps +(define eyeglassesps "0.15 setlinewidth -0.9 0 translate 1.1 1.1 scale @@ -2689,14 +2689,14 @@ Construct a note symbol, with stem. By using fractional values for ""))) (list (if (= dir UP) "u" "d") "s"))) - + (define (get-glyph-name font cands) (if (null? cands) "" (if (ly:stencil-empty? (ly:font-get-glyph font (car cands))) (get-glyph-name font (cdr cands)) (car cands)))) - + (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props))) (size-factor (magstep font-size)) (stem-length (* size-factor (max 3 (- log 1)))) @@ -2719,7 +2719,7 @@ Construct a note symbol, with stem. By using fractional values for (cons (min stemy (cdr attach-off)) (max stemy (cdr attach-off))) (/ stem-thickness 3)))) - + (dot (ly:font-get-glyph font "dots.dot")) (dotwid (interval-length (ly:stencil-extent dot X))) (dots (and (> dot-count 0) @@ -2755,7 +2755,7 @@ Construct a note symbol, with stem. By using fractional values for stem-glyph))) stem-glyph)) -(define-public log2 +(define-public log2 (let ((divisor (log 2))) (lambda (z) (inexact->exact (/ (log z) divisor))))) @@ -2853,7 +2853,7 @@ Translate @var{arg} by @var{offset}, scaling the offset by the () " @cindex raising text - + Raise @var{arg} by the distance @var{amount}. A negative @var{amount} indicates lowering, see also @code{\\lower}. @@ -2940,7 +2940,7 @@ Set @var{arg} in superscript with a normal font size. font ((font-size 0) (baseline-skip)) - " + " @cindex superscript text Set @var{arg} in superscript. @@ -2969,7 +2969,7 @@ Set @var{arg} in superscript. () " @cindex translating text - + Translate @var{arg} relative to its surroundings. @var{offset} is a pair of numbers representing the displacement in the X and Y axis. @@ -3044,7 +3044,7 @@ Set @var{arg} in subscript with a normal font size. () " @cindex placing horizontal brackets around text - + Draw horizontal brackets around @var{arg}. @lilypond[verbatim,quote] @@ -3066,7 +3066,7 @@ Draw horizontal brackets around @var{arg}. () " @cindex placing vertical brackets around text - + Draw vertical brackets around @var{arg}. @lilypond[verbatim,quote] @@ -3102,8 +3102,9 @@ when @var{label} is not found." `(delay-stencil-evaluation ,(delay (ly:stencil-expr (let* ((table (ly:output-def-lookup layout 'label-page-table)) - (label-page (and (list? table) (assoc label table))) - (page-number (and label-page (cdr label-page))) + (page-number (if (list? table) + (assoc-get label table) + #f)) (page-markup (if page-number (format "~a" page-number) default)) (page-stencil (interpret-markup layout props page-markup)) (gap (- (interval-length x-ext) diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 72f94b0acf..a620150338 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -961,11 +961,11 @@ Otherwise, return #f." symbol 'clefOctavation) (music 'ApplyContext procedure ly:set-middle-C!))))) - (let ((clef-prop+name (assoc (list ?clef-glyph ?clef-position 0) + (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0) clef-name-alist))) - (if clef-prop+name + (if clef-name (format #f "\\clef \"~a~{~a~a~}\"~a" - (cdr clef-prop+name) + clef-name (cond ((= 0 ?clef-octavation) (list "" "")) ((> ?clef-octavation 0) @@ -1033,6 +1033,7 @@ Otherwise, return #f." ((= i dots) m) (set! m (+ m delta))) factor)))) + (define moment-duration-alist (map (lambda (duration) (cons (duration->moment duration) duration)) @@ -1043,9 +1044,7 @@ Otherwise, return #f." (list 0 1 2 3 4)))) (define (moment->duration moment) - (let ((result (assoc (- moment) moment-duration-alist =))) - (and result - (cdr result)))) + (assoc-get (- moment) moment-duration-alist)) (define-extra-display-method ContextSpeccedMusic (expr parser) "If `expr' is a partial measure, return \"\\partial ...\". diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm index 0dc1c66bcf..ad1073d1b3 100644 --- a/scm/define-music-types.scm +++ b/scm/define-music-types.scm @@ -690,14 +690,14 @@ and values. E.g: m))) (define-public (make-repeated-music name) - (let* ((handle (assoc name '(("volta" . VoltaRepeatedMusic) - ("unfold" . UnfoldedRepeatedMusic) - ("percent" . PercentRepeatedMusic) - ("tremolo" . TremoloRepeatedMusic)))) - (music-name (if (pair? handle) - (cdr handle) - (begin - (ly:warning (_ "unknown repeat type `~S'") name) - (ly:warning (_ "See define-music-types.scm for supported repeats")) - 'VoltaRepeatedMusic)))) - (make-music music-name))) + (let* ((repeated-music (assoc-get name '(("volta" . VoltaRepeatedMusic) + ("unfold" . UnfoldedRepeatedMusic) + ("percent" . PercentRepeatedMusic) + ("tremolo" . TremoloRepeatedMusic)))) + (repeated-music-name (if repeated-music + repeated-music + (begin + (ly:warning (_ "unknown repeat type `~S'") name) + (ly:warning (_ "See define-music-types.scm for supported repeats")) + 'VoltaRepeatedMusic)))) + (make-music repeated-music-name))) diff --git a/scm/document-backend.scm b/scm/document-backend.scm index 7ab9f85fb0..5fb8bf9622 100644 --- a/scm/document-backend.scm +++ b/scm/document-backend.scm @@ -61,8 +61,7 @@ ;; extract ifaces, and put grob into the hash table. (map (lambda (x) - (let* ((metah (assoc 'meta (cdr x))) - (meta (cdr metah)) + (let* ((meta (assoc-get 'meta (cdr x))) (ifaces (assoc-get 'interfaces meta))) (map (lambda (iface) @@ -110,8 +109,7 @@ "Given a property alist DESCRIPTION, make a documentation node." - (let* ((metah (assoc 'meta description)) - (meta (cdr metah)) + (let* ((meta (assoc-get 'meta description)) (name (assoc-get 'name meta)) ;; (bla (display name)) (ifaces (map lookup-interface (assoc-get 'interfaces meta))) diff --git a/scm/document-translation.scm b/scm/document-translation.scm index 154750ab8d..a9bf143c3d 100644 --- a/scm/document-translation.scm +++ b/scm/document-translation.scm @@ -151,10 +151,7 @@ (let* ((name-sym (assoc-get 'context-name context-desc)) (name (symbol->string name-sym)) (aliases (map symbol->string (assoc-get 'aliases context-desc))) - (desc-handle (assoc 'description context-desc)) - (desc (if (and (pair? desc-handle) (string? (cdr desc-handle))) - (cdr desc-handle) "(not documented)")) - + (desc (assoc-get 'description context-desc "(not documented")) (accepts (assoc-get 'accepts context-desc)) (consists (assoc-get 'consists context-desc)) (props (assoc-get 'property-ops context-desc)) diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm index 6f82b4018a..a97f0c2f76 100644 --- a/scm/documentation-lib.scm +++ b/scm/documentation-lib.scm @@ -182,7 +182,7 @@ with init values from ALIST (1st optional argument) (type (object-property sym type?-name)) (typename (type-name type)) (desc (object-property sym doc-name)) - (handle (assoc sym alist))) + (init-value (assoc-get sym alist))) (if (eq? desc #f) (ly:error (_ "cannot find description for property ~S (~S)") sym where)) @@ -190,10 +190,10 @@ with init values from ALIST (1st optional argument) (cons (string-append "@code{" name "} " "(" typename ")" - (if handle + (if init-value (string-append ":\n\n" - (scm->texi (cdr handle)) + (scm->texi init-value) "\n\n") "")) desc))) diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm index 993e838921..b74bbc1453 100644 --- a/scm/fret-diagrams.scm +++ b/scm/fret-diagrams.scm @@ -101,9 +101,9 @@ found." (define (helper key alist-list default) (if (null? alist-list) default - (let* ((handle (assoc key (car alist-list)))) - (if (pair? handle) - (append (cdr handle) (chain-assoc-get key (cdr alist-list) '())) + (let* ((entry (assoc-get key (car alist-list)))) + (if entry + (append entry (chain-assoc-get key (cdr alist-list) '())) (helper key (cdr alist-list) default))))) (helper key alist-list @@ -254,7 +254,7 @@ with magnification @var{mag} of the string @var{text}." ; and draw-barre (dot-position (assoc-get - 'dot-position details default-dot-position)) ; needed for + 'dot-position details default-dot-position)) ; needed for ; draw-dots and draw-barre (th (* (ly:output-def-lookup layout 'line-thickness) @@ -751,7 +751,7 @@ at @var{fret}." xo-stencil 'fret orientation)) (xo-stencil-offset (stencil-coordinate-offset - (- diagram-fret-top + (- diagram-fret-top xo-fret-offset (* size xo-padding)) 0))) diff --git a/scm/lily.scm b/scm/lily.scm index 19b5104f4b..1e07dfa03c 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -448,8 +448,8 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (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"))) @@ -530,10 +530,8 @@ LilyPond safe mode. The syntax is the same as `define*-public'." (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) diff --git a/scm/midi.scm b/scm/midi.scm index 358fa0acca..11b565ea47 100644 --- a/scm/midi.scm +++ b/scm/midi.scm @@ -1,7 +1,7 @@ ;;;; midi.scm -- scm midi variables and functions ;;;; ;;;; source file of the GNU LilyPond music typesetter -;;;; +;;;; ;;;; (c) 2000--2009 Jan Nieuwenhuizen @@ -14,7 +14,7 @@ ;; define factor of total volume per dynamic marking (define-public absolute-volume-alist '()) (set! absolute-volume-alist - (append + (append '( ("sf" . 1.00) ("fffff" . 0.95) @@ -33,14 +33,12 @@ absolute-volume-alist)) (define-public (default-dynamic-absolute-volume s) - (let ((entry (assoc s absolute-volume-alist))) - (if entry - (cdr entry)))) + (assoc-get s absolute-volume-alist)) ;; define factors of total volume of minimum and maximum volume (define-public instrument-equalizer-alist '()) (set! instrument-equalizer-alist - (append + (append '( ("flute" . (0 . 0.7)) ("oboe" . (0 . 0.7)) @@ -57,9 +55,7 @@ instrument-equalizer-alist)) (define-public (default-instrument-equalizer s) - (let ((entry (assoc s instrument-equalizer-alist))) - (if entry - (cdr entry)))) + (assoc-get s instrument-equalizer-alist)) ;; (name . program+32768*(channel10 ? 1 : 0)) (define instrument-names-alist '()) @@ -259,16 +255,19 @@ returns whether the instrument should use midi channel 9 " (let* ((inst (symbol->string instrument)) - (entry (assoc inst instrument-names-alist))) - (and entry (>= (cdr entry) 32768)))) + (entry (assoc-get inst instrument-names-alist))) + (and entry (>= entry 32768) + entry))) (define-public (midi-program instrument) " returns the program of the instrument " (let* ((inst (symbol->string instrument)) - (entry (assoc inst instrument-names-alist))) - (if entry (modulo (cdr entry) 32768) #f))) + (entry (assoc-get inst instrument-names-alist))) + (if entry + (modulo entry 32768) + #f))) ;; 90 == 90/127 == 0.71 is supposed to be the default value ;; urg: we should set this at start of track @@ -276,7 +275,7 @@ returns the program of the instrument (define-public (alterations-in-key pitch-list) "Count number of sharps minus number of flats" - + (* (apply + (map cdr pitch-list)) 2)) diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 5ad79b4096..324e5aa8f0 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -1074,15 +1074,15 @@ specifies whether accidentals should be canceled in different octaves." (need-accidental #f) (previous-alteration #f) (from-other-octaves #f) - (from-same-octave (ly:assoc-get pitch-handle local-key-sig)) - (from-key-sig (ly:assoc-get notename local-key-sig))) + (from-same-octave (assoc-get pitch-handle local-key-sig)) + (from-key-sig (assoc-get notename local-key-sig))) ;; If no key signature match is found from localKeySignature, we may have a custom ;; type with octave-specific entries of the form ((octave . pitch) alteration) ;; instead of (pitch . alteration). Since this type cannot coexist with entries in ;; localKeySignature, try extracting from keySignature instead. (if (equal? from-key-sig #f) - (set! from-key-sig (ly:assoc-get pitch-handle key-sig))) + (set! from-key-sig (assoc-get pitch-handle key-sig))) ;; loop through localKeySignature to search for a notename match from other octaves (let loop ((l local-key-sig)) diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 68c338dfb8..c3d51282f0 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -202,21 +202,21 @@ (define-public (bar-line::calc-glyph-name grob) (let* ((glyph (ly:grob-property grob 'glyph)) (dir (ly:item-break-dir grob)) - (result (assoc glyph bar-glyph-alist)) + (result (assoc-get glyph bar-glyph-alist)) (glyph-name (if (= dir CENTER) glyph (if (and result - (string? (index-cell (cdr result) dir))) - (index-cell (cdr result) dir) + (string? (index-cell result dir))) + (index-cell result dir) #f)))) glyph-name)) (define-public (bar-line::calc-break-visibility grob) (let* ((glyph (ly:grob-property grob 'glyph)) - (result (assoc glyph bar-glyph-alist))) + (result (assoc-get glyph bar-glyph-alist))) (if result - (vector (string? (cadr result)) #t (string? (cddr result))) + (vector (string? (car result)) #t (string? (cdr result))) all-invisible))) (define-public (shift-right-at-line-begin g) diff --git a/scm/paper.scm b/scm/paper.scm index 48f4a46cb1..01fa8c06e2 100644 --- a/scm/paper.scm +++ b/scm/paper.scm @@ -1,7 +1,7 @@ ;;;; paper.scm -- manipulate the paper and layout block. ;;;; ;;;; source file of the GNU LilyPond music typesetter -;;;; +;;;; ;;;; (c) 2004--2009 Han-Wen Nienhuys (define-public (set-paper-dimension-variables mod) @@ -53,7 +53,7 @@ (module-define! module sym val)))) (setm! 'text-font-size (* 12 factor)) - + (setm! 'output-scale ss) (setm! 'fonts (make-century-schoolbook-tree factor)) (setm! 'staff-height staff-height) @@ -61,10 +61,10 @@ (setm! 'line-thickness (calc-line-thickness ss pt)) - ;; sync with feta + ;; sync with feta (setm! 'ledger-line-thickness (+ (* 0.5 pt) (/ ss 10))) - ;; sync with feta + ;; sync with feta (setm! 'blot-diameter (* 0.4 pt)) )) @@ -89,11 +89,11 @@ size. SZ is in points" ; maybe not necessary. ; but let's be paranoid. Maybe someone still refers to the - ; old one. + ; old one. (new-paper (ly:output-def-clone pap)) - + (new-scope (ly:output-def-scope new-paper))) - + (if in-layout? (ly:warning (_ "set-global-staff-size: not in toplevel scope"))) @@ -228,23 +228,23 @@ size. SZ is in points" (define (internal-set-paper-size module name landscape?) (define (swap x) (cons (cdr x) (car x))) - - (let* ((entry (assoc name paper-alist)) + + (let* ((entry (assoc-get name paper-alist)) (is-paper? (module-defined? module 'is-paper)) (mm (eval 'mm module))) - + (cond ((not is-paper?) (ly:warning (_ "This is not a \\layout {} object, ~S") module)) - ((pair? entry) + (entry - (set! entry (eval (cdr entry) module)) + (set! entry (eval entry module)) (if landscape? (set! entry (swap entry))) (set-paper-dimensions module (car entry) (cdr entry)) (module-define! module 'papersizename name) - (module-define! module 'landscape + (module-define! module 'landscape (if landscape? #t #f))) (else (ly:warning (_ "Unknown paper size: ~a") name))))) @@ -279,10 +279,10 @@ size. SZ is in points" (module-define! scope v (/ val scale)) - ;; spurious warnings, eg. for paper-width, paper-height. + ;; spurious warnings, eg. for paper-width, paper-height. ;; (ly:warning (_ "not a number, ~S = ~S " v val)) ))) - + dim-vars) - + new-pap)) diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm index 62bfef5ee9..8275929d55 100644 --- a/scm/parser-clef.scm +++ b/scm/parser-clef.scm @@ -109,15 +109,15 @@ (set! oct (* (if (equal? (match:substring match 2) "^") -1 1) (- (string->number (match:substring match 3)) 1))))) - (set! e (assoc clef-name supported-clefs)) - (if (pair? e) + (set! e (assoc-get clef-name supported-clefs)) + (if e (let* ((musics (map make-prop-set - `(((symbol . clefGlyph) (value . ,(cadr e))) + `(((symbol . clefGlyph) (value . ,(car e))) ((symbol . middleCClefPosition) (value . ,(+ oct - (caddr e) - (assoc-get (cadr e) c0-pitch-alist)))) - ((symbol . clefPosition) (value . ,(caddr e))) + (cadr e) + (assoc-get (car e) c0-pitch-alist)))) + ((symbol . clefPosition) (value . ,(cadr e))) ((symbol . clefOctavation) (value . ,(- oct)))))) (recalc-mid-C (make-music 'ApplyContext)) (seq (make-music 'SequentialMusic diff --git a/scm/song.scm b/scm/song.scm index 130208a753..b7fc063660 100644 --- a/scm/song.scm +++ b/scm/song.scm @@ -277,7 +277,7 @@ joined ; to the next note origin ) - + (defstruct rest duration origin @@ -424,7 +424,7 @@ count ; number of repetitions ) -(defstruct verse ; +(defstruct verse ; text ; separate text element (syllable or word) notelist/rests ; list of note lists (slurs) and rests (unfinished #f) ; whether to be merged with the following verse @@ -643,7 +643,7 @@ (warning (safe-car (if (null? note-list) consumed note-list)) "Unfinished slur: ~a ~a" context consumed)) (values (reverse consumed) note-list)))) - + (define (consume-skip-notes skip note-list context) ;; Returns either note list (skip word defined) or rest instance (no skip word) + new note-list. (assert (skip? skip)) @@ -773,7 +773,7 @@ (insert-lyrics! (get-lyrics (music-context-music music-context) context) score-list context) (debug "Final score list" score-list))) - music-context-list) + music-context-list) (extract-verses score-list))) @@ -786,7 +786,7 @@ (let* ((semitones (ly:pitch-semitones pitch)) (octave (inexact->exact (floor (/ semitones 12)))) (tone (modulo semitones 12))) - (format #f "~a~a" (cadr (assoc tone festival-note-mapping)) + (format #f "~a~a" (car (assoc-get tone festival-note-mapping)) (+ octave *base-octave* *base-octave-shift*)))) (define (write-header port tempo) -- 2.39.5