scm/ly-from-scheme.scm

   1 ;;;; ly-from-scheme.scm -- parsing LilyPond music expressions from scheme
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c)  2000--2004  Han-Wen Nienhuys <hanwen@cs.uu.nl>
   6 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8
   9 (define gen-lily-sym
  10   ;; Generate a lilyvartmpXX symbol, that may be (hopefully) unique.
  11   (let ((var-idx -1))
  12     (lambda ()
  13       (set! var-idx (1+ var-idx))
  14       (string->symbol (format #f "lilyvartmp~a"
  15                               (list->string (map (lambda (chr)
  16                                                    (integer->char (+ (char->integer #\a) (- (char->integer chr)
  17                                                                                             (char->integer #\0)))))
  18                                                  (string->list (number->string var-idx)))))))))
  19
  20 (define-public (ly:parse-string-result str module)
  21   "Parse `str', which is supposed to contain a music expression."
  22   (let ((music-sym (gen-lily-sym)))
  23     (ly:parser-parse-string
  24      parser
  25      (format #f "
  26 ~a = { ~a }
  27 #(ly:export '~a)
  28 #(module-define! (resolve-module '~a) '~a ~a)
  29 "
  30              music-sym str music-sym (module-name module) music-sym music-sym))
  31   (eval `,music-sym module)))
  32
  33 (define-public (read-lily-expression chr port)
  34   "Read a #{ lily music expression #} from port and return
  35 the scheme music expression. The $ character may be used to introduce
  36 scheme forms, typically symbols. $$ may be used to simply write a `$'
  37 character."
  38   (let* ((format-args '())
  39          (lily-string (with-output-to-string
  40                         (lambda ()
  41                           (do ((c (read-char port) (read-char port)))
  42                               ((and (char=? c #\#)
  43                                     (char=? (peek-char port) #\}))
  44                                (read-char port))
  45                             (cond ((and (char=? c #\$)
  46                                         (not (char=? (peek-char port) #\$)))
  47                                    ;; a $variable
  48                                    (display "~a")
  49                                    (set! format-args (cons (read port)
  50 format-args)))
  51                                   ((and (char=? c #\$)
  52                                         (char=? (peek-char port) #\$))
  53                                    ;; just a $ character
  54                                    (display (read-char port)))
  55                                   (else
  56                                    ;; other caracters
  57                                    (display c))))))))
  58    `(ly:parse-string-result (format #f ,lily-string ,@(reverse! format-args))
  59                             (current-module))))
  60
  61 (read-hash-extend #\{ read-lily-expression)