[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Unsecure assoc calls
|
From: |
Michael Käppler |
|
Subject: |
Re: Unsecure assoc calls |
|
Date: |
Fri, 18 Sep 2009 17:58:06 +0200 |
|
User-agent: |
Thunderbird 2.0.0.12 (X11/20071114) |
Hi Neil,
Hmm, some of these don't look too secure. :)
Whoops...
(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 (assoc-get label table))
I'm not sure we can always rely on 'label-page-table being a list here.
Hmm... I forgot that ly:assoc-get throws an assert error instead of
returning #f if it's list argument isn't a list. I reverted this for
now, but maybe we should better output a programming error in assoc-get
for this case?
+ (assoc-get (- moment) moment-duration-alist =))
This looks dangerous. I had to check the Guile docs here, but the
original assoc call uses the enhanced version from SRFI-1, which has
an optional argument for a comparison procedure.
Sorry for missing that. However, don't you think that this '=' is
unnecessary? The default comparison procedure is equal? and I don't see
any differences to = that matter for this case.
Regards,
Michael
>From 66ea82f15798237ced4a4a14d32f6c1404812701 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Michael=20K=C3=A4ppler?= <address@hidden>
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 3381a9e..bccd15e 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 53d71aa..933bfb2 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 <address@hidden>
;;;; Jan Nieuwenhuizen <address@hidden>
;;; 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
address@hidden lilypond"
address@hidden 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))
"
address@hidden text columns, left-aligned
address@hidden 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} address@hidden@var{y}."
+Set the dimensions of @var{arg} to @var{x} address@hidden@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}
address@hidden@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
address@hidden
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 72f94b0..a620150 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 0dc1c66..ad1073d 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 7ab9f85..5fb8bf9 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 154750a..a9bf143 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 6f82b40..a97f0c2 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 993e838..b74bbc1 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 783679c..4c4345a 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -453,8 +453,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")))
@@ -535,10 +535,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 358fa0a..11b565e 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 <address@hidden>
@@ -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 5ad79b4..324e5aa 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 68c338d..c3d5128 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 48f4a46..01fa8c0 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 <address@hidden>
(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 62bfef5..8275929 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 130208a..b7fc063 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)
--
1.6.0.2
- Re: Unsecure assoc calls, (continued)
- Re: Unsecure assoc calls, Neil Puttock, 2009/09/12
- Re: Unsecure assoc calls, Neil Puttock, 2009/09/12
- Re: Unsecure assoc calls, Michael Käppler, 2009/09/13
- Re: Unsecure assoc calls, Carl Sorensen, 2009/09/13
- Re: Unsecure assoc calls, John Mandereau, 2009/09/13
- Re: Unsecure assoc calls, Neil Puttock, 2009/09/13
- Re: Unsecure assoc calls, Michael Käppler, 2009/09/13
- Re: Unsecure assoc calls, Neil Puttock, 2009/09/16
- Re: Unsecure assoc calls, Michael Käppler, 2009/09/17
- Re: Unsecure assoc calls, Neil Puttock, 2009/09/17
- Re: Unsecure assoc calls,
Michael Käppler <=
- Re: Unsecure assoc calls, Neil Puttock, 2009/09/18
- Re: Unsecure assoc calls, Michael Käppler, 2009/09/20
- Re: Unsecure assoc calls, Carl Sorensen, 2009/09/20
- Re: Unsecure assoc calls, Ian Hulin, 2009/09/11