]> git.donarmstrong.com Git - lilypond.git/commitdiff
Turn assoc calls into secure assoc-get calls.
authorMichael Käppler <xmichael-k@web.de>
Sun, 13 Sep 2009 20:11:36 +0000 (22:11 +0200)
committerNeil Puttock <n.puttock@gmail.com>
Wed, 16 Sep 2009 19:32:21 +0000 (20:32 +0100)
* First stage: Turn all (cdr (assoc calls into (assoc-get calls.

scm/define-grobs.scm
scm/document-backend.scm
scm/document-translation.scm
scm/documentation-lib.scm
scm/fret-diagrams.scm
scm/memory-trace.scm
scm/music-functions.scm
scm/output-socket.scm
scm/parser-clef.scm
scm/part-combiner.scm
scm/song.scm

index eeef0385c86691e704f17c6159d6ba836b813590..aab8a04a61724b5e417d5ce70ff92a146095ceb3 100644 (file)
   ;;  (newline)
   (let* ((name-sym  (car x))
         (grob-entry (cdr x))
-        (meta-entry (cdr (assoc 'meta grob-entry)))
-        (class (cdr (assoc 'class meta-entry)))
+        (meta-entry (assoc-get 'meta grob-entry))
+        (class (assoc-get 'class meta-entry))
         (ifaces-entry
-         (cdr (assoc 'interfaces meta-entry))))
+         (assoc-get 'interfaces meta-entry)))
 
     (cond
      ((eq? 'Item class)
index 41c2aab60c9fc03831f14c5a3694b72138ba2b75..7ab9f85fb05310abd913521a5dfb910bc68ca8cf 100644 (file)
@@ -63,7 +63,7 @@
  (lambda (x)
    (let* ((metah (assoc 'meta (cdr x)))
          (meta (cdr metah))
-         (ifaces (cdr (assoc 'interfaces meta))))
+         (ifaces (assoc-get 'interfaces meta)))
 
      (map (lambda (iface)
            (hashq-set!
@@ -112,9 +112,9 @@ node."
 
   (let* ((metah (assoc 'meta description))
         (meta (cdr metah))
-        (name (cdr (assoc 'name meta)))
+        (name (assoc-get 'name meta))
         ;;       (bla (display name))
-        (ifaces (map lookup-interface (cdr (assoc 'interfaces meta))))
+        (ifaces (map lookup-interface (assoc-get 'interfaces meta)))
         (ifacedoc (map ref-ify
                        (sort
                         (map (lambda (iface)
index 390d6b0330a86ad5ce8c3ead39db54bef000d50e..154750ab8de817c76ff141f1bcf907e6983f80b6 100644 (file)
        (engraver-accepts-music-types? (cdr types) grav))))
 
 (define (engraver-doc-string engraver in-which-contexts)
-  (let* ((propsr (cdr (assoc 'properties-read (ly:translator-description engraver))))
-        (propsw (cdr (assoc 'properties-written (ly:translator-description engraver))))
-        (accepted  (cdr (assoc 'events-accepted (ly:translator-description engraver))))
+  (let* ((propsr (assoc-get 'properties-read (ly:translator-description engraver)))
+        (propsw (assoc-get 'properties-written (ly:translator-description engraver)))
+        (accepted  (assoc-get 'events-accepted (ly:translator-description engraver)))
         (name-sym  (ly:translator-name engraver))
         (name-str (symbol->string name-sym))
-        (desc (cdr (assoc 'description (ly:translator-description engraver))))
+        (desc (assoc-get 'description (ly:translator-description engraver)))
         (grobs (engraver-grobs engraver)))
 
     (string-append
                 (apply append
                        (map
                         (lambda (x)
-                          (let* ((context (cdr (assoc 'context-name x)))
+                          (let* ((context (assoc-get 'context-name x))
                                  (group (assq-ref x 'group-type))
                                  (consists (append
                                             (if group
                                                 (list group)
                                                 '())
-                                            (cdr (assoc 'consists x)))))
+                                            (assoc-get 'consists x))))
                             (if (member name-sym consists)
                                 (list context)
                                 '())))
 
 
 (define (context-doc context-desc)
-  (let* ((name-sym (cdr (assoc 'context-name context-desc)))
+  (let* ((name-sym (assoc-get 'context-name context-desc))
         (name (symbol->string name-sym))
-        (aliases (map symbol->string (cdr (assoc 'aliases context-desc))))
+        (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)"))
        
-        (accepts (cdr (assoc 'accepts context-desc)))
-        (consists (cdr (assoc 'consists context-desc)))
-        (props (cdr (assoc 'property-ops context-desc)))
+        (accepts (assoc-get 'accepts context-desc))
+        (consists (assoc-get 'consists context-desc))
+        (props (assoc-get 'property-ops context-desc))
         (grobs  (context-grobs context-desc))
         (grob-refs (map ref-ify (sort grobs ly:string-ci<?))))
 
                 grav)))
     (if (eq? eg #f)
        '()
-       (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg)))))))
+       (map symbol->string (assoc-get 'grobs-created (ly:translator-description eg))))))
 
 (define (context-grobs context-desc)
   (let* ((group (assq-ref context-desc 'group-type))
                    (if group
                        (list group)
                        '())
-                   (cdr (assoc 'consists context-desc))))
+                   (assoc-get 'consists context-desc)))
         (grobs  (apply append
                        (map engraver-grobs consists))))
     grobs))
index 8315a765c120e9f6ad0097940344ef412ad7059a..79da938b6b34e08443195f5548950d2e742800d4 100644 (file)
@@ -2,7 +2,7 @@
 ;;;; documentation-lib.scm -- Assorted Functions for generated documentation
 ;;;;
 ;;;; source file of the GNU LilyPond music typesetter
-;;;; 
+;;;;
 ;;;; (c) 2000--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
 
 
 
 (define (texi-section-command level)
-  (cdr (assoc level '(
-                     ;; Hmm, texinfo doesn't have ``part''
-                     (0 . "@top")
-                     (1 . "@chapter")
-                     (2 . "@section")
-                     (3 . "@subsection")
-                     (4 . "@unnumberedsubsubsec")
-                     (5 . "@unnumberedsubsubsec")))))
+  (assoc-get level '(
+                    ;; Hmm, texinfo doesn't have ``part''
+                    (0 . "@top")
+                    (1 . "@chapter")
+                    (2 . "@section")
+                    (3 . "@subsection")
+                    (4 . "@unnumberedsubsubsec")
+                    (5 . "@unnumberedsubsubsec"))))
 
 (define (texi-appendix-section-command level)
-  (cdr (assoc level '((0 . "@top")
-                     (1 . "@appendix")
-                     (2 . "@appendixsec")
-                     (3 . "@appendixsubsec")
-                     (4 . "@appendixsubsubsec")
-                     (5 . "@appendixsubsubsec")))))
+  (assoc-get level '((0 . "@top")
+                    (1 . "@appendix")
+                    (2 . "@appendixsec")
+                    (3 . "@appendixsubsec")
+                    (4 . "@appendixsubsubsec")
+                    (5 . "@appendixsubsubsec"))))
 
 (define (one-item->texi label-desc-pair)
   "Document one (LABEL . DESC); return empty string if LABEL is empty string."
@@ -100,13 +100,13 @@ string-to-use).  If QUOTE? is #t, embed table in a @quotation environment."
   "Generate what is between @menu and @end menu."
   (let ((maxwid
         (apply max (map (lambda (x) (string-length (car x))) items-alist))))
-    
+
     (string-append
      "\n@menu"
      (apply string-append
            (map (lambda (x)
                   (string-append
-                   (string-pad-right 
+                   (string-pad-right
                     (string-append "\n* " (car x) ":: ")
                     (+ maxwid 8))
                    (cdr x)))
@@ -155,7 +155,7 @@ string-to-use).  If QUOTE? is #t, embed table in a @quotation environment."
 
 (define (human-listify lst)
   "Produce a textual enumeration from LST, a list of strings"
-  
+
   (cond
    ((null? lst) "none")
    ((null? (cdr lst)) (car lst))
@@ -177,7 +177,7 @@ with init values from ALIST (1st optional argument)
         (alist (if (pair? rest) (car rest) '()))
         (type?-name (string->symbol
                      (string-append (symbol->string where) "-type?")))
-        (doc-name (string->symbol                  
+        (doc-name (string->symbol
                    (string-append (symbol->string where) "-doc")))
         (type (object-property sym type?-name))
         (typename (type-name type))
@@ -186,7 +186,7 @@ with init values from ALIST (1st optional argument)
 
     (if (eq? desc #f)
        (ly:error (_ "cannot find description for property ~S (~S)") sym where))
-    
+
     (cons
      (string-append "@code{" name "} "
                    "(" typename ")"
index d0883a48ac5ab4dccb3d33e24a8d6e273d85c392..993e83892197e80c9d118d8e528b183c77c0df62 100644 (file)
@@ -268,11 +268,11 @@ with magnification @var{mag} of the string @var{text}."
            (* size (assoc-get 'xo-padding details 0.2))) ; needed only here
          (parameters (fret-parse-marking-list marking-list my-fret-count))
          (capo-fret (assoc-get 'capo-fret parameters 0))
-         (dot-list (cdr (assoc 'dot-list parameters)))
-         (xo-list (cdr (assoc 'xo-list parameters)))
-         (fret-range (cdr (assoc 'fret-range parameters)))
+         (dot-list (assoc-get 'dot-list parameters))
+         (xo-list (assoc-get 'xo-list parameters))
+         (fret-range (assoc-get 'fret-range parameters))
          (my-fret-count (fret-count fret-range))
-         (barre-list (cdr (assoc 'barre-list parameters)))
+         (barre-list (assoc-get 'barre-list parameters))
          (barre-type
            (assoc-get 'barre-type details 'curved))
          (fret-diagram-stencil '()))
index 9da1c30eda14a24963163f0bb24c694787ccc79a..345d1327f0f47f4ca4cdebe350b577f2fa077172 100644 (file)
@@ -34,7 +34,7 @@
   (if (eq? (current-thread) trace-thread)
       #t ;; do nothing.
       (let*
-         ((cells (cdr (assoc 'total-cells-allocated (gc-stats))))
+         ((cells (assoc-get 'total-cells-allocated (gc-stats)))
           (proc (arg-procedure args))
           (time (tms:utime (times)))
           (stack (extract-trace continuation)))
@@ -67,7 +67,7 @@
   (set! trace-points '())
   (set! continue-tracing #t)
   (set! trace-count 0)
-  (set! start-memory (cdr (assoc 'total-cells-allocated (gc-stats))))
+  (set! start-memory (assoc-get 'total-cells-allocated (gc-stats)))
   (set! start-time (tms:utime (times)))
   
   (install-tracepoint))
     (for-each
      (lambda (r)
        (let*
-          ((mem (- (cdr (assoc 'cells r)) start-memory))
-           (proc (cdr (assoc 'proc r)))
-           (stack (cdr (assoc 'stack r)))
-           (time (- (cdr (assoc 'time r)) start-time)))
+          ((mem (- (assoc-get 'cells r) start-memory))
+           (proc (assoc-get 'proc r))
+           (stack (assoc-get 'stack r))
+           (time (- (assoc-get 'time r) start-time)))
         
         (format graph-out "~a ~a\n" time mem)
         (if stack
                       (- mem last-mem) proc)
               (do
                   ((j 0 (1+ j))
-                   (stack (cdr (assoc 'stack r)) stack))
+                   (stack (assoc-get 'stack r) stack))
                   ((>= j (vector-length stack)))
                 
                 (format stacks-out "\t~a\n"
index 3846727a1a7bcd1dc198e83b0f152bc7aec1d944..549b175d1eef872ddcd4d663be49baa6431b1062 100644 (file)
@@ -480,11 +480,11 @@ OTTAVATION to `8va', or whatever appropriate."
            (ly:context-unset-property where 'ottavation)))
 
       (let* ((offset (* -7 octavation))
-            (string (cdr (assoc octavation '((2 . "15ma")
-                                             (1 . "8va")
-                                             (0 . #f)
-                                             (-1 . "8vb")
-                                             (-2 . "15mb"))))))
+            (string (assoc-get octavation '((2 . "15ma")
+                                            (1 . "8va")
+                                            (0 . #f)
+                                            (-1 . "8vb")
+                                            (-2 . "15mb")))))
        (ly:context-set-property! context 'middleCOffset offset)
        (ly:context-set-property! context 'ottavation string)
        (ly:set-middle-C! context)))
@@ -671,7 +671,7 @@ inside of and outside of chord construct."
 
 "
   (let ((meta (ly:grob-property grob 'meta)))
-    (if (equal?  (cdr (assoc 'name meta)) grob-name)
+    (if (equal? (assoc-get 'name meta) grob-name)
        (set! (ly:grob-property grob symbol) val))))
 
 
index 5534c2816c96c29a205dcb1367ab563a8b25ccdc..c86047815ade2ecc0a9ea9aec2074a91a58f77ef 100644 (file)
@@ -68,7 +68,7 @@
      (tag (if (and cause (integer? (ly:event-property cause 'input-tag)))
              (ly:event-property cause 'input-tag)
              -1))
-     (name (cdr (assoc 'name (ly:grob-property grob 'meta)))))
+     (name (assoc-get 'name (ly:grob-property grob 'meta))))
 
     (apply format
           (append (list "cause ~a \"~a\" ~a ~a ~a ~a\n" tag name)
index a6d178eaeff9fbb95c07dc6108e71d062b6293aa..62bfef5ee9af0d4b5c9ae594b431bda1da8c3fa4 100644 (file)
                              ((symbol . middleCClefPosition)
                               (value . ,(+ oct
                                            (caddr e)
-                                           (cdr (assoc (cadr e) c0-pitch-alist)))))
+                                           (assoc-get (cadr e) c0-pitch-alist))))
                              ((symbol . clefPosition) (value . ,(caddr e)))
                              ((symbol . clefOctavation) (value . ,(- oct))))))
               (recalc-mid-C (make-music 'ApplyContext))
index 81beaf6ae7d83c6dab583c1297dcd061fe775f3c..c874f09d1cda66ad25084993577557b4bd4ba76d 100644 (file)
@@ -1,7 +1,7 @@
 ;;;; part-combiner.scm -- Part combining, staff changes.
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
-;;;; 
+;;;;
 ;;;; (c) 2004--2009    Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;; todo: figure out how to make module,
@@ -19,7 +19,7 @@
   ;; of (SYMBOL . RESULT-INDEX), which indicates where
   ;; said spanner was started.
   (spanner-state #:init-value '() #:accessor span-state))
-  
+
 (define-method (write (x <Voice-state> ) file)
   (display (when x) file)
   (display " evs = " file)
@@ -49,7 +49,7 @@
   ;;
   (is #:init-keyword #:voice-states #:accessor voice-states)
   (synced  #:init-keyword #:synced #:init-value         #f #:getter synced?))
-                            
+
 
 (define-method (write (x <Split-state> ) f)
   (display (when x) f)
@@ -82,7 +82,7 @@
   "Merge lists VS1 and VS2, containing Voice-state objects into vector
 of Split-state objects, crosslinking the Split-state vector and
 Voice-state objects
-"  
+"
   (define (helper ss-idx ss-list idx1 idx2)
     (let* ((state1 (if (< idx1 (vector-length vs1)) (vector-ref vs1 idx1) #f))
           (state2 (if (< idx2 (vector-length vs2)) (vector-ref vs2 idx2) #f))
@@ -114,13 +114,13 @@ Voice-state objects
 
   (define (helper index active)
     "Analyse EVS at INDEX, given state ACTIVE."
-    
+
     (define (analyse-tie-start active ev)
       (if (equal? (ly:event-property ev 'class) 'tie-event)
          (acons 'tie (split-index (vector-ref voice-state-vec index))
                 active)
          active))
-    
+
     (define (analyse-tie-end active ev)
       (if (equal? (ly:event-property ev 'class) 'note-event)
          (assoc-remove! active 'tie)
@@ -132,12 +132,12 @@ Voice-state objects
                   (equal? STOP (ly:event-property ev 'span-direction))))
          (assoc-remove! (assoc-remove! active 'cresc) 'decr)
          active))
-    
+
     (define (active<? a b)
       (cond ((symbol<? (car a) (car b)) #t)
            ((symbol<? (car b) (car b)) #f)
            (else (< (cdr a) (cdr b)))))
-    
+
     (define (analyse-span-event active ev)
       (let* ((name (ly:event-property ev 'class))
             (key (cond ((equal? name 'slur-event) 'slur)
@@ -181,17 +181,17 @@ Voice-state objects
          (set! (span-state (vector-ref voice-state-vec index))
                (list-copy active))
          (helper (1+ index) active))))
-  
+
   (helper 0 '()))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-public (recording-group-emulate music odef) 
+(define-public (recording-group-emulate music odef)
   "Interprets music according to odef, but stores all events in a chronological list, similar to the Recording_group_engraver in 2.8 and earlier"
   (let*
       ((context-list '())
        (now-mom (ly:make-moment 0 0))
        (global (ly:make-global-context odef))
-       (mom-listener (ly:make-listener 
+       (mom-listener (ly:make-listener
                      (lambda (tev)
                        (set! now-mom (ly:event-property tev 'moment)))))
        (new-context-listener
@@ -227,12 +227,12 @@ Voice-state objects
         (listener (ly:parser-lookup parser 'partCombineListener))
         (evs2 (recording-group-emulate m2 listener))
         (evs1 (recording-group-emulate m1 listener)))
-    
+
     (set! (ly:music-property m 'elements) (list m1 m2))
     (set! (ly:music-property m 'split-list)
       (if (and (assoc "one" evs1) (assoc "two" evs2))
-         (determine-split-list (reverse! (cdr (assoc "one" evs1)) '())
-                               (reverse! (cdr (assoc "two" evs2)) '()))
+         (determine-split-list (reverse! (assoc-get "one" evs1) '())
+                               (reverse! (assoc-get "two" evs2) '()))
          '() ))
     m))
 
@@ -243,7 +243,7 @@ Voice-state objects
         (voice-state-vec1 (make-voice-states evl1))
         (voice-state-vec2 (make-voice-states evl2))
         (result (make-split-state voice-state-vec1 voice-state-vec2)))
-    
+
     (define (analyse-time-step result-idx)
       (define (put x . index)
        "Put the result to X, starting from INDEX backwards.
@@ -256,7 +256,7 @@ Only set if not set previously.
              (begin
                (set! (configuration (vector-ref result i)) x)
                (put x (1- i))))))
-      
+
       (define (copy-state-from state-vec vs)
        (define (copy-one-state key-idx)
          (let* ((idx (cdr key-idx))
@@ -314,12 +314,12 @@ Only set if not set previously.
                                                (previous-voice-state vs2)))
                           (if (and (null? (span-state vs1)) (null? (span-state vs2)))
                               (put 'chords)))))))))
-      
+
       (if (< result-idx (vector-length result))
          (let* ((now-state (vector-ref result result-idx))
                 (vs1 (car (voice-states now-state)))
                 (vs2 (cdr (voice-states now-state))))
-           
+
            (cond ((not vs1) (put 'apart))
                  ((not vs2) (put 'apart))
                  (else
@@ -336,13 +336,13 @@ Only set if not set previously.
                              (equal? active1 active2)
                              (equal? new-active1 new-active2))
                         (analyse-notes now-state)
-                        
+
                         ;; active states different:
                         (put 'apart)))
-                  
+
                   ;; go to the next one, if it exists.
                   (analyse-time-step (1+ result-idx)))))))
-    
+
     (define (analyse-a2 result-idx)
       (if (< result-idx (vector-length result))
          (let* ((now-state (vector-ref result result-idx))
@@ -350,7 +350,7 @@ Only set if not set previously.
                 (vs2 (cdr (voice-states now-state))))
            (if (and (equal? (configuration now-state) 'chords)
                     vs1 vs2)
-               (let ((notes1 (note-events vs1)) 
+               (let ((notes1 (note-events vs1))
                      (notes2 (note-events vs2)))
                  (cond ((and (= 1 (length notes1))
                              (= 1 (length notes2))
@@ -361,9 +361,9 @@ Only set if not set previously.
                              (= 0 (length notes2)))
                         (set! (configuration now-state) 'unisilence)))))
            (analyse-a2 (1+ result-idx)))))
-    
+
     (define (analyse-solo12 result-idx)
-      
+
       (define (previous-config vs)
        (let* ((pvs (previous-voice-state vs))
               (spi (if pvs (split-index pvs) #f))
@@ -371,24 +371,24 @@ Only set if not set previously.
          (if prev-split
              (configuration prev-split)
              'apart)))
-      
+
       (define (put-range x a b)
        ;; (display (list "put range "  x a b "\n"))
        (do ((i a (1+ i)))
            ((> i b) b)
          (set! (configuration (vector-ref result i)) x)))
-      
+
       (define (put x)
        ;; (display (list "putting "  x "\n"))
        (set! (configuration (vector-ref result result-idx)) x))
-      
+
       (define (current-voice-state now-state voice-num)
        (define vs ((if (= 1 voice-num) car cdr)
                    (voice-states now-state)))
        (if (or (not vs) (equal? (when now-state) (when vs)))
            vs
            (previous-voice-state vs)))
-      
+
       (define (try-solo type start-idx current-idx)
        "Find a maximum stretch that can be marked as solo. Only set
 the mark when there are no spanners active.
@@ -414,7 +414,7 @@ the mark when there are no spanners active.
                     ;;
                     ;; This includes rests. This isn't a problem: long rests
                     ;; will be shared with the silent voice, and be marked
-                    ;; as unisilence. Therefore, long rests won't 
+                    ;; as unisilence. Therefore, long rests won't
                     ;;  accidentally be part of a solo.
                     ;;
                     (put-range type start-idx current-idx)
@@ -423,7 +423,7 @@ the mark when there are no spanners active.
                     (try-solo type start-idx (1+ current-idx)))))
            ;; try-solo
            start-idx))
-      
+
       (define (analyse-moment result-idx)
        "Analyse 'apart starting at RESULT-IDX. Return next index. "
        (let* ((now-state (vector-ref result result-idx))
@@ -449,11 +449,11 @@ the mark when there are no spanners active.
                       (equal? (when vs2) (when now-state))
                       (null? (previous-span-state vs2)))
                  (try-solo 'solo2 result-idx result-idx))
-                
+
                 (else (1+ result-idx)))
           ;; analyse-moment
           (1+ result-idx))))
-      
+
       (if (< result-idx (vector-length result))
          (if (equal? (configuration (vector-ref result result-idx)) 'apart)
              (analyse-solo12 (analyse-moment result-idx))
index c5ecc89da623c3997866922ae7038e3c4a7bdf04..130208a7534053f75af592c2dea229615f1965d1 100644 (file)
@@ -87,7 +87,7 @@
    ((note? object)
     (let ((pitch (ly:pitch-semitones (note-pitch object))))
       (format #f "~a~a~a~a"
-              (cdr (assoc (modulo pitch 12) pp-pitch-names))
+              (assoc-get (modulo pitch 12) pp-pitch-names)
               (let ((octave (+ (inexact->exact (floor (/ pitch 12))) 1)))
                 (cond
                  ((= octave 0)