Re: Creating markup macros (functions actually)

[Nicolas Sceaux]

Paul Scott <address@hidden> writes:

> Nicolas Sceaux wrote:
>
>>Create that music-display.scm file, in the same directory as
>>displayscheme.ly, with the code from
>> http://lists.gnu.org/archive/html/lilypond-devel/2004-11/msg00029.html
>>
> In my best attempt to extract the code from that email I get:

> music-display.scm:61:27: In expression (markup-function? (car obj)):
> music-display.scm:61:27: Unbound variable: markup-function?

hm, sorry.

(define-module (lily))
(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))
(define-module (*anonymous-ly-0*))

nicolas