X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmarkup-macros.scm;h=a55e8c45e90621ed6e211a135cf423d9ccdf2012;hb=8659a99f233f5c4684292728e7ad4206669b35b0;hp=cccfaccfcba554c5f6f4d207ffd69bc0ec7a70a1;hpb=f875ef39c544bd3499dae5360e9e24f69933575f;p=lilypond.git diff --git a/scm/markup-macros.scm b/scm/markup-macros.scm index cccfaccfcb..a55e8c45e9 100644 --- a/scm/markup-macros.scm +++ b/scm/markup-macros.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2003--2010 Han-Wen Nienhuys +;;;; Copyright (C) 2003--2015 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -47,12 +47,10 @@ The command is now available in markup mode, e.g. ;;; markup definer utilities ;; For documentation purposes -;; category -> markup functions -(define-public markup-functions-by-category (make-hash-table 150)) +;; markup function -> categories +(define-public markup-function-category (make-object-property)) ;; markup function -> used properties -(define-public markup-functions-properties (make-weak-key-hash-table 151)) -;; List of markup list functions -(define-public markup-list-functions (make-weak-key-hash-table 151)) +(define-public markup-function-properties (make-object-property)) (use-modules (ice-9 optargs)) @@ -64,9 +62,9 @@ The command is now available in markup mode, e.g. * Define a COMMAND-markup function after command-and-args and body, register COMMAND-markup and its signature, -* add COMMAND-markup to markup-functions-by-category, +* add categories to markup-function-category, -* sets COMMAND-markup markup-signature object property, +* sets the markup-signature object property, * define a make-COMMAND-markup function. @@ -94,7 +92,7 @@ After `argument-types', you may also specify [ #:category category ] where: `category' is either a symbol or a symbol list specifying the - category for this markup command in the docs. + categories for this markup command in the docs. As an element of the `properties' list, you may directly use a COMMANDx-markup symbol instead of a `(prop value)' list to indicate @@ -110,14 +108,14 @@ command. There is no protection against circular definitions. (set! body (cddr body))) `(begin ;; define the COMMAND-markup function - ,(let* ((documentation (if (string? (car body)) - (list (car body)) - '())) - (real-body (if (or (null? documentation) + ,(let* ((documentation + (format #f "~a\n~a" (cddr args) + (if (string? (car body)) (car body) ""))) + (real-body (if (or (not (string? (car body))) (null? (cdr body))) body (cdr body)))) `(define-public (,command-name ,@args) - ,@documentation + ,documentation (let ,(map (lambda (prop-spec) (let ((prop (car prop-spec)) (default-value (if (null? (cdr prop-spec)) @@ -129,28 +127,17 @@ command. There is no protection against circular definitions. ,@real-body))) (set! (markup-command-signature ,command-name) (list ,@signature)) ;; Register the new function, for markup documentation - ,@(map (lambda (category) - `(hashq-set! - (or (hashq-ref markup-functions-by-category ',category) - (let ((hash (make-weak-key-hash-table 151))) - (hashq-set! markup-functions-by-category ',category - hash) - hash)) - ,command-name #t)) - (if (list? category) category (list category))) + (set! (markup-function-category ,command-name) ',category) ;; Used properties, for markup documentation - (hashq-set! markup-functions-properties - ,command-name - (list ,@(map (lambda (prop-spec) - (cond ((symbol? prop-spec) - prop-spec) - ((not (null? (cdr prop-spec))) - `(list ',(car prop-spec) ,(cadr prop-spec))) - (else - `(list ',(car prop-spec))))) - (if (pair? args) - properties - (list))))) + (set! (markup-function-properties ,command-name) + (list ,@(map (lambda (prop-spec) + (cond ((symbol? prop-spec) + prop-spec) + ((not (null? (cdr prop-spec))) + `(list ',(car prop-spec) ,(cadr prop-spec))) + (else + `(list ',(car prop-spec))))) + properties))) ;; define the make-COMMAND-markup function (define-public (,make-markup-name . args) (let ((sig (list ,@signature))) @@ -168,14 +155,14 @@ interpreted, returns a list of stencils instead of a single one" (set! body (cddr body))) `(begin ;; define the COMMAND-markup-list function - ,(let* ((documentation (if (string? (car body)) - (list (car body)) - '())) - (real-body (if (or (null? documentation) + ,(let* ((documentation + (format #f "~a\n~a" (cddr args) + (if (string? (car body)) (car body) ""))) + (real-body (if (or (not (string? (car body))) (null? (cdr body))) body (cdr body)))) `(define-public (,command-name ,@args) - ,@documentation + ,documentation (let ,(map (lambda (prop-spec) (let ((prop (car prop-spec)) (default-value (if (null? (cdr prop-spec)) @@ -186,23 +173,18 @@ interpreted, returns a list of stencils instead of a single one" (filter pair? properties)) ,@real-body))) (set! (markup-command-signature ,command-name) (list ,@signature)) - ;; add the command to markup-list-function-list, for markup documentation - (hashq-set! markup-list-functions ,command-name #t) ;; Used properties, for markup documentation - (hashq-set! markup-functions-properties - ,command-name - (list ,@(map (lambda (prop-spec) - (cond ((symbol? prop-spec) - prop-spec) - ((not (null? (cdr prop-spec))) - `(list ',(car prop-spec) ,(cadr prop-spec))) - (else - `(list ',(car prop-spec))))) - (if (pair? args) - properties - (list))))) + (set! (markup-function-properties ,command-name) + (list ,@(map (lambda (prop-spec) + (cond ((symbol? prop-spec) + prop-spec) + ((not (null? (cdr prop-spec))) + `(list ',(car prop-spec) ,(cadr prop-spec))) + (else + `(list ',(car prop-spec))))) + properties))) ;; it's a markup-list command: - (set-object-property! ,command-name 'markup-list-command #t) + (set! (markup-list-function? ,command-name) #t) ;; define the make-COMMAND-markup-list function (define-public (,make-markup-name . args) (let ((sig (list ,@signature))) @@ -220,29 +202,16 @@ interpreted, returns a list of stencils instead of a single one" ;;; ==> (# #) ;;; -(define-public (markup-command-signature-ref markup-command) - "Return markup-command's signature (the 'markup-signature object property)" - (object-property markup-command 'markup-signature)) - -(define-public (markup-command-signature-set! markup-command signature) - "Set markup-command's signature (as object property)" - (set-object-property! markup-command 'markup-signature signature) - signature) - -(define-public markup-command-signature - (make-procedure-with-setter markup-command-signature-ref - markup-command-signature-set!)) +(define-public markup-command-signature (make-object-property)) ;;;;;;;;;;;;;;;;;;;;;; ;;; markup type predicates -(define (markup-function? x) +(define-public (markup-function? x) (and (markup-command-signature x) - (not (object-property x 'markup-list-command)))) + (not (markup-list-function? x)))) -(define (markup-list-function? x) - (and (markup-command-signature x) - (object-property x 'markup-list-command))) +(define-public markup-list-function? (make-object-property)) (define-public (markup-command-list? x) "Determine if `x' is a markup command list, ie. a list composed of @@ -344,11 +313,6 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function. (use-modules (ice-9 receive)) -(defmacro*-public markup* (#:rest body) - "Same as `markup', for use in a \\notes block." - `(ly:export (markup ,@body))) - - (define (compile-all-markup-expressions expr) "Return a list of canonical markups expressions, e.g.: (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23) @@ -389,10 +353,10 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function. (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args)) (set! rest (cdr rest))) (else - ;; pick up one arg in `rest' - (receive (a r) (compile-markup-arg rest) - (set! args (cons a args)) - (set! rest r)))))))) + ;; pick up one arg in `rest' + (receive (a r) (compile-markup-arg rest) + (set! args (cons a args)) + (set! rest r)))))))) ((and (pair? expr) (pair? (car expr)) (keyword? (caar expr))) @@ -403,9 +367,9 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function. (string? (car expr))) ;; expr === ("string" ...) (values `(make-simple-markup ,(car expr)) (cdr expr))) (else - ;; expr === (symbol ...) or ((funcall ...) ...) - (values (car expr) - (cdr expr))))) + ;; expr === (symbol ...) or ((funcall ...) ...) + (values (car expr) + (cdr expr))))) (define (compile-all-markup-args expr) "Transform `expr' into markup arguments" @@ -459,21 +423,3 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function. (string->symbol (format #f "~a-markup-list" code))))) (and proc (markup-list-function? proc) (cons proc (markup-command-signature proc))))) - -;;;;;;;;;;;;;;;;;;;;;; -;;; used in parser.yy to map a list of markup commands on markup arguments -(define-public (map-markup-command-list commands markups) - "`markups' being a list of markups, eg (markup1 markup2 markup3), -and `commands' a list of commands with their scheme arguments, in reverse order, -eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg: - ((bold (raise 4 (italic markup1))) - (bold (raise 4 (italic markup2))) - (bold (raise 4 (italic markup3)))) -" - (map-in-order (lambda (arg) - (let ((result arg)) - (for-each (lambda (cmd) - (set! result (append cmd (list result)))) - commands) - result)) - markups))