From 407b739489c7c4a52a9613453db688a2c62ab53d Mon Sep 17 00:00:00 2001
From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Tue, 4 May 2004 22:33:03 +0000
Subject: [PATCH] (Generic_prefix_music): allow generic music-transformation
 functions.

---
 ChangeLog      |  9 +++++++++
 lily/lexer.ll  | 41 +++++++++++++++++++++++++++++++++++++++--
 lily/parser.yy | 30 +++++++++++++++++++++++++++---
 3 files changed, 75 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 144bd54668..d51100910f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-05-05  Han-Wen Nienhuys   <hanwen@xs4all.nl>
+
+	* lily/parser.yy (Generic_prefix_music): allow generic
+	music-transformation functions.	
+
+	* lily/include/music-head.hh (is_music_head): new file.
+
+	* lily/music-head.cc (get_music_head_transform): new file.
+
 2004-05-04  Han-Wen Nienhuys   <hanwen@xs4all.nl>
 
 	* lily/ottava-bracket.cc (print): use coordinate, not (0,0) for
diff --git a/lily/lexer.ll b/lily/lexer.ll
index b7e810e90a..fa31de9c41 100644
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -32,7 +32,7 @@
 
 #include <iostream>
 using namespace std;
-
+#include "music-head.hh"
 #include "source-file.hh"
 #include "parse-scm.hh"
 #include "lily-guile.hh"
@@ -57,7 +57,7 @@ RH 7 fix (?)
 void strip_trailing_white (String&);
 void strip_leading_white (String&);
 String lyric_fudge (String s);
-
+int music_head_type (SCM);
 SCM lookup_markup_command (String s);
 bool is_valid_version (String s);
 
@@ -699,6 +699,12 @@ My_lily_lexer::scan_escaped_word (String str)
 		return l;
 	}
 	SCM sid = lookup_identifier (str);
+	if (is_music_head (sid))
+	{
+		yylval.scm = get_music_head_transform (sid); 
+		return music_head_type (yylval.scm);
+	}
+
 	if (sid != SCM_UNDEFINED)
 	{
 		yylval.scm = sid;
@@ -880,3 +886,34 @@ lookup_markup_command (String s)
 	SCM proc = ly_scheme_function ("lookup-markup-command");
 	return scm_call_1 (proc, scm_makfrom0str (s.to_str0 ()));
 }
+
+
+int
+music_head_type (SCM func)
+{
+	SCM type= scm_object_property (func, ly_symbol2scm ("music-head-signature"));
+	if (type == ly_symbol2scm ("scm"))
+	{
+		return MUSIC_HEAD_SCM;
+	}
+	else if (type == ly_symbol2scm ("music"))
+	{
+		return MUSIC_HEAD_MUSIC;
+	}
+	else if (type == ly_symbol2scm ("scm-music"))
+	{
+		return MUSIC_HEAD_SCM_MUSIC;
+	}
+	else if (type == ly_symbol2scm ("scm-music-music"))
+	{
+		return MUSIC_HEAD_SCM_MUSIC_MUSIC;
+	}
+	else if (type == ly_symbol2scm ("scm-scm-music"))
+	{
+		return MUSIC_HEAD_SCM_SCM_MUSIC;
+	}
+	else
+		assert (false);
+
+	return MUSIC_HEAD_SCM_MUSIC_MUSIC;
+}
diff --git a/lily/parser.yy b/lily/parser.yy
index 9bb3c89627..4b1868ceab 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -359,6 +359,13 @@ or
 %token <scm> MARKUP_HEAD_SCM0_SCM1_SCM2
 %token <scm> MARKUP_HEAD_SCM0_SCM1_MARKUP2
 
+%token <scm> MUSIC_HEAD_SCM 
+%token <scm> MUSIC_HEAD_MUSIC 
+%token <scm> MUSIC_HEAD_SCM_MUSIC 
+%token <scm> MUSIC_HEAD_MUSIC_MUSIC 
+%token <scm> MUSIC_HEAD_SCM_SCM_MUSIC 
+%token <scm> MUSIC_HEAD_SCM_MUSIC_MUSIC 
+
 %token <scm> MARKUP_IDENTIFIER MARKUP_HEAD_LIST0
 %type <scm> markup markup_line markup_list  markup_list_body full_markup
 
@@ -377,7 +384,7 @@ or
 %type <i>	sub_quotes sup_quotes
 %type <music>	toplevel_music
 %type <music>	simple_element event_chord command_element
-%type <music>	Composite_music Simple_music Prefix_composite_music
+%type <music>	Composite_music Simple_music Prefix_composite_music Generic_prefix_music
 %type <music>	Grouped_music_list
 %type <music>	Repeated_music
 %type <scm>     Alternative_music
@@ -945,9 +952,26 @@ Grouped_music_list:
 	Simultaneous_music		{ $$ = $1; }
 	| Sequential_music		{ $$ = $1; }
 	;
-	
+
+Generic_prefix_music:
+	MUSIC_HEAD_SCM { THIS->push_spot (); } embedded_scm {
+		SCM m = scm_call_2 ($1, make_input (THIS->pop_spot ()),
+			$3);
+		if (unsmob_music (m))
+			$$ = unsmob_music (m);
+		else
+		{
+			THIS->parser_error ("MUSIC_HEAD should return Music");
+			$$ = MY_MAKE_MUSIC("Music");
+		}
+	}
+	;
+
 Prefix_composite_music:
-	AUTOCHANGE Music	{
+	Generic_prefix_music {
+		$$ = $1;
+	}
+	|AUTOCHANGE Music	{
 		SCM proc = ly_scheme_function ("make-autochange-music");
 	
 		SCM res = scm_call_1 (proc, $2->self_scm ());
-- 
2.39.5