X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fparser.yy;h=43670458d2352ca6bae52b3aa5e07dae4706b263;hb=3d04206a83222e89d99ddf1a0766b6b74f158967;hp=8c910598eb90481349e6e172c55f66b9b8e72ec7;hpb=c7268da1b688b47e3a7f2ac926e5ce3d79e05dbb;p=lilypond.git diff --git a/lily/parser.yy b/lily/parser.yy index 8c910598eb..43670458d2 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -54,7 +54,8 @@ TODO: Music *property_op_to_music (SCM op); Music *context_spec_music (SCM type, SCM id, Music *m, SCM ops); -SCM get_next_unique_context (); +SCM get_next_unique_context_id (); +SCM get_next_unique_lyrics_context_id (); #define YYERROR_VERBOSE 1 @@ -100,6 +101,20 @@ is_regular_identifier (SCM id) return v; } + +SCM +get_first_context_id (SCM type, Music *m) +{ + SCM id = m->get_property ("context-id"); + if (SCM_BOOL_T == scm_equal_p (m->get_property ("context-type"), type) + && scm_is_string (m->get_property ("context-id")) + && scm_c_string_length (id) > 0) + { + return id; + } + return SCM_EOL; +} + SCM make_simple_markup (SCM encoding, SCM a) { @@ -285,6 +300,7 @@ or %token NAME %token NEWCONTEXT %token NOTEMODE +%token OBJECTID %token OCTAVE %token ONCE %token OVERRIDE SET REVERT @@ -428,9 +444,10 @@ or %type Generic_prefix_music_scm %type lyric_element %type Alternative_music -%type markup markup_line markup_list markup_list_body full_markup +%type full_markup markup_composed_list markup_braced_list markup_braced_list_body markup_head_1_item markup_head_1_list markup simple_markup markup_top %type mode_changing_head %type mode_changing_head_with_context +%type object_id_setting %type score_block score_body @@ -457,6 +474,11 @@ lilypond: /* empty */ } ; + +object_id_setting: + OBJECTID STRING { $$ = $2; } + ; + toplevel_expression: lilypond_header { THIS->lexer_->set_identifier (ly_symbol2scm ("$globalheader"), $1); @@ -658,8 +680,7 @@ book_body: } | book_body score_block { Score *score = $2; - $$->scores_.push (score); - scm_gc_unprotect_object (score->self_scm ()); + $$->add_score (score); } | book_body lilypond_header { $$->header_ = $2; @@ -668,6 +689,9 @@ book_body: $$->paper_ = 0; $$->scores_.clear(); } + | book_body object_id_setting { + $$->user_key_ = ly_scm2string ($2); + } ; score_block: @@ -690,6 +714,9 @@ score_body: $$ = new Score ( *unsmob_score ($1)); $$->set_spot (THIS->here_input ()); } + | score_body object_id_setting { + $$->user_key_ = ly_scm2string ($2); + } | score_body Music { SCM m = $2->self_scm (); scm_gc_unprotect_object (m); @@ -1016,6 +1043,11 @@ Generic_prefix_music_scm: } embedded_scm embedded_scm { $$ = scm_list_4 ($1, make_input (THIS->pop_spot ()), $3, $4); } + | MUSIC_FUNCTION_SCM_SCM_MUSIC { + THIS->push_spot (); + } embedded_scm embedded_scm Music { + $$ = scm_list_5 ($1, make_input (THIS->pop_spot ()), $3, $4, $5->self_scm ()); + } | MUSIC_FUNCTION_MARKUP_MUSIC { THIS->push_spot (); } full_markup Music { @@ -1058,28 +1090,27 @@ Generic_prefix_music: Input *loc = unsmob_input (scm_cadr ($1)); SCM args = scm_cddr ($1); SCM sig = scm_object_property (func, ly_symbol2scm ("music-function-signature")); - int k = 0; - bool ok = true; - for (SCM s = sig, t = args; - ok && scm_is_pair (s) && scm_is_pair (t); - s = scm_cdr (s), t = scm_cdr (t)) { - k++; - if (scm_call_1 (scm_car (s), scm_car (t)) != SCM_BOOL_T) - { - loc->error (_f ("Argument %d failed typecheck", k)); - THIS->error_level_ = 1; - ok = false; - } + + SCM type_check_proc = ly_scheme_function ("type-check-list"); + bool ok = true; + + if (!to_boolean (scm_call_3 (type_check_proc, scm_cadr ($1), sig, args))) + { + THIS->error_level_ = 1; + ok = false; } + SCM m = SCM_EOL; - if (ok) - m = scm_apply_0 (func, scm_cdr ($1)); + if (ok) + m = scm_apply_0 (func, scm_cons (THIS->self_scm(), + scm_cdr ($1))); + if (unsmob_music (m)) { $$ = unsmob_music (m); scm_gc_protect_object (m); } - else + else { if (ok) loc->error (_ ("Music head function should return Music object.")); @@ -1102,7 +1133,7 @@ Prefix_composite_music: $$ = context_spec_music ($2, SCM_UNDEFINED, $4, $3); } | NEWCONTEXT simple_string optional_context_mod Music { - $$ = context_spec_music ($2, get_next_unique_context (), $4, + $$ = context_spec_music ($2, get_next_unique_context_id (), $4, $3); } @@ -1138,9 +1169,9 @@ Prefix_composite_music: scm_gc_unprotect_object (p->self_scm ()); } | mode_changing_head Grouped_music_list { - if ($1 == ly_symbol2scm ("figures")) + if ($1 == ly_symbol2scm ("chords")) { - Music *chm = MY_MAKE_MUSIC ("UntransposableMusic"); + Music *chm = MY_MAKE_MUSIC ("UnrelativableMusic"); chm->set_property ("element", $2->self_scm ()); $$ = chm; scm_gc_unprotect_object ($2->self_scm ()); @@ -1152,11 +1183,11 @@ Prefix_composite_music: THIS->lexer_->pop_state (); } | mode_changing_head_with_context optional_context_mod Grouped_music_list { - $$ = context_spec_music ($1, get_next_unique_context (), + $$ = context_spec_music ($1, get_next_unique_context_id (), $3, $2); - if ($1 == ly_symbol2scm ("FiguredBass")) + if ($1 == ly_symbol2scm ("ChordNames")) { - Music *chm = MY_MAKE_MUSIC ("UntransposableMusic"); + Music *chm = MY_MAKE_MUSIC ("UnrelativableMusic"); chm->set_property ("element", $$->self_scm ()); scm_gc_unprotect_object ($$->self_scm ()); $$ = chm; @@ -1266,11 +1297,15 @@ new_lyrics: re_rhythmed_music: Grouped_music_list new_lyrics { - - SCM name = $1->get_property ("context-id"); - //if (name == SCM_EOL) + Music * voice = $1; + SCM name = get_first_context_id (scm_makfrom0str ("Voice"), voice); if (!scm_is_string (name)) - name = scm_makfrom0str (""); + { + name = get_next_unique_lyrics_context_id (); + voice = context_spec_music (scm_makfrom0str ("Voice"), + name, + voice, SCM_EOL); + } SCM context = scm_makfrom0str ("Lyrics"); Music *all = MY_MAKE_MUSIC ("SimultaneousMusic"); @@ -1281,15 +1316,13 @@ re_rhythmed_music: Music *music = unsmob_music (scm_car (s)); Music *com = make_lyric_combine_music (name, music); Music *csm = context_spec_music (context, - get_next_unique_context (), com, SCM_EOL); + get_next_unique_context_id (), com, SCM_EOL); lst = scm_cons (csm->self_scm (), lst); } - /* FIXME: only first lyric music is accepted, - the rest is junked */ - all->set_property ("elements", scm_cons ($1->self_scm (), + all->set_property ("elements", scm_cons (voice->self_scm (), lst)); $$ = all; - scm_gc_unprotect_object ($1->self_scm ()); + scm_gc_unprotect_object (voice->self_scm ()); } | LYRICSTO { THIS->lexer_->push_lyric_state (); @@ -1595,14 +1628,6 @@ command_element: $$ = skip; } - | QUOTE STRING duration_length { - Music *quote = MY_MAKE_MUSIC ("QuoteMusic"); - quote->set_property ("duration", $3); - quote->set_property ("quoted-music-name", $2); - quote->set_spot (THIS->here_input ()); - - $$ = quote; - } | OCTAVE { THIS->push_spot (); } pitch { Music *m = MY_MAKE_MUSIC ("RelativeOctaveCheck"); @@ -1717,7 +1742,7 @@ command_req: { key->set_property ("pitch-alist", $3); key->set_property ("tonic", Pitch (0,0,0).smobbed_copy ()); - ((Music*)key)->transpose (* unsmob_pitch ($2)); + key->transpose (* unsmob_pitch ($2)); } else { THIS->parser_error (_ ("Second argument must be pitch list.")); } @@ -2438,58 +2463,85 @@ questions: | questions '?' { $$ ++; } ; - +/* +This should be done more dynamically if possible. +*/ full_markup: MARKUP_IDENTIFIER { $$ = $1; - } + } | MARKUP { THIS->lexer_->push_markup_state (); } - markup - { $$ = $3; - THIS->lexer_->pop_state (); - } + markup_top { + $$ = $3; + THIS->lexer_->pop_state (); + } ; - -/* -This should be done more dynamically if possible. -*/ -markup: - STRING { - $$ = make_simple_markup (THIS->lexer_->encoding (), $1); +markup_top: + markup_composed_list { + $$ = scm_list_2 (ly_scheme_function ("line-markup"), $1); } - | MARKUP_HEAD_EMPTY { - $$ = scm_list_1 ($1); + | markup_head_1_list simple_markup { + $$ = scm_car (scm_call_2 (ly_scheme_function ("map-markup-command-list"), $1, scm_list_1 ($2))); } - | MARKUP_HEAD_MARKUP0 markup { - $$ = scm_list_2 ($1, $2); + | simple_markup { + $$ = $1; } - | MARKUP_HEAD_MARKUP0_MARKUP1 markup markup { - $$ = scm_list_3 ($1, $2, $3); + | markup_braced_list { + $$ = scm_list_2 (ly_scheme_function ("line-markup"), $1); } - | MARKUP_HEAD_SCM0_MARKUP1 SCM_T markup { - $$ = scm_list_3 ($1, $2, $3); + ; + +markup_composed_list: + markup_head_1_list markup_braced_list { + $$ = scm_call_2 (ly_scheme_function ("map-markup-command-list"), $1, $2); + } - | markup_line { - $$ = $1; + ; + +markup_braced_list: + '{' markup_braced_list_body '}' { + $$ = scm_reverse_x ($2, SCM_EOL); } - | MARKUP_HEAD_LIST0 markup_list { - $$ = scm_list_2 ($1,$2); + ; + +markup_braced_list_body: + /* empty */ { $$ = scm_list (SCM_EOL); } + | markup_braced_list_body markup { + $$ = scm_cons ($2, $1); } - | MARKUP_HEAD_SCM0 embedded_scm { - $$ = scm_list_2 ($1, $2); + | markup_braced_list_body markup_composed_list { + $$ = scm_append_x (scm_list_2 (scm_reverse_x ($2, SCM_EOL), $1)); } - | MARKUP_HEAD_SCM0_SCM1_MARKUP2 embedded_scm embedded_scm markup { - $$ = scm_list_4 ($1, $2, $3, $4); + ; + +markup_head_1_item: + MARKUP_HEAD_MARKUP0 { + $$ = scm_list_1 ($1); } - | MARKUP_HEAD_SCM0_SCM1_SCM2 embedded_scm embedded_scm embedded_scm { - $$ = scm_list_4 ($1, $2, $3, $4); + | MARKUP_HEAD_SCM0_MARKUP1 embedded_scm { + $$ = scm_list_2 ($1, $2); } - | MARKUP_HEAD_SCM0_SCM1 embedded_scm embedded_scm { + | MARKUP_HEAD_SCM0_SCM1_MARKUP2 embedded_scm embedded_scm { $$ = scm_list_3 ($1, $2, $3); } + ; + +markup_head_1_list: + markup_head_1_item { + $$ = scm_list_1 ($1); + } + | markup_head_1_list markup_head_1_item { + $$ = scm_cons ($2, $1); + } + ; + +simple_markup: + STRING { + $$ = make_simple_markup (THIS->lexer_->encoding (), $1); + } | MARKUP_IDENTIFIER { $$ = $1; } @@ -2505,28 +2557,38 @@ markup: scm_gc_unprotect_object (sc->self_scm ()); THIS->lexer_->pop_state (); } + | MARKUP_HEAD_SCM0 embedded_scm { + $$ = scm_list_2 ($1, $2); + } + | MARKUP_HEAD_SCM0_SCM1_SCM2 embedded_scm embedded_scm embedded_scm { + $$ = scm_list_4 ($1, $2, $3, $4); + } + | MARKUP_HEAD_SCM0_SCM1 embedded_scm embedded_scm { + $$ = scm_list_3 ($1, $2, $3); + } + | MARKUP_HEAD_EMPTY { + $$ = scm_list_1 ($1); + } + | MARKUP_HEAD_LIST0 markup_braced_list { + $$ = scm_list_2 ($1,$2); + } + | MARKUP_HEAD_MARKUP0_MARKUP1 markup markup { + $$ = scm_list_3 ($1, $2, $3); + } ; - -markup_list: - chord_open markup_list_body chord_close { $$ = scm_reverse_x ($2, SCM_EOL); } - ; - -markup_line: - '{' markup_list_body '}' { - SCM line = ly_scheme_function ("line-markup"); - $$ = scm_list_2 (line, scm_reverse_x ($2, SCM_EOL)); +markup: + markup_head_1_list simple_markup { + $$ = scm_car (scm_call_2 (ly_scheme_function ("map-markup-command-list"), $1, scm_list_1 ($2))); } - ; - -markup_list_body: - /**/ { $$ = SCM_EOL; } - | markup_list_body markup { - $$ = scm_cons ($2, $1); + | simple_markup { + $$ = $1; + } + | markup_braced_list { + $$ = scm_list_2 (ly_scheme_function ("line-markup"), $1); } ; - %% void @@ -2690,15 +2752,18 @@ context_spec_music (SCM type, SCM id, Music *m, SCM ops) return csm; } -/* -FIXME: this should be postponed until the music hits \Score -*/ SCM -get_next_unique_context () +get_next_unique_context_id () +{ + return scm_makfrom0str ("$uniqueContextId"); +} + + +SCM +get_next_unique_lyrics_context_id () { static int new_context_count; - char s[1024]; + char s[128]; snprintf (s, 1024, "uniqueContext%d", new_context_count++); return scm_makfrom0str (s); } -