ly/markup-init.ly

   1 %% -*- Mode: Scheme -*-
   2
   3 \version "2.11.9"
   4
   5 %%;; to be define later, in a closure
   6 #(define-public toplevel-module-define-public! #f)
   7 #(define-public toplevel-module-ref #f)
   8 #(let ((toplevel-module (current-module)))
   9    (set! toplevel-module-define-public!
  10          (lambda (symbol value)
  11            (module-define! toplevel-module symbol value)
  12            (module-export! toplevel-module (list symbol))))
  13    (set! toplevel-module-ref
  14          (lambda (symbol)
  15            (module-ref toplevel-module symbol))))
  16
  17 #(defmacro-public define-public-toplevel
  18    (first-arg . rest)
  19   "Define a public variable or function in the toplevel module:
  20   (define-public-toplevel variable-name value)
  21 or:
  22   (define-public-toplevel (function-name . args)
  23     ..body..)"
  24   (if (symbol? first-arg)
  25       ;; (define-public-toplevel symbol value)
  26       (let ((symbol first-arg)
  27             (value (car rest)))
  28         `(toplevel-module-define-public! ',symbol ,value))
  29       ;; (define-public-toplevel (function-name . args) . body)
  30       (let ((function-name (car first-arg))
  31             (arg-list (cdr first-arg))
  32             (body rest))
  33         `(toplevel-module-define-public!
  34           ',function-name
  35           (let ((proc (lambda ,arg-list
  36                         ,@body)))
  37             (set-procedure-property! proc
  38                                      'name
  39                                      ',function-name)
  40             proc)))))
  41
  42 #(defmacro-public define-markup-command (command-and-args signature . body)
  43   "
  44 * Define a COMMAND-markup function after command-and-args and body,
  45 register COMMAND-markup and its signature,
  46
  47 * add COMMAND-markup to markup-function-list,
  48
  49 * sets COMMAND-markup markup-signature and markup-keyword object properties,
  50
  51 * define a make-COMMAND-markup function.
  52
  53 Syntax:
  54   (define-markup-command (COMMAND layout props arg1 arg2 ...)
  55                          (arg1-type? arg2-type? ...)
  56     \"documentation string\"
  57     ...command body...)
  58 or:
  59   (define-markup-command COMMAND (arg1-type? arg2-type? ...) function)
  60 "
  61   (let* ((command (if (pair? command-and-args)
  62                       (car command-and-args)
  63                       command-and-args))
  64          (command-name (string->symbol (format #f "~a-markup" command)))
  65          (make-markup-name (string->symbol (format #f "make-~a-markup" command))))
  66     `(begin
  67        ;; define the COMMAND-markup procedure in toplevel module
  68        ,(if (pair? command-and-args)
  69             ;; 1/ (define (COMMAND-markup layout props arg1 arg2 ...)
  70             ;;      ..command body))
  71             `(define-public-toplevel (,command-name ,@(cdr command-and-args))
  72                ,@body)
  73             ;; 2/ (define (COMMAND-markup . args) (apply function args))
  74             (let ((args (gensym "args"))
  75                   (command (car body)))
  76             `(define-public-toplevel (,command-name . ,args)
  77                (apply ,command ,args))))
  78        (let ((command-proc (toplevel-module-ref ',command-name)))
  79          ;; register its command signature
  80          (set! (markup-command-signature command-proc)
  81                (list ,@signature))
  82          ;; define the make-COMMAND-markup procedure in the toplevel module
  83          (define-public-toplevel (,make-markup-name . args)
  84            (make-markup command-proc
  85                         ,(symbol->string make-markup-name)
  86                         (list ,@signature)
  87                         args))))))
  88
  89 #(defmacro-public define-markup-list-command (command-and-args signature . body)
  90   "Same as `define-markup-command', but defines a command that, when interpreted,
  91 returns a list of stencils, instead of a single one."
  92   (let* ((command (if (pair? command-and-args)
  93                       (car command-and-args)
  94                       command-and-args))
  95          (command-name (string->symbol (format #f "~a-markup-list" command)))
  96          (make-markup-name (string->symbol (format #f "make-~a-markup-list" command))))
  97     `(begin
  98        ;; define the COMMAND-markup-list procedure in toplevel module
  99        ,(if (pair? command-and-args)
 100             ;; 1/ (define (COMMAND-markup-list layout props arg1 arg2 ...)
 101             ;;      ..command body))
 102             `(define-public-toplevel (,command-name ,@(cdr command-and-args))
 103                ,@body)
 104             ;; 2/ (define (COMMAND-markup-list . args) (apply function args))
 105             (let ((args (gensym "args"))
 106                   (command (car body)))
 107             `(define-public-toplevel (,command-name . ,args)
 108                (apply ,command ,args))))
 109        (let ((command-proc (toplevel-module-ref ',command-name)))
 110          ;; register its command signature
 111          (set! (markup-command-signature command-proc)
 112                (list ,@signature))
 113          ;; it's a markup-list command:
 114          (set-object-property! command-proc 'markup-list-command #t)
 115          ;; define the make-COMMAND-markup-list procedure in the toplevel module
 116          (define-public-toplevel (,make-markup-name . args)
 117            (list (make-markup command-proc
 118                               ,(symbol->string make-markup-name)
 119                               (list ,@signature)
 120                               args)))))))