1 %% -*- Mode: Scheme -*-
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!
9 (module-define! toplevel-module symbol value)
10 (module-export! toplevel-module (list symbol))))
11 (set! toplevel-module-ref
13 (module-ref toplevel-module symbol))))
15 #(defmacro-public define-public-toplevel
17 "Define a public variable or function in the toplevel module:
18 (define-public-toplevel variable-name value)
20 (define-public-toplevel (function-name . args)
22 (if (symbol? first-arg)
23 ;; (define-public-toplevel symbol value)
24 (let ((symbol first-arg)
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))
31 `(toplevel-module-define-public!
33 (let ((proc (lambda ,arg-list
35 (set-procedure-property! proc
40 #(defmacro-public define-markup-command (command-and-args signature . body)
42 * Define a COMMAND-markup function after command-and-args and body,
43 register COMMAND-markup and its signature,
45 * add COMMAND-markup to markup-function-list,
47 * sets COMMAND-markup markup-signature and markup-keyword object properties,
49 * define a make-COMMAND-markup function.
52 (define-markup-command (COMMAND layout props arg1 arg2 ...)
53 (arg1-type? arg2-type? ...)
54 \"documentation string\"
57 (define-markup-command COMMAND (arg1-type? arg2-type? ...) function)
59 (let* ((command (if (pair? command-and-args)
60 (car 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))))
65 ;; define the COMMAND-markup procedure in toplevel module
66 ,(if (pair? command-and-args)
67 ;; 1/ (define (COMMAND-markup layout props arg1 arg2 ...)
69 `(define-public-toplevel (,command-name ,@(cdr command-and-args))
71 ;; 2/ (define (COMMAND-markup . args) (apply function args))
72 (let ((args (gensym "args"))
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)
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)