(list ch1 ch2)))
- (make-music 'SequentialMusic 'elements (apply append
- (map chord->tied-chord (ly:music-property chords 'elements)))))
+ (make-music 'SequentialMusic 'elements (append-map
+ chord->tied-chord (ly:music-property chords 'elements))))
baseChords =
\applyMusic #(lambda (mus)
toplevel-book-handler)))
(cond ((pair? toplevel-bookparts)
(let ((book (ly:make-book $defaultpaper $defaultheader)))
- (map (lambda (part)
- (ly:book-add-bookpart! book part))
- (reverse! toplevel-bookparts))
+ (for-each (lambda (part)
+ (ly:book-add-bookpart! book part))
+ (reverse! toplevel-bookparts))
(set! toplevel-bookparts (list))
;; if scores have been defined after the last explicit \bookpart:
(if (pair? toplevel-scores)
- (map (lambda (score)
- (ly:book-add-score! book score))
- (reverse! toplevel-scores)))
+ (for-each (lambda (score)
+ (ly:book-add-score! book score))
+ (reverse! toplevel-scores)))
(set! toplevel-scores (list))
(book-handler parser book)))
((or (pair? toplevel-scores) output-empty-score-list)
(define-public (output-scopes scopes fields basename)
(define (output-scope scope)
- (apply
- string-append
+ (string-concatenate
(module-map
(lambda (sym var)
(let ((val (if (variable-bound? var) (variable-ref var) "")))
(header-to-file basename sym val))
""))
scope)))
- (apply string-append (map output-scope scopes)))
+ (string-concatenate (map output-scope scopes)))
(define-public (relevant-book-systems book)
(let ((systems (ly:paper-book-systems book)))
(ly:warning (_ "missing stencil expression `~S'") name)
""))
- (map (lambda (x)
- (if (not (module-defined? output-module x))
- (begin
- (module-define! output-module x
- (lambda* (#:optional y . z)
- (missing-stencil-expression x)))
- (set! missing-stencil-list (append (list x)
- missing-stencil-list)))))
- (ly:all-stencil-commands)))
+ (for-each (lambda (x)
+ (if (not (module-defined? output-module x))
+ (begin
+ (module-define! output-module x
+ (lambda* (#:optional y . z)
+ (missing-stencil-expression x)))
+ (set! missing-stencil-list (cons x missing-stencil-list)))))
+ (ly:all-stencil-commands)))
(define-public (remove-stencil-warnings output-module)
(for-each
(define-pango-pf pango-pf font-name scaling)))
(string-append
- (apply string-append (map font-load-command other-fonts))
- (apply string-append (map pango-font-load-command pango-only-fonts)))))
+ (string-concatenate (map font-load-command other-fonts))
+ (string-concatenate (map pango-font-load-command pango-only-fonts)))))
(if (pair? line-pos)
(begin
(set! iv (cons (car line-pos) (car line-pos)))
- (map (lambda (x)
- (set! iv (cons (min (car iv) x)
- (max (cdr iv) x))))
- (cdr line-pos)))
+ (for-each (lambda (x)
+ (set! iv (cons (min (car iv) x)
+ (max (cdr iv) x))))
+ (cdr line-pos)))
(let ((line-count (ly:grob-property grob 'line-count 0)))
(last-pos (1- (length sorted-elts)))
(idx 0))
- (map (lambda (g)
- (ly:grob-set-property!
- g
- 'has-span-bar
- (cons (if (eq? idx last-pos)
- #f
- grob)
- (if (zero? idx)
- #f
- grob)))
- (set! idx (1+ idx)))
- sorted-elts)))
+ (for-each (lambda (g)
+ (ly:grob-set-property!
+ g
+ 'has-span-bar
+ (cons (if (eq? idx last-pos)
+ #f
+ grob)
+ (if (zero? idx)
+ #f
+ grob)))
+ (set! idx (1+ idx)))
+ sorted-elts)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Line break decisions.
(half-thick (/ line-thickness 2.0))
(stencil empty-stencil))
- (map (lambda (i)
- (let ((top-y (min (* (+ i dash-size) half-space)
- (+ (* (1- line-count) half-space)
- half-thick)))
- (bot-y (max (* (- i dash-size) half-space)
- (- 0 (* (1- line-count) half-space)
- half-thick))))
-
- (set! stencil
- (ly:stencil-add
- stencil
- (ly:round-filled-box (cons 0 thickness)
- (cons bot-y top-y)
- blot)))))
- (iota line-count (1- line-count) (- 2)))
+ (for-each (lambda (i)
+ (let ((top-y (min (* (+ i dash-size) half-space)
+ (+ (* (1- line-count) half-space)
+ half-thick)))
+ (bot-y (max (* (- i dash-size) half-space)
+ (- 0 (* (1- line-count) half-space)
+ half-thick))))
+
+ (set! stencil
+ (ly:stencil-add
+ stencil
+ (ly:round-filled-box (cons 0 thickness)
+ (cons bot-y top-y)
+ blot)))))
+ (iota line-count (1- line-count) (- 2)))
stencil)
(let* ((dashes (/ height staff-space))
(total-dash-size (/ height dashes))
;; we compute the extents of each system and store them
;; in a list; dito for the 'allow-span-bar property.
;; model-bar takes the bar grob, if given.
- (map (lambda (bar)
- (let ((ext (bar-line::bar-y-extent bar refp))
- (staff-symbol (ly:grob-object bar 'staff-symbol)))
-
- (if (ly:grob? staff-symbol)
- (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
-
- (set! ext (interval-union ext refp-extent))
-
- (if (> (interval-length ext) 0)
- (begin
- (set! extents (append extents (list ext)))
- (set! model-bar bar)
- (set! make-span-bars
- (append make-span-bars
- (list (ly:grob-property
- bar
- 'allow-span-bar
- #t))))))))))
- elts)
+ (for-each (lambda (bar)
+ (let ((ext (bar-line::bar-y-extent bar refp))
+ (staff-symbol (ly:grob-object bar 'staff-symbol)))
+
+ (if (ly:grob? staff-symbol)
+ (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
+
+ (set! ext (interval-union ext refp-extent))
+
+ (if (> (interval-length ext) 0)
+ (begin
+ (set! extents (append extents (list ext)))
+ (set! model-bar bar)
+ (set! make-span-bars
+ (append make-span-bars
+ (list (ly:grob-property
+ bar
+ 'allow-span-bar
+ #t))))))))))
+ elts)
;; if there is no bar grob, we use the callback argument
(if (not model-bar)
(set! model-bar grob))
partial-markup-prefix
(make-normal-size-super-markup
(markup-join
- (apply append
- (map step->markup
- (append altered
- (if (and (> (step-nr highest) 5)
- (not
- (step-even-or-altered? highest)))
- (list highest) '())))
- (list partial-markup-suffix)
- (list (map sub->markup missing)))
+ (append
+ (map step->markup
+ (append altered
+ (if (and (> (step-nr highest) 5)
+ (not
+ (step-even-or-altered? highest)))
+ (list highest) '())))
+ (list partial-markup-suffix)
+ (map sub->markup missing))
sep)))))))
;; no exception.
;; handle sus4 and sus2 suffix: if there is a 3 together with
;; sus2 or sus4, then we explicitly say add3.
- (map
+ (for-each
(lambda (j)
(if (get-step j pitches)
(begin
;; make sure that \property Foo.Bar =\turnOff doesn't complain
-(map (lambda (x)
- ;; (display (car x)) (newline)
+(for-each (lambda (x)
+ ;; (display (car x)) (newline)
- (set-object-property! (car x) 'translation-type? list?)
- (set-object-property! (car x) 'is-grob? #t))
- all-grob-descriptions)
+ (set-object-property! (car x) 'translation-type? list?)
+ (set-object-property! (car x) 'is-grob? #t))
+ all-grob-descriptions)
(set! all-grob-descriptions (sort all-grob-descriptions alist<?))
justify word-space
line-width text-direction)))
list-para-words)))
- (apply append para-lines)))
+ (concatenate para-lines)))
(define-markup-command (wordwrap-string layout props arg)
(string?)
))
;; add two native utf-8 aliases. Pairs obey cp-like order: '(old new)
-(map (lambda (pair)
- (set! language-pitch-names
- (append language-pitch-names
- (list (cons (cadr pair)
- (cdr (assoc (car pair) language-pitch-names)))))))
- '((espanol español)
- (italiano français)))
+(for-each
+ (lambda (pair)
+ (set! language-pitch-names
+ (append language-pitch-names
+ (list (cons (cadr pair)
+ (cdr (assoc (car pair) language-pitch-names)))))))
+ '((espanol español)
+ (italiano français)))
(define-public (note-names-language parser str)
(_ "Select note names language.")
transparent-stencil
))
-(map ly:register-stencil-expression
- (append (ly:all-stencil-commands)
- (ly:all-output-backend-commands)))
+(for-each ly:register-stencil-expression
+ (append (ly:all-stencil-commands)
+ (ly:all-output-backend-commands)))
(*
(car slope-offset1)
(+ keylen (list-ref first-bezier 6))) (cdr slope-offset1))))
- ((if bezier? (lambda (x) `(,(apply append x))) identity)
+ ((if bezier? (lambda (x) `(,(concatenate x))) identity)
`((,(+ (+ keylen 1.75) (list-ref first-bezier 6))
,(+
(*
possibility-list))))
(define (translate-draw-instructions input-alist key-name-alist)
- (apply append
- (map (lambda (short long)
+ (append-map (lambda (short long)
(let*
((key-instructions
(map (lambda (instr)
(assoc-get long key-name-alist))))
(key-crawler (assoc-get short input-alist) key-instructions)))
'(hd cc lh rh)
- '(hidden central-column left-hand right-hand))))
+ '(hidden central-column left-hand right-hand)))
(define (uniform-draw-instructions key-name-alist)
- (apply append
- (map (lambda (long)
+ (append-map (lambda (long)
(map (lambda (key-instructions)
`((,long . ,(car key-instructions)) . 1))
(assoc-get long key-name-alist)))
- '(hidden central-column left-hand right-hand))))
+ '(hidden central-column left-hand right-hand)))
(define (list-all-possible-keys key-name-alist)
(map (lambda (short long)
;; properly sort all grobs, properties, and interfaces
;; within the all-grob-descriptions alist
-(map
+(for-each
(lambda (x)
(let* ((props (assoc-ref all-grob-descriptions (car x)))
(meta (assoc-ref props 'meta))
(define iface->grob-table (make-hash-table 61))
;; extract ifaces, and put grob into the hash table.
-(map
+(for-each
(lambda (x)
(let* ((meta (assoc-get 'meta (cdr x)))
(ifaces (assoc-get 'interfaces meta)))
- (map (lambda (iface)
- (hashq-set!
- iface->grob-table iface
- (cons (car x)
- (hashq-ref iface->grob-table iface '()))))
- ifaces)))
+ (for-each (lambda (iface)
+ (hashq-set!
+ iface->grob-table iface
+ (cons (car x)
+ (hashq-ref iface->grob-table iface '()))))
+ ifaces)))
all-grob-descriptions)
;; First level Interface description
;;;;;;;;;; check for dangling backend properties.
(define (mark-interface-properties entry)
- (map (lambda (x) (set-object-property! x 'iface-marked #t))
- (caddr (cdr entry))))
+ (for-each (lambda (x) (set-object-property! x 'iface-marked #t))
+ (caddr (cdr entry))))
-(map mark-interface-properties interface-description-alist)
+(for-each mark-interface-properties interface-description-alist)
(define (check-dangling-properties prop)
(if (not (object-property prop 'iface-marked))
(ly:error (string-append "define-grob-properties.scm: "
(_ "cannot find interface for property: ~S")) prop)))
-(map check-dangling-properties all-backend-properties)
+(for-each check-dangling-properties all-backend-properties)
;;;;;;;;;;;;;;;;
(map document-mod-list mod-list))))
(define (document-mod obj-pair)
- (cond
- ((ly:context-mod? (cdr obj-pair))
- (document-context-mod obj-pair))
- (else
- #f)))
+ (and (ly:context-mod? (cdr obj-pair))
+ (document-context-mod obj-pair)))
(define context-mods-doc-string
(format
@end table
"
(string-join
- (filter
- identity
- (map
- document-mod
- (sort
- (ly:module->alist (current-module))
- identifier<?)))
- "")))
+ (filter-map
+ document-mod
+ (sort
+ (ly:module->alist (current-module))
+ identifier<?)))
+ ""))
#:name "Scheme functions"
#:desc "Primitive functions exported by LilyPond."
#:text
- (apply string-append sfdocs))))
+ (string-concatenate sfdocs))))
;; (dump-node (all-scheme-functions-doc) (current-output-port) 0 )
~a
"
name-sym (car type-names)
- (if (equal? "" signature-str) "" " - ") signature-str
+ (if (string-null? signature-str) "" " - ") signature-str
name-sym
(if doc
doc
(define (document-object obj-pair)
- (cond
- ((ly:music-function? (cdr obj-pair))
- (document-music-function obj-pair))
- (else
- #f)))
+ (and (ly:music-function? (cdr obj-pair))
+ (document-music-function obj-pair)))
(define-public (identifiers-doc-string)
(format #f
@end table
"
(string-join
- (filter
- identity
- (map
- document-object
- (sort
- (ly:module->alist (current-module))
- identifier<?)))
- "")))
+ (filter-map
+ document-object
+ (sort
+ (ly:module->alist (current-module))
+ identifier<?)))
+ ""))
(if (null? prop-strings)
"\n"
(string-append "\n\n\nUsed properties:\n@itemize\n"
- (apply string-append prop-strings)
+ (string-concatenate prop-strings)
"@end itemize\n"))))))
(define (markup-function<? a b)
#:desc ""
#:text (string-append
"@table @asis"
- (apply string-append
- (map doc-markup-function
- (sort markup-functions markup-function<?)))
+ (string-concatenate
+ (map doc-markup-function
+ (sort markup-functions markup-function<?)))
"\n@end table"))))
(define (markup-doc-node)
(define (markup-list-doc-string)
(string-append
"@table @asis"
- (apply string-append
- (map doc-markup-function
- (sort (hash-fold (lambda (markup-list-function dummy functions)
- (cons markup-list-function functions))
- '()
- markup-list-functions)
- markup-function<?)))
+ (string-concatenate
+ (map doc-markup-function
+ (sort (hash-fold (lambda (markup-list-function dummy functions)
+ (cons markup-list-function functions))
+ '()
+ markup-list-functions)
+ markup-function<?)))
"\n@end table"))
texi)))
(define music-types->names (make-hash-table 61))
-(filter-map (lambda (entry)
- (let* ((class (ly:camel-case->lisp-identifier (car entry)))
- (classes (ly:make-event-class class)))
- (if classes
- (map
- (lambda (cl)
- (hashq-set! music-types->names cl
- (cons (car entry)
- (hashq-ref music-types->names cl '()))))
- classes)
- #f)))
- music-descriptions)
+(for-each (lambda (entry)
+ (let* ((class (ly:camel-case->lisp-identifier (car entry)))
+ (classes (ly:make-event-class class)))
+ (if classes
+ (for-each
+ (lambda (cl)
+ (hashq-set! music-types->names cl
+ (cons (car entry)
+ (hashq-ref music-types->names cl '()))))
+ classes))))
+ music-descriptions)
(define (strip-description x)
(cons (symbol->string (car x))
(let* ((layout-alist (ly:output-description $defaultlayout))
(context-description-alist (map cdr layout-alist))
(contexts
- (apply append
- (map
- (lambda (x)
- (let* ((context (assoc-get 'context-name x))
- (group (assq-ref x 'group-type))
- (consists (append
- (if group
- (list group)
- '())
- (assoc-get 'consists x))))
- (if (member name-sym consists)
- (list context)
- '())))
- context-description-alist)))
+ (append-map
+ (lambda (x)
+ (let* ((context (assoc-get 'context-name x))
+ (group (assq-ref x 'group-type))
+ (consists (append
+ (if group
+ (list group)
+ '())
+ (assoc-get 'consists x))))
+ (if (member name-sym consists)
+ (list context)
+ '())))
+ context-description-alist))
(context-list (human-listify (map ref-ify
(sort
(map symbol->string contexts)
;; Second level, part of Context description
(define name->engraver-table (make-hash-table 61))
-(map
+(for-each
(lambda (x)
(hash-set! name->engraver-table (ly:translator-name x) x))
(ly:get-all-translators))
"."
(if (and (pair? props) (not (null? props)))
- (let ((str (apply string-append
- (sort (map document-property-operation props)
- ly:string-ci<?))))
+ (let ((str (string-concatenate
+ (sort (map document-property-operation props)
+ ly:string-ci<?))))
(if (string-null? str)
""
(string-append
(list group)
'())
(assoc-get 'consists context-desc)))
- (grobs (apply append
- (map engraver-grobs consists))))
+ (grobs (append-map engraver-grobs consists)))
grobs))
(define (all-contexts-doc)
"\n"
"@multitable @columnfractions .33 .66\n"
"@headitem Type predicate @tab Description\n"
- (apply string-append
- (sort (map document-type-predicate alist)
- ly:string-ci<?))
+ (string-concatenate
+ (sort (map document-type-predicate alist)
+ ly:string-ci<?))
"@end multitable\n"
"\n"))
"* LilyPond exported predicates::\n"
"@end menu\n"
"\n"
- (apply
- string-append
+ (string-concatenate
(map
(lambda (alist-nodename-list)
(apply document-type-predicate-category
(use-modules (scm accreg))
-(map ly:load '("documentation-lib.scm"
- "lily-sort.scm"
- "document-functions.scm"
- "document-translation.scm"
- "document-music.scm"
- "document-type-predicates.scm"
- "document-identifiers.scm"
- "document-context-mods.scm"
- "document-backend.scm"
- "document-markup.scm"))
+(for-each ly:load '("documentation-lib.scm"
+ "lily-sort.scm"
+ "document-functions.scm"
+ "document-translation.scm"
+ "document-music.scm"
+ "document-type-predicates.scm"
+ "document-identifiers.scm"
+ "document-context-mods.scm"
+ "document-backend.scm"
+ "document-markup.scm"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(node-children node)))
""))
port)
- (map (lambda (x) (dump-node x port (+ 1 level)))
- (node-children node)))
+ (for-each (lambda (x) (dump-node x port (+ 1 level)))
+ (node-children node)))
(define (processing name)
(ly:basic-progress (_ "Processing ~S...") name))
"\n"
(if quote? "@quotation\n" "")
"@table @asis\n"
- (apply string-append (map one-item->texi items-alist))
+ (string-concatenate (map one-item->texi items-alist))
"\n"
"@end table\n"
(if quote? "@end quotation\n" "")))
(string-append
"\n@menu"
- (apply string-append
- (map (lambda (x)
- (string-append
- (string-pad-right
- (string-append "\n* " (car x) ":: ")
- (+ maxwid 8))
- (cdr x)))
- items-alist))
+ (string-concatenate
+ (map (lambda (x)
+ (string-append
+ (string-pad-right
+ (string-append "\n* " (car x) ":: ")
+ (+ maxwid 8))
+ (cdr x)))
+ items-alist))
"\n@end menu\n"
;; Menus don't appear in html, so we make a list ourselves
"\n@ignore\n"
#:children (make-hash-table 11)))
(define-method (display (leaf <Font-tree-leaf>) port)
- (map (lambda (x) (display x port))
- (list
- "#<Font-size-family:\n"
- (slot-ref leaf 'default-size)
- (slot-ref leaf 'size-vector)
- "#>"
- )))
+ (for-each (lambda (x) (display x port))
+ (list
+ "#<Font-size-family:\n"
+ (slot-ref leaf 'default-size)
+ (slot-ref leaf 'size-vector)
+ "#>"
+ )))
(define-method (display (node <Font-tree-node>) port)
- (map
+ (for-each
(lambda (x)
(display x port))
(list
(list (ly:font-name font))))
(let* ((fonts (ly:paper-fonts paper))
- (names (apply append (map extract-names fonts))))
- (apply string-append
- (map (lambda (f)
- (format #f
- (if load-fonts?
- "%%DocumentSuppliedResources: font ~a\n"
- "%%DocumentNeededResources: font ~a\n")
- f))
- (uniq-list (sort names string<?))))))
+ (names (append-map extract-names fonts)))
+ (string-concatenate
+ (map (lambda (f)
+ (format #f
+ (if load-fonts?
+ "%%DocumentSuppliedResources: font ~a\n"
+ "%%DocumentNeededResources: font ~a\n")
+ f))
+ (uniq-list (sort names string<?))))))
(define (eps-header paper bbox load-fonts?)
(string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
(ly:font-sub-fonts font))))
fonts))
(font-names (uniq-list
- (sort (apply append all-font-names)
+ (sort (concatenate all-font-names)
(lambda (x y) (string<? (cadr x) (cadr y))))))
;; slightly spaghetti-ish: deciding what to load where
(list elem)))
'() lst))
-(define-public (filtered-map proc lst)
- (filter
- (lambda (x) x)
- (map proc lst)))
+(define-public filtered-map filter-map)
(define-public (flatten-list x)
"Unnest list."
(let* ((stat (gulp-file "/proc/self/status"))
(lines (string-split stat #\newline))
- (interesting (filter identity
- (map
- (lambda (l)
- (string-match "^VmData:[ \t]*([0-9]*) kB" l))
- lines)))
+ (interesting (filter-map
+ (lambda (l)
+ (string-match "^VmData:[ \t]*([0-9]*) kB" l))
+ lines))
(mem (string->number (match:substring (car interesting) 1))))
(format #t "VMDATA: ~a\n" mem)
(display (gc-stats))
(ly:exit 2 #t)))
(if (ly:get-option 'read-file-list)
(set! files
- (filter (lambda (s)
- (> (string-length s) 0))
- (apply append
- (map (lambda (f)
- (string-split (string-delete (ly:gulp-file f) #\cr) #\nl))
- files)))))
+ (remove string-null?
+ (append-map
+ (lambda (f)
+ (string-split (string-delete (ly:gulp-file f) #\cr) #\nl))
+ files))))
(if (and (number? (ly:get-option 'job-count))
(>= (length files) (ly:get-option 'job-count)))
(let* ((count (ly:get-option 'job-count))
(ly:music-set-property! music 'pitch (converter pitch)))
((pair? elements)
- (map (lambda (x) (change-pitches x converter)) elements))
+ (for-each (lambda (x) (change-pitches x converter)) elements))
((ly:music? element)
(change-pitches element converter)))))
(if (ly:dir? span-dir)
(ly:music-set-property! music 'span-direction (- span-dir)))
- (map retrograde-music reversed)
+ (for-each retrograde-music reversed)
music))
(string-length "-markup")))))))
(define (transform-arg arg)
(cond ((and (pair? arg) (markup? (car arg))) ;; a markup list
- (apply append (map inner-markup->make-markup arg)))
+ (append-map inner-markup->make-markup arg))
((and (not (string? arg)) (markup? arg)) ;; a markup
(inner-markup->make-markup arg))
(else ;; scheme arg
(ly:music? obj)
`(make-music
',(ly:music-property obj 'name)
- ,@(apply append (map (lambda (prop)
- `(',(car prop)
- ,(music->make-music (cdr prop))))
- (remove (lambda (prop)
- (eqv? (car prop) 'origin))
- (ly:music-mutable-properties obj))))))
+ ,@(append-map (lambda (prop)
+ `(',(car prop)
+ ,(music->make-music (cdr prop))))
+ (remove (lambda (prop)
+ (eqv? (car prop) 'origin))
+ (ly:music-mutable-properties obj)))))
(;; moment
(ly:moment? obj)
`(ly:make-moment ,(ly:moment-main-numerator obj)
(layout (ly:grob-layout root))
(blot (ly:output-def-lookup layout 'blot-diameter)))
;; Hide spanned stems
- (map (lambda (st)
- (set! (ly:grob-property st 'stencil) #f))
- stems)
+ (for-each (lambda (st)
+ (set! (ly:grob-property st 'stencil) #f))
+ stems)
;; Draw a nice looking stem with rounded corners
(ly:round-filled-box (ly:grob-extent root root X) yextent blot))
;; Nothing to connect, don't draw the span
;; two stems at this musical moment
(if (<= 2 (length stems))
(let ((roots (filter stem-is-root? stems)))
- (map (make-stem-span! stems trans) roots))))
+ (for-each (make-stem-span! stems trans) roots))))
(define-public (Span_stem_engraver ctx)
"Connect cross-staff stems to the stems above in the system"
(define-public (color? x)
(and (list? x)
(= 3 (length x))
- (apply eq? #t (map number? x))
- (apply eq? #t (map (lambda (y) (<= 0 y 1)) x))))
+ (every number? x)
+ (every (lambda (y) (<= 0 y 1)) x)))
(define-public (rgb-color r g b) (list r g b))
;; Helper functions
(define-public (attributes attributes-alist)
- (apply string-append
- (map (lambda (x)
- (let ((attr (car x))
- (value (cdr x)))
- (if (number? value)
- (set! value (ly:format "~4f" value)))
- (format #f " ~s=\"~a\"" attr value)))
- attributes-alist)))
+ (string-concatenate
+ (map (lambda (x)
+ (let ((attr (car x))
+ (value (cdr x)))
+ (if (number? value)
+ (set! value (ly:format "~4f" value)))
+ (format #f " ~s=\"~a\"" attr value)))
+ attributes-alist)))
(define-public (eo entity . attributes-alist)
"o = open"
(integer->entity (char->integer char)))
(define (string->entities string)
- (apply string-append
- (map (lambda (x) (char->entity x)) (string->list string))))
+ (string-concatenate
+ (map char->entity (string->list string))))
(define svg-element-regexp
(make-regexp "^(<[a-z]+) ?(.*>)"))
`(stroke-linecap . ,(symbol->string cap-style))
'(stroke . "currentColor")
`(fill . ,(if fill? "currentColor" "none"))
- `(d . ,(apply string-append (convert-path-exps commands))))))
+ `(d . ,(string-concatenate (convert-path-exps commands))))))
(define (placebox x y expr)
(if (string-null? expr)
(append (cdr lines) (list #f)))
(paper-system-annotate-last (car (last-pair lines)) layout)))
- (map add-system lines)
+ (for-each add-system lines)
(ly:prob-set-property! page 'bottom-system-edge
"Generate the clef setting commands for a clef with name @var{clef-name}."
(define (make-prop-set props)
(let ((m (make-music 'PropertySet)))
- (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
+ (for-each (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
m))
(let ((e '())
(c0 0)
(define (analyse-forced-combine result-idx prev-res)
(define (get-forced-event x)
- (if (ly:in-event-class? x 'part-combine-force-event)
- (cons (ly:event-property x 'forced-type) (ly:event-property x 'once))
- #f))
+ (and (ly:in-event-class? x 'part-combine-force-event)
+ (cons (ly:event-property x 'forced-type)
+ (ly:event-property x 'once))))
(define (part-combine-events vs)
(if (not vs)
'()
(prev (configuration prev-ss)))
(if (symbol? prev)
(put prev))))
- (map copy-one-state (span-state vs)))
+ (for-each copy-one-state (span-state vs)))
(define (analyse-notes now-state)
(let* ((vs1 (car (voice-states now-state)))
(if (not (= 0 status))
(begin
- (map delete-file files)
+ (for-each delete-file files)
(exit 1)))
(if (and rename-page-1 multi-page?)
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-(map
+(for-each
(lambda (sym)
(set! safe-objects (cons (cons sym (primitive-eval sym))
safe-objects)))
((record-constructor ,record) ,@(map car slots*))))
(set! ,$copy-record
(lambda (record)
- (,$make-record ,@(apply
- append
- (map (lambda (slot)
- (list (symbol->keyword slot)
- (list (make-symbol reader-format slot) 'record)))
- (map car slots*))))))
+ (,$make-record ,@(append-map
+ (lambda (slot)
+ (list (symbol->keyword slot)
+ (list (make-symbol reader-format slot) 'record)))
+ (map car slots*)))))
,@(map (lambda (s)
`(set! ,(make-symbol reader-format (car s))
(record-accessor ,record (quote ,(car s)))))
\n((0.0 . 2) (PI/2 . 3) (PI . -2) (3*PI/2 . -3)\
\n(2*PI . 2) (5*PI/2 . 3) (3*PI . -2) (7*PI/2 . -3))
"
- (apply append
- (map (lambda (adder)
- (map (lambda (quadrant)
- (cons (+ adder (car quadrant))
- (cdr quadrant)))
- `((0.0 . (,x-radius . 0.0))
- (,PI-OVER-TWO . (0.0 . ,y-radius))
- (,PI . (,(- x-radius) . 0.0))
- (,THREE-PI-OVER-TWO . (0.0 . ,(- y-radius))))))
- `(0.0 ,TWO-PI))))
+ (append-map
+ (lambda (adder)
+ (map (lambda (quadrant)
+ (cons (+ adder (car quadrant))
+ (cdr quadrant)))
+ `((0.0 . (,x-radius . 0.0))
+ (,PI-OVER-TWO . (0.0 . ,y-radius))
+ (,PI . (,(- x-radius) . 0.0))
+ (,THREE-PI-OVER-TWO . (0.0 . ,(- y-radius))))))
+ `(0.0 ,TWO-PI)))
(define
(insert-in-ordered-list ordering-function value inlist cutl? cutr?)
"
(reduce min-max
(if (eq? min-max min) 100000 -100000)
- (map (lambda (x) (side x)) l)))
+ (map side l)))
(let*
(;; the outside limit of the x-radius
(null (cons 0 0))
(arrow-1
(ly:make-stencil
- `(polygon (quote ,(concatenate (map complex-to-offset p1s)))
+ `(polygon (quote ,(append-map complex-to-offset p1s))
0.0
#t) null null))
(arrow-2
(ly:make-stencil
- `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
+ `(polygon (quote ,(append-map complex-to-offset p2s))
0.0
#t) null null ) )
(thickness (min (/ distance 12) 0.1))
(elt (ly:music-property mus 'element)))
(cond
((pair? elts)
- (map make-harmonic elts))
+ (for-each make-harmonic elts))
((ly:music? elt)
(make-harmonic elt))
((music-is-of-type? mus 'note-event)
;; Normalize to given beat, extract the beats and join them to one list
(let* ((beat (calculate-compound-base-beat-full time-sig))
(normalized (map (lambda (f) (normalize-fraction f beat)) time-sig))
- (beats (map (lambda (f) (reverse (cdr (reverse f)))) normalized)))
- (apply append beats)))
+ (beats (map (lambda (f) (drop-right f 1)) normalized)))
+ (concatenate beats)))
(define-public (calculate-compound-beat-grouping time-sig)
(cond
(if (equal? (node-value node) "")
(string-append
(if xml-name "\n" "")
- (apply string-append (map musicxml-node->string (node-children node))))
+ (string-concatenate (map musicxml-node->string (node-children node))))
(node-value node))
(if xml-name (close-tag xml-name) "")
(if xml-name "\n" ""))))
"\n"
(open-tag (node-name node) (node-attributes node) '())
(if (equal? (node-value node) "")
- (string-append
- (apply string-append (map xml-node->string (node-children node))))
+ (string-concatenate (map xml-node->string (node-children node)))
(node-value node))
"\n"
(close-tag (node-name node))))
(string-append
"<" (symbol->string tag)
- (apply string-append (map dump-attr (filter candidate? attrs)))
+ (string-concatenate (map dump-attr (filter candidate? attrs)))
">"))
(define (close-tag name)
if no fingering is present."
(let* ((articulations (ly:event-property ev 'articulations))
(finger-found #f))
- (map (lambda (art)
- (let* ((num (ly:event-property art 'digit)))
-
- (if (and (ly:in-event-class? art 'fingering-event)
- (number? num)
- (> num 0))
- (set! finger-found num))))
- articulations)
+ (for-each (lambda (art)
+ (let* ((num (ly:event-property art 'digit)))
+
+ (if (and (ly:in-event-class? art 'fingering-event)
+ (number? num)
+ (> num 0))
+ (set! finger-found num))))
+ articulations)
finger-found))
(define (delete-free-string string)
projects / lilypond.git / commitdiff