;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2003--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
(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))
((not (null? (cdr prop-spec)))
`(list ',(car prop-spec) ,(cadr prop-spec)))
(else
- `(list ',(car prop-spec)))))
+ `(list ',(car prop-spec)))))
(if (pair? args)
properties
(list)))))
(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))
((not (null? (cdr prop-spec)))
`(list ',(car prop-spec) ,(cadr prop-spec)))
(else
- `(list ',(car prop-spec)))))
+ `(list ',(car prop-spec)))))
(if (pair? args)
properties
(list)))))
;;;;;;;;;;;;;;;;;;;;;;
;;; markup type predicates
-(define (markup-function? x)
+(define-public (markup-function? x)
(and (markup-command-signature x)
(not (object-property x 'markup-list-command))))
-(define (markup-list-function? x)
+(define-public (markup-list-function? x)
(and (markup-command-signature x)
(object-property x 'markup-list-command)))
(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)))
(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"
(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))