lib/40-loadmacros.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 40-loadmacros.scm                                  ;
   3 ;                                                                  ;
   4 ; (c) 2008-2011 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 as published by the Free Software         ;
   9 ; Foundation, either version 3 of the License, or (at your option) ;
  10 ; any later version.                                               ;
  11 ;     This program is distributed WITHOUT ANY WARRANTY; without    ;
  12 ; even the implied warranty of MERCHANTABILITY or FITNESS FOR A    ;
  13 ; PARTICULAR PURPOSE.  You should have received a copy of the GNU  ;
  14 ; General Public License along with this program (typically in the ;
  15 ; share/doc/ directory).  If not, see http://www.gnu.org/licenses/ ;
  16 ;                                                                  ;
  17 ;------------------------------------------------------------------;
  18
  19
  20
  21 (defmacro make-function (token funct)
  22   (let* ((sym (if (defined-string? token)
  23                   (string->symbol (primitive-eval token))
  24                   token)))
  25     `(define-public ,sym ,funct)))
  26
  27
  28 (defmacro staff-change-command (token)
  29   (let* ((str (primitive-eval token))
  30          (sym (if (defined-string? token)
  31                   (string->symbol str)
  32                   token)))
  33     `(define-public ,sym
  34        (define-music-function (parser location) ()
  35          (make-music 'ContextChange 'change-to-type 'Staff
  36                                     'change-to-id ,str)))))
  37
  38 (defmacro make-script (str)
  39   (let* ((sym (car (primitive-eval str)))
  40          (script (cdr (primitive-eval str))))
  41     `(define-public ,sym
  42        (define-music-function (parser location mus) (ly:music?)
  43          (add-script mus ,script)))))
  44
  45
  46 ;; Not used. See make-script above.
  47 (define (make-scripts lst)
  48   (let ((rest '()))
  49     (if (list? lst)
  50         (begin
  51           (set! rest (cdr lst))
  52           (set! lst (car lst))))
  53     (let ((sym (car lst))
  54           (script (cdr lst)))
  55       (eval-string (format #f
  56                            ;; hackish, but oh sooo convenient
  57                            "(define-public ~a
  58           (define-music-function (parser location mus) (ly:music?)
  59           (add-script mus \"~a\")))" sym script)))
  60     (if (not-null? rest) (make-scripts rest))))
  61
  62 (define (load-macros-in dir)
  63    (map (lambda (x)
  64           (begin
  65             (ly:debug-message "Loading macros file ~a..." x)
  66             ;; ugh.
  67             (scm-load (string-append "../" x))))
  68        (find-files dir ".scm$")))
  69
  70 (define eval-macros
  71 ;;   "Load macros, first at a global level
  72 ;; (typically in bin/), then locally (which
  73 ;; allows the score to override some definitions
  74 ;; if needed)."
  75   (begin
  76     (load-macros-in conf:macros-dir)
  77     (load-macros-in conf:local-conf-dir)))