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 (defmacro staff-change-command (token)
  28   (let* ((str (primitive-eval token))
  29          (sym (if (defined-string? token)
  30                   (string->symbol str)
  31                   token)))
  32     `(define-public ,sym
  33        (define-music-function (parser location) ()
  34          (make-music 'ContextChange 'change-to-type 'Staff
  35                                     'change-to-id ,str)))))
  36
  37 (defmacro make-script (str)
  38   (let* ((sym (car (primitive-eval str)))
  39          (script (cdr (primitive-eval str))))
  40     `(define-public ,sym
  41        (define-music-function (parser location mus) (ly:music?)
  42          (add-script mus ,script)))))
  43
  44
  45 ;; Not used. See make-script above.
  46 (define (make-scripts lst)
  47   (let ((rest '()))
  48     (if (list? lst)
  49         (begin
  50           (set! rest (cdr lst))
  51           (set! lst (car lst))))
  52     (let ((sym (car lst))
  53           (script (cdr lst)))
  54       (eval-string (format #f
  55                            ;; hackish, but oh sooo convenient
  56                            "(define-public ~a
  57           (define-music-function (parser location mus) (ly:music?)
  58           (add-script mus \"~a\")))" sym script)))
  59     (if (not-null? rest) (make-scripts rest))))
  60
  61 (define (load-macros-in dir)
  62    (map (lambda (x)
  63           (begin
  64             (ly:debug-message "Loading macros file ~a..." x)
  65             ;; ugh.
  66             (scm-load (string-append "../" x))))
  67        (find-files dir ".scm$")))
  68
  69 (define eval-macros
  70 ;;   "Load macros, first at a global level
  71 ;; (typically in bin/), then locally (which
  72 ;; allows the score to override some definitions
  73 ;; if needed)."
  74   (begin
  75     (load-macros-in conf:macros-dir)
  76     (load-macros-in conf:local-conf-dir)))