X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdisplay-lily.scm;h=9536c3dd42b25b626dd0300b8f7f9a9cf31f80a6;hb=0bb3eb14a16a605ca202dacbf657bdbe5dc94ebf;hp=e85159059df198020dba621b003d713de156040f;hpb=7f3f0083f89d87c5ed0422858e9648fc759e98a4;p=lilypond.git diff --git a/scm/display-lily.scm b/scm/display-lily.scm index e85159059d..9536c3dd42 100644 --- a/scm/display-lily.scm +++ b/scm/display-lily.scm @@ -2,7 +2,7 @@ ;;; ;;; ;;; -;;; (c) 2005--2008 Nicolas Sceaux +;;; Copyright (C) 2005--2012 Nicolas Sceaux ;;; ;;; - This file defines the procedures used to define display methods for each @@ -28,9 +28,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-13) #:use-module (srfi srfi-39) - #:use-module (lily) - #:use-syntax (srfi srfi-39) - #:use-syntax (ice-9 optargs)) + #:use-module (lily)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -41,7 +39,7 @@ (define-macro (define-display-method music-type vars . body) "Define a display method for a music type and store it in the `display-methods' property of the music type entry found in the -`music-name-to-property-table' hash table. Print methods previously +`music-name-to-property-table' hash table. Print methods previously defined for that music type are lost. Syntax: (define-display-method MusicType (expression parser) ...body...))" @@ -57,9 +55,9 @@ Syntax: (define-display-method MusicType (expression parser) method)) (define-macro (define-extra-display-method music-type vars . body) - "Add a display method for a music type. A primary display method + "Add a display method for a music type. A primary display method is supposed to have been previously defined with `define-display-method'. -This new method should return a string or #f. If #f is returned, the next +This new method should return a string or #f. If #f is returned, the next display method will be called." `(let* ((type-props (hashq-ref music-name-to-property-table ',music-type '())) @@ -81,8 +79,17 @@ display method will be called." (format #f "~a\\tag #'~a" (if post-event? "-" "") tag)) (ly:music-property expr 'tags)))) +(define* (tweaks->lily-string expr #:optional (post-event? #f)) + (format #f "~{~a ~}" + (map (lambda (tweak) + (format #f "~a\\tweak #'~a #~a" + (if post-event? "-" "") + (car tweak) + (scheme-expr->lily-string (cdr tweak)))) + (ly:music-property expr 'tweaks)))) + (define-public (music->lily-string expr parser) - "Print expr, a music expression, in LilyPond syntax" + "Print @var{expr}, a music expression, in LilyPond syntax." (if (ly:music? expr) (let* ((music-type (ly:music-property expr 'name)) (procs (assoc-ref (hashq-ref music-name-to-property-table @@ -92,8 +99,9 @@ display method will be called." (proc expr parser)) procs)))) (if result-string - (format #f "~a~a" - (tag->lily-string expr (post-event? expr)) + (format #f "~a~a~a" + (tag->lily-string expr (post-event? expr)) + (tweaks->lily-string expr (post-event? expr)) result-string) (format #f "%{ Print method not implemented for music type ~a %}" music-type))) @@ -230,7 +238,7 @@ Generate binding forms by looking for ?var symbol in pattern." elements-list)))) (define-macro (with-music-match music-expr+pattern . body) - "If `music-expr' matches `pattern', call `body'. `pattern' should look like: + "If `music-expr' matches `pattern', call `body'. `pattern' should look like: '(music property value property ?var1 @@ -243,8 +251,8 @@ pattern (the name property being the symbol after the `music' keyword), then all music expression found in its properties (such as 'element or 'elements). When ?var is found instead of a property value, ?var is bound that property value, -as read inside `music-expr'. ?var may also be used to refere to a whole music -expression inside an elements list for instance. These bindings are accessible +as read inside `music-expr'. ?var may also be used to refere to a whole music +expression inside an elements list for instance. These bindings are accessible inside body." (let ((music-expr (first music-expr+pattern)) (pattern (second music-expr+pattern)) @@ -289,11 +297,14 @@ inside body." ;;; (define (make-music-type-predicate . music-types) - (define ((make-music-type-predicate-aux mtypes) expr) - (if (null? mtypes) - #f - (or (eqv? (car mtypes) (ly:music-property expr 'name)) - ((make-music-type-predicate-aux (cdr mtypes)) expr)))) - (make-music-type-predicate-aux music-types)) - -(load "define-music-display-methods.scm") \ No newline at end of file + (define make-music-type-predicate-aux + (lambda (mtypes) + (lambda (expr) + (if (null? mtypes) + #f + (or (eqv? (car mtypes) (ly:music-property expr 'name)) + ((make-music-type-predicate-aux (cdr mtypes)) expr)))))) + (make-music-type-predicate-aux music-types)) + +(ly:load "define-music-display-methods.scm") +