lib/70-loadmacros.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 70-loadmacros.scm                                  ;
   3 ;                                                                  ;
   4 ; (c) 2008-2010 Valentin Villenave <valentin@villenave.net>        ;
   5 ;                                                                  ;
   6 ;     opus_libre is a free framework for GNU LilyPond: you may     ;
   7 ; redistribute it and/or modify it under the terms of the GNU      ;
   8 ; General Public License, version 3 or later: gnu.org/licenses     ;
   9 ;                                                                  ;
  10 ;------------------------------------------------------------------;
  11
  12
  13
  14 (defmacro make-simple-function (token expr)
  15   (let* ((sym (if (is-defined? token)
  16                   (string->symbol (primitive-eval token))
  17                   token)))
  18     `(define-public ,sym
  19       (ly:make-music-function (list ly:music?)
  20         (lambda (parser location x)
  21     ,expr)))))
  22
  23 (defmacro make-script (str)
  24   (let* ((sym (car (primitive-eval str)))
  25          (script (cdr (primitive-eval str))))
  26     `(define-public ,sym
  27        (ly:make-music-function (list ly:music?)
  28                                (lambda (parser location mus)
  29                                  (add-script mus ,script))))))
  30
  31
  32 ;; Not used. See make-script above.
  33 (define (make-scripts lst)
  34   (let ((rest '()))
  35     (if (list? lst)
  36         (begin
  37           (set! rest (cdr lst))
  38           (set! lst (car lst))))
  39     (let ((sym (car lst))
  40           (script (cdr lst)))
  41       (eval-string (format #f
  42                            ;; hackish, but oh sooo convenient
  43                            "(define-public ~a
  44           (ly:make-music-function (list ly:music?)
  45           (lambda (parser location mus)
  46           (add-script mus \"~a\"))))" sym script)))
  47     (if (not (null? rest)) (make-scripts rest))))
  48
  49 (define eval-macros
  50   (map (lambda (x)
  51          ;; ugh.
  52          (load (string-append "../" x)))
  53        (find-files conf:macros-dir ".scm$")))