From 5aac8e8d8e2b1fc490354cba2cdecd204e9d5006 Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Wed, 21 Sep 2011 21:05:10 +0200
Subject: [PATCH] Implement define-event-function

---
 lily/lexer.ll           |  2 ++
 lily/parser.yy          | 10 ++++++++++
 scm/music-functions.scm | 22 ++++++++++++++++++++++
 3 files changed, 34 insertions(+)

diff --git a/lily/lexer.ll b/lily/lexer.ll
index 707f84bd83..6b19c8f67d 100644
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -817,6 +817,8 @@ Lily_lexer::scan_escaped_word (string str)
 
 		if (scm_is_eq (cs, ly_lily_module_constant ("ly:music?")))
 			funtype = MUSIC_FUNCTION;
+		else if (scm_is_eq (cs, ly_lily_module_constant ("ly:event?")))
+			funtype = EVENT_FUNCTION;
 		else if (ly_is_procedure (cs))
 			funtype = SCM_FUNCTION;
 		else programming_error ("Bad syntax function predicate");
diff --git a/lily/parser.yy b/lily/parser.yy
index 0eefc1f40e..21f467746e 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -286,6 +286,7 @@ If we give names, Bison complains.
 %token <scm> PITCH_IDENTIFIER
 %token <scm> DURATION_IDENTIFIER
 %token <scm> EVENT_IDENTIFIER
+%token <scm> EVENT_FUNCTION
 %token <scm> FRACTION
 %token <scm> LYRICS_STRING
 %token <scm> LYRIC_MARKUP_IDENTIFIER
@@ -393,6 +394,7 @@ If we give names, Bison complains.
 %type <scm> embedded_scm_closed
 %type <scm> embedded_scm_chord_body
 %type <scm> embedded_scm_event
+%type <scm> event_function_event
 %type <scm> figure_list
 %type <scm> figure_spec
 %type <scm> fraction
@@ -1680,6 +1682,13 @@ music_function_event:
 	}
 	;
 
+event_function_event:
+	EVENT_FUNCTION music_function_event_arglist {
+		$$ = run_music_function (PARSER, @$,
+					 $1, $2);
+	}
+	;
+
 command_element:
 	command_event {
 		$$ = $1;
@@ -1879,6 +1888,7 @@ direction_less_event:
                a->set_property ("tremolo-type", scm_from_int ($1));
                $$ = a->unprotect ();
         }
+	| event_function_event	
 	;
 
 direction_reqd_event:
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index feb11143b1..de6ec015da 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -880,6 +880,28 @@ parameter."
 
   `(define-syntax-function scheme? ,@rest))
 
+(defmacro-public define-event-function rest
+  "Defining macro returning event functions.
+Syntax:
+  (define-event-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+Must return an event expression.  The @code{origin} is automatically
+set to the @code{location} parameter."
+
+  `(define-syntax-function (ly:event? (make-music 'Event 'void #t)) ,@rest))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-- 
2.39.5