ly/markup-init.ly

   1 %% -*- Mode: Scheme -*-
   2
   3 %%;; to be define later, in a closure
   4 #(define-public toplevel-module-define-public! #f)
   5 #(define-public toplevel-module-ref #f)
   6 #(let ((toplevel-module (current-module)))
   7    (set! toplevel-module-define-public!
   8          (lambda (symbol value)
   9            (module-define! toplevel-module symbol value)
  10            (module-export! toplevel-module (list symbol))))
  11    (set! toplevel-module-ref
  12          (lambda (symbol)
  13            (module-ref toplevel-module symbol))))
  14
  15 #(defmacro-public define-public-toplevel
  16    (first-arg . rest)
  17   "Define a public variable or function in the toplevel module:
  18   (define-public-toplevel variable-name value)
  19 or:
  20   (define-public-toplevel (function-name . args)
  21     ..body..)"
  22   (if (symbol? first-arg)
  23       ;; (define-public-toplevel symbol value)
  24       (let ((symbol first-arg)
  25             (value (car rest)))
  26         `(toplevel-module-define-public! ',symbol ,value))
  27       ;; (define-public-toplevel (function-name . args) . body)
  28       (let ((function-name (car first-arg))
  29             (arg-list (cdr first-arg))
  30             (body rest))
  31         `(toplevel-module-define-public!
  32           ',function-name
  33           (let ((proc (lambda ,arg-list
  34                         ,@body)))
  35             (set-procedure-property! proc
  36                                      'name
  37                                      ',function-name)
  38             proc)))))
  39
  40 #(defmacro-public define-markup-command (command-and-args signature . body)
  41   "
  42 * Define a COMMAND-markup function after command-and-args and body,
  43 register COMMAND-markup and its signature,
  44
  45 * add COMMAND-markup to markup-function-list,
  46
  47 * sets COMMAND-markup markup-signature and markup-keyword object properties,
  48
  49 * define a make-COMMAND-markup function.
  50
  51 Syntax:
  52   (define-markup-command (COMMAND layout props arg1 arg2 ...)
  53                          (arg1-type? arg2-type? ...)
  54     \"documentation string\"
  55     ...command body...)
  56 or:
  57   (define-markup-command COMMAND (arg1-type? arg2-type? ...) function)
  58 "
  59   (let* ((command (if (pair? command-and-args)
  60                       (car command-and-args)
  61                       command-and-args))
  62          (command-name (string->symbol (format #f "~a-markup" command)))
  63          (make-markup-name (string->symbol (format #f "make-~a-markup" command))))
  64     `(begin
  65        ;; define the COMMAND-markup procedure in toplevel module
  66        ,(if (pair? command-and-args)
  67             ;; 1/ (define (COMMAND-markup layout props arg1 arg2 ...)
  68             ;;      ..command body))
  69             `(define-public-toplevel (,command-name ,@(cdr command-and-args))
  70                ,@body)
  71             ;; 2/ (define (COMMAND-markup . args) (apply function args))
  72             (let ((args (gensym "args"))
  73                   (command (car body)))
  74             `(define-public-toplevel (,command-name . ,args)
  75                (apply ,command ,args))))
  76        (let ((command-proc (toplevel-module-ref ',command-name)))
  77          ;; register its command signature
  78          (set! (markup-command-signature command-proc)
  79                (list ,@signature))
  80          ;; define the make-COMMAND-markup procedure in the toplevel module
  81          (define-public-toplevel (,make-markup-name . args)
  82            (make-markup command-proc
  83                         ,(symbol->string make-markup-name)
  84                         (list ,@signature)
  85                         args))))))