Re: make-span-event

[Nicolas Sceaux]

Juergen Reuter <address@hidden> writes:

> Aah, ok, I understand.  That helps me a lot!
>
> Many thanks,
> Jürgen
>
> PS: btw, how did you do the
>
> guile> (mus:display #{ \notemode { d\cr e\endcr } #})
>
> ?  Applying grep on the lilypond source tree, I could not find any file 
> that defines the "mus:display" function.
>

This is a homebrew utility.


(use-modules (ice-9 format) 
             (ice-9 optargs)
             (srfi srfi-1))

(define (mus:markup->make-markup markup-expression)
  "Generate a expression that, when evaluated, return an equivalent markup
expression"
  (define (inner-markup->make-markup mrkup)
    (let ((cmd (car mrkup))
          (args (cdr mrkup)))
      `(,(proc->command cmd) ,@(map transform-arg args))))
  (define (proc->command proc)
    (let ((cmd-markup (symbol->string (procedure-name proc))))
      (symbol->keyword (string->symbol (substring cmd-markup 0 (- 
(string-length cmd-markup)
                                                                  
(string-length "-markup")))))))
  (define (transform-arg arg)
    (cond ((and (pair? arg) (pair? (car arg))) ;; markup list
           (apply append (map inner-markup->make-markup arg)))
          ((pair? arg)                         ;; markup
           (inner-markup->make-markup arg))
          (else                                ;; scheme arg
           arg)))
  `(markup ,@(inner-markup->make-markup markup-expression)))

(define*-public (mus:pretty-string obj #:optional (depth 0))
  "Return a string describing `obj', in particular music expression
will be printed as: (make-music 'MusicType 'property ...)"
  (cond ((ly:music? obj)
         (format #f "(make-music '~a~{~a~})"
                 (ly:music-property obj 'name)
                 (map (lambda (prop)
                        (format #f "~%~v_'~a ~a" 
                                (+ 2 (* 13 depth))
                                (car prop)
                                (cond ((list? (cdr prop))
                                       (format #f "(list~{~a~})"
                                               (map (lambda (mus)
                                                      (format #f "~%~v_~a"
                                                              (* 13 (1+ depth))
                                                              
(mus:pretty-string mus (1+ depth))))
                                                    (cdr prop))))
                                      ((string? (cdr prop))
                                       (string-append "\"" (cdr prop) "\""))
                                      (else
                                       (mus:pretty-string (cdr prop) (1+ 
depth))))))
                      (remove (lambda (prop)
                                (eqv? (car prop) 'origin))
                              (ly:music-mutable-properties obj)))))
        ((string? obj) (format #f "\"~a\"" obj))
        ((symbol? obj) (format #f "'~a" obj))
        ((ly:duration? obj) (format #f "(ly:make-duration ~a ~a ~a ~a)"
                                    (ly:duration-log obj)
                                    (ly:duration-dot-count obj)
                                    (car (ly:duration-factor obj))
                                    (cdr (ly:duration-factor obj))))
        ((ly:pitch? obj) (format #f "(ly:make-pitch ~a ~a ~a)"
                                 (ly:pitch-octave obj)
                                 (ly:pitch-notename obj)
                                 (ly:pitch-alteration obj)))
        ((procedure? obj) (or (procedure-name obj) (format #f "(lambda ...)")))
        ((and (list? obj) (markup-function? (car obj)))
         (format #f "~a" (mus:markup->make-markup obj)))
        (format #f "~a" obj)))

(define-public (mus:display obj)
  (display (mus:pretty-string obj))
  (newline))