From c2cf1fe96181541f1b197dbde98f1f2217f97705 Mon Sep 17 00:00:00 2001 From: hanwen Date: Wed, 11 Feb 2004 00:33:26 +0000 Subject: [PATCH] (updated_grob_properties): new function (execute_pushpop_property): change to new convention: object property inits are stored as (cons ALIST BASED-ON). This storage format allows concurrent tweaks in different contexts. --- ChangeLog | 12 + Documentation/user/GNUmakefile | 2 +- Documentation/user/refman.itely | 23 -- GNUmakefile.in | 2 +- TODO | 54 +++++ VERSION | 2 +- input/screech-boink.ly | 96 ++++---- lily/clef-engraver.cc | 4 +- lily/context.cc | 175 ++++++++++++++ lily/engraver.cc | 15 -- lily/include/engraver.hh | 9 +- lily/include/separating-group-spanner.hh | 2 - lily/include/translator-group.hh | 7 +- lily/ligature-engraver.cc | 4 +- lily/new-part-combine-iterator.cc | 6 +- lily/parser.yy | 5 +- lily/property-iterator.cc | 8 +- lily/score-engraver.cc | 11 +- lily/separating-group-spanner.cc | 9 - lily/system-start-delimiter-engraver.cc | 2 +- lily/translator-group.cc | 279 ----------------------- lily/translator-property.cc | 192 ++++++++++++++++ lily/translator-scheme.cc | 2 +- ly/engraver-init.ly | 4 +- ly/property-init.ly | 2 +- 25 files changed, 521 insertions(+), 406 deletions(-) create mode 100644 TODO create mode 100644 lily/context.cc create mode 100644 lily/translator-property.cc diff --git a/ChangeLog b/ChangeLog index 0c15b7971c..205518a553 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2004-02-11 Han-Wen Nienhuys + + * lily/translator-property.cc (updated_grob_properties): new + function + (execute_pushpop_property): change to new convention: + object property inits are stored as (cons ALIST BASED-ON). This + storage format allows concurrent tweaks in different contexts. + +2004-02-10 Han-Wen Nienhuys + + * TODO: new file. + 2004-02-10 Jan Nieuwenhuizen * debian/: Late Debian update (sorry Anthony). diff --git a/Documentation/user/GNUmakefile b/Documentation/user/GNUmakefile index c3c629a029..b471deaf2e 100644 --- a/Documentation/user/GNUmakefile +++ b/Documentation/user/GNUmakefile @@ -120,7 +120,7 @@ local-clean: $(builddir)/mf/$(outconfbase)/feta16list.ly: $(MAKE) -C $(topdir)/mf -$(outdir)/lilypond.texi: $(ITELY_FILES) macros.itexi +$(outdir)/lilypond.texi: $(ITELY_FILES) macros.itexi # Rules for the automatically generated documentation # When cross-compiling, we don't have lilypond, so we fake diff --git a/Documentation/user/refman.itely b/Documentation/user/refman.itely index 6c15848427..b8f2f282d0 100644 --- a/Documentation/user/refman.itely +++ b/Documentation/user/refman.itely @@ -7704,29 +7704,6 @@ Cyclic references in Scheme values for properties cause hangs and/or crashes. Reverting properties that are system defaults may also lead to crashes. -A property tweak of modifies a local copy of the object definition. -After such a tweak, the definition is independent of the objects in -enclosing contexts. For example - -@lilypond[verbatim,fragment] - \property Voice.Stem \set #'direction = #UP - d''4 - \property Staff.Stem \set #'thickness = #4.0 - d''8 - \new Voice { d'32 } -@end lilypond - -In this fragment, @code{direction} is tweaked. As a result, the -current @internalsref{Voice} gets a private version of the -@internalsref{Stem} object. The following tweak modifies the -definition at @internalsref{Staff} level. Since it a different -definition, the thickness of the first @code{d'} is unaffected. For -the third note, a new Voice is created, which inherits the new -definition, including the changed thickness, but excluding the new -neutral direction. - - - @menu * Constructing a tweak:: * Applyoutput:: diff --git a/GNUmakefile.in b/GNUmakefile.in index 41f11fe930..5c7e563e3b 100644 --- a/GNUmakefile.in +++ b/GNUmakefile.in @@ -18,7 +18,7 @@ SUBDIRS = buildscripts python scripts \ # SCRIPTS = configure aclocal.m4 autogen.sh lexer-gcc-3.1.sh -README_FILES = ChangeLog COPYING DEDICATION ROADMAP THANKS +README_FILES = ChangeLog COPYING DEDICATION ROADMAP THANKS TODO README_TXT_FILES = AUTHORS.txt README.txt INSTALL.txt NEWS.txt IN_FILES := $(wildcard *.in) PATCH_FILES = emacsclient.patch server.el.patch darwin.patch diff --git a/TODO b/TODO new file mode 100644 index 0000000000..807c0774c9 --- /dev/null +++ b/TODO @@ -0,0 +1,54 @@ + +This file is our personal scrapbook, listing what we want to do in the +nearby future + + +***************** Website + +* mission.html + +* benchmark Schubert + + +***************** Bugs + +* pc-solo.ly + +* staff-padding / padding. + + +***************** Code + +* \set / \override syntax + +* objpropertry init + +* lyricsvoice -> lyrics. + +***************** Documentation + +* Prune internals documentation. + +* Move Markup doc to docstrings. + +* Sift examples, move into main doc. + +***************** Release 2.2/3.0 + +* upload + +* binaries + +* announce + + News: + + Mail: + + Web: + +* translation project. + +* mutopia submissions + + diff --git a/VERSION b/VERSION index 35298bbb47..0fca4aaab5 100644 --- a/VERSION +++ b/VERSION @@ -2,5 +2,5 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=2 MINOR_VERSION=1 PATCH_LEVEL=20 -MY_PATCH_LEVEL= +MY_PATCH_LEVEL=hwn1 diff --git a/input/screech-boink.ly b/input/screech-boink.ly index 6c42914cf2..253e28a26b 100644 --- a/input/screech-boink.ly +++ b/input/screech-boink.ly @@ -3,59 +3,61 @@ title = "Screech and boink" subtitle = "Random complex notation" composer = "Han-Wen Nienhuys" - } +} \score { -\notes \context PianoStaff << - \context Staff = up { - \time 4/8 - \key c \minor + \notes \context PianoStaff << + \context Staff = up { + \time 4/8 + \key c \minor -<< { \property Voice.Stem \override #'direction = #'() \change Staff = down - \property Voice.subdivideBeams = ##t - g16.[ - \change Staff = up - c'''32 \change Staff = down - g32 \change Staff = up - c'''32 \change Staff = down - g16] - \change Staff = up - \property Voice.Stem \revert #'direction - \property Voice.followVoice = ##t - c'''32([ b''16 a''16 gis''16 g''32)] } \\ - { s4 \times 2/3 { d'16[ f' g'] } as'32[ b''32 e'' d''] } \\ - { s4 \autoBeamOff d''8.. f''32 } \\ - { s4 es''4 } - >> - } + << { + \property Voice.Stem \revert #'direction + \change Staff = down + \property Voice.subdivideBeams = ##t + g16.[ + \change Staff = up + c'''32 \change Staff = down + g32 \change Staff = up + c'''32 \change Staff = down + g16] + \change Staff = up + \property Voice.Stem \set #'direction = #1 + \property Voice.followVoice = ##t + c'''32([ b''16 a''16 gis''16 g''32)] } \\ + { s4 \times 2/3 { d'16[ f' g'] } as'32[ b''32 e'' d''] } \\ + { s4 \autoBeamOff d''8.. f''32 } \\ + { s4 es''4 } + >> + } - \context Staff = down { - \clef bass - \key c \minor - \property Voice.subdivideBeams = ##f - \property Voice.Stem \set #'french-beaming = ##t -\property Voice.Beam \set #'thickness = #0.3 -\property Voice.Stem \set #'thickness = #4.0 - g'16[ b16 fis16 g16] -<< \apply #notes-to-clusters { - as16 - - - } \\ - { -\property Staff.Arpeggio \set #'arpeggio-direction =#-1 -4\arpeggio } - >> - } ->> + \context Staff = down { + \clef bass + \key c \minor + \property Voice.subdivideBeams = ##f + \property Voice.Stem \set #'french-beaming = ##t + \property Voice.Beam \set #'thickness = #0.3 + \property Voice.Stem \set #'thickness = #4.0 + g'16[ b16 fis16 g16] + << \apply #notes-to-clusters { + as16 + + + } \\ + { + \property Staff.Arpeggio \set #'arpeggio-direction =#-1 + 4\arpeggio } + >> + } + >> -\paper { linewidth = -1.0 + \paper { linewidth = -1.0 - \translator { - \StaffContext - \consists Horizontal_bracket_engraver } + \translator { + \StaffContext + \consists Horizontal_bracket_engraver } -} -\midi { \tempo 8 = 60 } + } + \midi { \tempo 8 = 60 } } diff --git a/lily/clef-engraver.cc b/lily/clef-engraver.cc index dffa01431b..76c814444f 100644 --- a/lily/clef-engraver.cc +++ b/lily/clef-engraver.cc @@ -61,8 +61,8 @@ Clef_engraver::set_glyph () SCM basic = ly_symbol2scm ("Clef"); - daddy_trans_->execute_pushpop_property (basic, glyph_sym, SCM_UNDEFINED); - daddy_trans_->execute_pushpop_property (basic, glyph_sym, glyph); + execute_pushpop_property (daddy_trans_, basic, glyph_sym, SCM_UNDEFINED); + execute_pushpop_property (daddy_trans_, basic, glyph_sym, glyph); } /** diff --git a/lily/context.cc b/lily/context.cc new file mode 100644 index 0000000000..cf5b161679 --- /dev/null +++ b/lily/context.cc @@ -0,0 +1,175 @@ +#include "translator-group.hh" +#include "context-def.hh" +#include "warn.hh" +#include "music-output-def.hh" +#include "scm-hash.hh" +#include "main.hh" + +bool +Translator_group::is_removable () const +{ + return trans_group_list_ == SCM_EOL && ! iterator_count_; +} + +Translator_group * +Translator_group::find_existing_translator (SCM n, String id) +{ + if ((is_alias (n) && (id_string_ == id || id.is_empty ())) || n == ly_symbol2scm ("Current")) + return this; + + Translator_group* r = 0; + for (SCM p = trans_group_list_; !r && gh_pair_p (p); p = ly_cdr (p)) + { + Translator * t = unsmob_translator (ly_car (p)); + + r = dynamic_cast (t)->find_existing_translator (n, id); } + + return r; +} + + +Translator_group* +Translator_group::find_create_translator (SCM n, String id, SCM operations) +{ + Translator_group * existing = find_existing_translator (n,id); + if (existing) + return existing; + + + /* + TODO: use accepts_list_. + */ + Link_array path + = unsmob_context_def (definition_)->path_to_acceptable_translator (n, get_output_def ()); + + if (path.size ()) + { + Translator_group * current = this; + + // start at 1. The first one (index 0) will be us. + for (int i=0; i < path.size (); i++) + { + SCM ops = (i == path.size () -1) ? operations : SCM_EOL; + + Translator_group * new_group + = path[i]->instantiate (ops); + + if (i == path.size () -1) + { + new_group->id_string_ = id; + } + + current->add_fresh_group_translator (new_group); + apply_property_operations (new_group, ops); + + current = new_group; + } + + return current; + } + + Translator_group *ret = 0; + if (daddy_trans_) + ret = daddy_trans_->find_create_translator (n, id, operations); + else + { + warning (_f ("Cannot find or create `%s' called `%s'", + ly_symbol2string (n).to_str0 (), id)); + ret =0; + } + return ret; +} + +/* + Default child context as a SCM string, or something else if there is + none. +*/ +SCM +default_child_context_name (Translator_group const *tg) +{ + return gh_pair_p (tg->accepts_list_) + ? ly_car (scm_last_pair (tg->accepts_list_)) + : SCM_EOL; +} + + +bool +Translator_group::is_bottom_context () const +{ + return !gh_symbol_p (default_child_context_name (this)); +} + +Translator_group* +Translator_group::get_default_interpreter () +{ + if (!is_bottom_context ()) + { + SCM nm = default_child_context_name (this); + SCM st = get_output_def ()->find_translator (nm); + + Context_def *t = unsmob_context_def (st); + if (!t) + { + warning (_f ("can't find or create: `%s'", ly_symbol2string (nm).to_str0 ())); + t = unsmob_context_def (this->definition_); + } + Translator_group *tg = t->instantiate (SCM_EOL); + add_fresh_group_translator (tg); + if (!tg->is_bottom_context ()) + return tg->get_default_interpreter (); + else + return tg; + } + return this; +} + +/* + PROPERTIES + */ +Translator_group* +Translator_group::where_defined (SCM sym) const +{ + if (properties_dict ()->contains (sym)) + { + return (Translator_group*)this; + } + + return (daddy_trans_) ? daddy_trans_->where_defined (sym) : 0; +} + +/* + return SCM_EOL when not found. +*/ +SCM +Translator_group::internal_get_property (SCM sym) const +{ + SCM val =SCM_EOL; + if (properties_dict ()->try_retrieve (sym, &val)) + return val; + + if (daddy_trans_) + return daddy_trans_->internal_get_property (sym); + + return val; +} + +void +Translator_group::internal_set_property (SCM sym, SCM val) +{ +#ifndef NDEBUG + if (internal_type_checking_global_b) + assert (type_check_assignment (sym, val, ly_symbol2scm ("translation-type?"))); +#endif + + properties_dict ()->set (sym, val); +} + +/* + TODO: look up to check whether we have inherited var? + */ +void +Translator_group::unset_property (SCM sym) +{ + properties_dict ()->remove (sym); +} + diff --git a/lily/engraver.cc b/lily/engraver.cc index 2badb89cd6..d8338972c9 100644 --- a/lily/engraver.cc +++ b/lily/engraver.cc @@ -67,21 +67,6 @@ Engraver::process_music () { } - -Item* -Engraver::internal_make_item (SCM x) -{ - SCM props = internal_get_property (x); - return new Item (props); -} - -Spanner* -Engraver::internal_make_spanner (SCM x) -{ - SCM props = internal_get_property (x); - return new Spanner (props); -} - Engraver::Engraver() { } diff --git a/lily/include/engraver.hh b/lily/include/engraver.hh index f0dce7d6c7..63928813f5 100644 --- a/lily/include/engraver.hh +++ b/lily/include/engraver.hh @@ -51,8 +51,6 @@ protected: Score_engraver * top_engraver () const; - Item * internal_make_item (SCM); - Spanner * internal_make_spanner (SCM); public: Engraver_group_engraver * get_daddy_grav () const; @@ -62,10 +60,11 @@ public: TRANSLATOR_DECLARATIONS(Engraver); }; -#define make_item(x) internal_make_item (ly_symbol2scm (x)) -#define make_spanner(x) internal_make_spanner (ly_symbol2scm (x)) +#define make_item(x) make_item_from_properties (daddy_trans_, ly_symbol2scm (x)) +#define make_spanner(x) make_spanner_from_properties (daddy_trans_, ly_symbol2scm (x)) +Item* make_item_from_properties (Translator_group* tg, SCM x); +Spanner* make_spanner_from_properties (Translator_group * tg, SCM x); #endif // ENGRAVER_HH - diff --git a/lily/include/separating-group-spanner.hh b/lily/include/separating-group-spanner.hh index b8ba2b9cdc..93059cc316 100644 --- a/lily/include/separating-group-spanner.hh +++ b/lily/include/separating-group-spanner.hh @@ -19,9 +19,7 @@ public: static void add_spacing_unit (Grob*me, Item*); static bool has_interface (Grob*); - static void find_musical_sequences (Grob*); DECLARE_SCHEME_CALLBACK (set_spacing_rods, (SCM )); - DECLARE_SCHEME_CALLBACK (set_spacing_rods_and_seqs, (SCM )); }; #endif /* SEPARATING_GROUP_SPANNER_HH */ diff --git a/lily/include/translator-group.hh b/lily/include/translator-group.hh index 0ae9e840f1..6bf46324bf 100644 --- a/lily/include/translator-group.hh +++ b/lily/include/translator-group.hh @@ -47,13 +47,15 @@ public: SCM properties_as_alist () const; void unset_property (SCM var_sym); void internal_set_property (SCM var_sym, SCM value); + Translator_group *where_defined (SCM name_sym) const; String context_name () const; Translator_group (Translator_group const &); Translator_group (); + + void add_fresh_group_translator (Translator *trans); void add_used_group_translator (Translator *trans); - bool is_bottom_context () const; bool is_removable () const; void terminate_translator (Translator*r); @@ -83,5 +85,8 @@ public: bool melisma_busy (Translator* tr); // where to put this? --hwn void apply_property_operations (Translator_group*tg, SCM pre_init_ops); SCM names_to_translators (SCM namelist, Translator_group*tg); +void execute_pushpop_property (Translator_group * trg, + SCM prop, SCM eltprop, SCM val); +SCM updated_grob_properties (Translator_group* tg, SCM sym); #endif // TRANSLATOR_GROUP_HH diff --git a/lily/ligature-engraver.cc b/lily/ligature-engraver.cc index f071cb568c..080e7ef2e1 100644 --- a/lily/ligature-engraver.cc +++ b/lily/ligature-engraver.cc @@ -117,7 +117,7 @@ Ligature_engraver::override_molecule_callback () SCM source_callback = ly_symbol2scm ("ligature-primitive-callback"); SCM noteHeadProperties = daddy_trans_->get_property ("NoteHead"); SCM value = ly_cdr (scm_sloppy_assq (source_callback, noteHeadProperties)); - daddy_trans_->execute_pushpop_property (symbol, target_callback, value); + execute_pushpop_property (daddy_trans_, symbol, target_callback, value); } /* @@ -138,7 +138,7 @@ Ligature_engraver::revert_molecule_callback () { SCM symbol = ly_symbol2scm ("NoteHead"); SCM key = ly_symbol2scm ("molecule-callback"); - daddy_trans_->execute_pushpop_property (symbol, key, SCM_UNDEFINED); + execute_pushpop_property (daddy_trans_, symbol, key, SCM_UNDEFINED); } void diff --git a/lily/new-part-combine-iterator.cc b/lily/new-part-combine-iterator.cc index ceae7e03b5..68c4b3434b 100644 --- a/lily/new-part-combine-iterator.cc +++ b/lily/new-part-combine-iterator.cc @@ -322,11 +322,11 @@ New_pc_iterator::construct_children () for (char const**p = syms; *p; p++) { SCM sym = ly_symbol2scm (*p); - one->execute_pushpop_property (sym, + execute_pushpop_property (one, sym, ly_symbol2scm ("direction"), gh_int2scm (1)); - two->execute_pushpop_property (sym, - ly_symbol2scm ("direction"), gh_int2scm (-1)); + execute_pushpop_property (two, sym, + ly_symbol2scm ("direction"), gh_int2scm (-1)); } } diff --git a/lily/parser.yy b/lily/parser.yy index 7ea2da8890..dfbe3dfc32 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -577,8 +577,10 @@ translator_spec_body: for (SCM p = $3; gh_pair_p (p); p = ly_cdr (p)) { SCM tag = gh_caar (p); + + /* TODO: should make new tag "grob-definition" ? */ td->add_context_mod (scm_list_n (ly_symbol2scm ("assign"), - tag, ly_cdar (p), SCM_UNDEFINED)); + tag, gh_cons (ly_cdar (p), SCM_EOL), SCM_UNDEFINED)); } } | translator_spec_body context_mod { @@ -945,7 +947,6 @@ basic music objects too, since the meaning is different. scm_gc_unprotect_object (startm->self_scm ()); } - Music* seq = MY_MAKE_MUSIC("SequentialMusic"); seq->set_mus_property ("elements", ms); diff --git a/lily/property-iterator.cc b/lily/property-iterator.cc index 0a1aa27e5b..9ce3befab7 100644 --- a/lily/property-iterator.cc +++ b/lily/property-iterator.cc @@ -111,9 +111,9 @@ Push_property_iterator::process (Moment m) if (to_boolean (get_music ()->get_mus_property ("pop-first")) && !to_boolean (get_music ()->get_mus_property ("once")) ) - get_outlet ()->execute_pushpop_property (sym, eprop, SCM_UNDEFINED); + execute_pushpop_property (get_outlet (), sym, eprop, SCM_UNDEFINED); - get_outlet ()->execute_pushpop_property (sym, eprop, val); + execute_pushpop_property (get_outlet (), sym, eprop, val); } Simple_music_iterator::process (m); } @@ -130,7 +130,7 @@ Push_property_iterator::once_finalization (SCM trans, SCM music) { SCM eprop = mus->get_mus_property ("grob-property"); - tg->execute_pushpop_property (sym, eprop, SCM_UNDEFINED); + execute_pushpop_property (tg, sym, eprop, SCM_UNDEFINED); } return SCM_UNSPECIFIED; } @@ -157,7 +157,7 @@ Pop_property_iterator::process (Moment m) if (check_grob (get_music (), sym)) { SCM eprop = get_music ()->get_mus_property ("grob-property"); - get_outlet ()->execute_pushpop_property (sym, eprop, SCM_UNDEFINED); +execute_pushpop_property (get_outlet (), sym, eprop, SCM_UNDEFINED); } Simple_music_iterator::process (m); } diff --git a/lily/score-engraver.cc b/lily/score-engraver.cc index a505efcc2d..a100c17d04 100644 --- a/lily/score-engraver.cc +++ b/lily/score-engraver.cc @@ -43,8 +43,13 @@ Score_engraver::make_columns () */ if (!command_column_) { - set_columns (new Paper_column (get_property ("NonMusicalPaperColumn")), - new Paper_column (get_property ("PaperColumn"))); + SCM nmp + = updated_grob_properties (this, + ly_symbol2scm ("NonMusicalPaperColumn")); + SCM pc = updated_grob_properties (this, + ly_symbol2scm ("PaperColumn")); + + set_columns (new Paper_column (nmp), new Paper_column (pc)); command_column_->set_grob_property ("breakable", SCM_BOOL_T); @@ -107,7 +112,7 @@ Score_engraver::initialize () pscore_ = new Paper_score; pscore_->paper_ = dynamic_cast (get_output_def ()); - SCM props = get_property ("System"); + SCM props = updated_grob_properties (this, ly_symbol2scm ("System")); pscore_->typeset_line (new System (props)); diff --git a/lily/separating-group-spanner.cc b/lily/separating-group-spanner.cc index 47bacd392f..868e49ecdd 100644 --- a/lily/separating-group-spanner.cc +++ b/lily/separating-group-spanner.cc @@ -72,15 +72,6 @@ Separating_group_spanner::find_rods (Item * r, SCM next, Real padding) } } -MAKE_SCHEME_CALLBACK (Separating_group_spanner,set_spacing_rods_and_seqs,1); -SCM -Separating_group_spanner::set_spacing_rods_and_seqs (SCM smob) -{ - set_spacing_rods (smob); - - return SCM_UNSPECIFIED; -} - MAKE_SCHEME_CALLBACK (Separating_group_spanner,set_spacing_rods,1); SCM Separating_group_spanner::set_spacing_rods (SCM smob) diff --git a/lily/system-start-delimiter-engraver.cc b/lily/system-start-delimiter-engraver.cc index 3e672d0c95..967fc24d5f 100644 --- a/lily/system-start-delimiter-engraver.cc +++ b/lily/system-start-delimiter-engraver.cc @@ -73,7 +73,7 @@ System_start_delimiter_engraver::process_music () if (!delim_) { SCM delim_name =get_property ("systemStartDelimiter"); - delim_ = internal_make_spanner (delim_name); + delim_ = make_spanner_from_properties (daddy_trans_, delim_name); delim_->set_bound (LEFT, unsmob_grob (get_property ("currentCommandColumn"))); announce_grob (delim_, SCM_EOL); diff --git a/lily/translator-group.cc b/lily/translator-group.cc index 4475d08aae..cc09ca0668 100644 --- a/lily/translator-group.cc +++ b/lily/translator-group.cc @@ -103,81 +103,6 @@ Translator_group::add_fresh_group_translator (Translator*t) t->initialize (); } -bool -Translator_group::is_removable () const -{ - return trans_group_list_ == SCM_EOL && ! iterator_count_; -} - -Translator_group * -Translator_group::find_existing_translator (SCM n, String id) -{ - if ((is_alias (n) && (id_string_ == id || id.is_empty ())) || n == ly_symbol2scm ("Current")) - return this; - - Translator_group* r = 0; - for (SCM p = trans_group_list_; !r && gh_pair_p (p); p = ly_cdr (p)) - { - Translator * t = unsmob_translator (ly_car (p)); - - r = dynamic_cast (t)->find_existing_translator (n, id); } - - return r; -} - - -Translator_group* -Translator_group::find_create_translator (SCM n, String id, SCM operations) -{ - Translator_group * existing = find_existing_translator (n,id); - if (existing) - return existing; - - - /* - TODO: use accepts_list_. - */ - Link_array path - = unsmob_context_def (definition_)->path_to_acceptable_translator (n, get_output_def ()); - - if (path.size ()) - { - Translator_group * current = this; - - // start at 1. The first one (index 0) will be us. - for (int i=0; i < path.size (); i++) - { - SCM ops = (i == path.size () -1) ? operations : SCM_EOL; - - Translator_group * new_group - = path[i]->instantiate (ops); - - if (i == path.size () -1) - { - new_group->id_string_ = id; - } - - current->add_fresh_group_translator (new_group); - apply_property_operations (new_group, ops); - - current = new_group; - } - - return current; - } - - Translator_group *ret = 0; - if (daddy_trans_) - ret = daddy_trans_->find_create_translator (n, id, operations); - else - { - warning (_f ("Cannot find or create `%s' called `%s'", - ly_symbol2string (n).to_str0 (), id)); - ret =0; - } - return ret; -} - bool Translator_group::try_music (Music* m) { @@ -214,49 +139,6 @@ Translator_group::remove_translator (Translator*trans) } -/* - Default child context as a SCM string, or something else if there is - none. -*/ -SCM -default_child_context_name (Translator_group const *tg) -{ - return gh_pair_p (tg->accepts_list_) - ? ly_car (scm_last_pair (tg->accepts_list_)) - : SCM_EOL; -} - - -bool -Translator_group::is_bottom_context () const -{ - return !gh_symbol_p (default_child_context_name (this)); -} - -Translator_group* -Translator_group::get_default_interpreter () -{ - if (!is_bottom_context ()) - { - SCM nm = default_child_context_name (this); - SCM st = get_output_def ()->find_translator (nm); - - Context_def *t = unsmob_context_def (st); - if (!t) - { - warning (_f ("can't find or create: `%s'", ly_symbol2string (nm).to_str0 ())); - t = unsmob_context_def (this->definition_); - } - Translator_group *tg = t->instantiate (SCM_EOL); - add_fresh_group_translator (tg); - if (!tg->is_bottom_context ()) - return tg->get_default_interpreter (); - else - return tg; - } - return this; -} - static void static_each (SCM list, Method_pointer method) { @@ -273,110 +155,6 @@ Translator_group::each (Method_pointer method) } -/* - PROPERTIES - */ -Translator_group* -Translator_group::where_defined (SCM sym) const -{ - if (properties_dict ()->contains (sym)) - { - return (Translator_group*)this; - } - - return (daddy_trans_) ? daddy_trans_->where_defined (sym) : 0; -} - -/* - return SCM_EOL when not found. -*/ -SCM -Translator_group::internal_get_property (SCM sym) const -{ - SCM val =SCM_EOL; - if (properties_dict ()->try_retrieve (sym, &val)) - return val; - - if (daddy_trans_) - return daddy_trans_->internal_get_property (sym); - - return val; -} - -void -Translator_group::internal_set_property (SCM sym, SCM val) -{ -#ifndef NDEBUG - if (internal_type_checking_global_b) - assert (type_check_assignment (sym, val, ly_symbol2scm ("translation-type?"))); -#endif - - properties_dict ()->set (sym, val); -} - -/* - TODO: look up to check whether we have inherited var? - */ -void -Translator_group::unset_property (SCM sym) -{ - properties_dict ()->remove (sym); -} - - -/* - Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL) - entry from a translator property list by name of PROP -*/ -void -Translator_group::execute_pushpop_property (SCM prop, SCM eltprop, SCM val) -{ - if (gh_symbol_p (prop)) - { - if (val != SCM_UNDEFINED) - { - SCM prev = internal_get_property (prop); - - if (gh_pair_p (prev) || prev == SCM_EOL) - { - bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?")); - - if (ok) - { - prev = gh_cons (gh_cons (eltprop, val), prev); - internal_set_property (prop, prev); - } - } - else - { - // warning here. - } - - } - else - { - SCM prev = internal_get_property (prop); - - /* - TODO: should have scm_equal_something () for reverting - autobeam properties. - */ - SCM newprops= SCM_EOL ; - while (gh_pair_p (prev) && !SCM_EQ_P(ly_caar (prev), eltprop)) - { - newprops = gh_cons (ly_car (prev), newprops); - prev = ly_cdr (prev); - } - - if (gh_pair_p (prev)) - { - newprops = scm_reverse_x (newprops, ly_cdr (prev)); - internal_set_property (prop, newprops); - } - } - } -} - /* @@ -482,32 +260,7 @@ Translator_group::context_name () const return ly_symbol2string (td->get_context_name ()); } -/* - PRE_INIT_OPS is in the order specified, and hence must be reversed. - */ -void -apply_property_operations (Translator_group*tg, SCM pre_init_ops) -{ - SCM correct_order = scm_reverse (pre_init_ops); - for (SCM s = correct_order; gh_pair_p (s); s = ly_cdr (s)) - { - SCM entry = ly_car (s); - SCM type = ly_car (entry); - entry = ly_cdr (entry); - - if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush")) - { - SCM val = ly_cddr (entry); - val = gh_pair_p (val) ? ly_car (val) : SCM_UNDEFINED; - tg->execute_pushpop_property (ly_car (entry), ly_cadr (entry), val); - } - else if (type == ly_symbol2scm ("assign")) - { - tg->internal_set_property (ly_car (entry), ly_cadr (entry)); - } - } -} SCM names_to_translators (SCM namelist, Translator_group*tg) @@ -538,37 +291,5 @@ SCM Translator_group::get_simple_trans_list () { return simple_trans_list_; - } - - -#if 0 -SCM -Translator_group::get_simple_trans_list () -{ - if (simple_trans_list_ != SCM_BOOL_F) - return simple_trans_list_; - - Context_def * td = unsmob_context_def (definition_); - - /* - The following cannot work, since start_translation_timestep () - triggers this code, and start_translation_timestep happens before - \property Voice.Voice =#'() - - */ - trans_names = td->get_translator_names (SCM_EOL); - - SCM trans_names = internal_get_property (td->get_context_name ()); - if (!gh_pair_p (trans_names)) - { - } - - simple_trans_list_ = names_to_translators (trans_names, this); - - - static_each (simple_trans_list_, &Translator::initialize); - return simple_trans_list_; -} -#endif diff --git a/lily/translator-property.cc b/lily/translator-property.cc new file mode 100644 index 0000000000..9e48ad9553 --- /dev/null +++ b/lily/translator-property.cc @@ -0,0 +1,192 @@ +/* +translator-property.cc -- implement manipulation of + + immutable Grob property lists. + +source file of the GNU LilyPond music typesetter + +(c) 2004 Han-Wen Nienhuys + + */ + +#include "translator-group.hh" +#include "warn.hh" +#include "item.hh" +#include "spanner.hh" + +/* + Grob descriptions (ie. alists with layout properties) are + represented as a (ALIST . BASED-ON) pair, where BASED-ON is the + alist defined in a parent context. BASED-ON should always be a tail + of ALIST. + + */ + +/* + Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL) + entry from a translator property list by name of PROP +*/ + + +void +execute_pushpop_property (Translator_group * trg, + SCM prop, SCM eltprop, SCM val) +{ + if (gh_symbol_p (prop)) + { + if (val != SCM_UNDEFINED) + { + SCM prev = SCM_EOL; + Translator_group * where = trg->where_defined (prop); + + /* + Don't mess with MIDI. + */ + if (!where) + return ; + if (where != trg) + { + SCM base = updated_grob_properties (trg, prop); + prev = gh_cons (base, base); + trg->internal_set_property (prop, prev); + } + else + prev = trg->internal_get_property (prop); + + if (!gh_pair_p (prev)) + { + programming_error ("Grob definition should be cons."); + return ; + } + + SCM prev_alist = gh_car (prev); + + if (gh_pair_p (prev_alist) || prev_alist == SCM_EOL) + { + bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?")); + + if (ok) + { + gh_set_car_x (prev, scm_acons (eltprop, val, prev_alist)); + } + } + else + { + // warning here. + } + } + else if (trg->where_defined (prop) == trg) + { + SCM prev = trg->internal_get_property (prop); + SCM prev_alist = gh_car (prev); + SCM daddy = gh_cdr (prev); + + SCM new_alist = SCM_EOL; + SCM *tail = &new_alist; + + while (prev_alist != daddy) + { + if (!gh_equal_p (gh_caar (prev_alist), eltprop)) + { + *tail = gh_cons (gh_car (prev_alist), daddy); + tail = SCM_CDRLOC (*tail); + } + prev_alist = gh_cdr (prev_alist); + } + + if (new_alist == SCM_EOL) + trg->unset_property (prop); + else + trg->internal_set_property (prop, gh_cons (new_alist, daddy)); + } + } +} + +/* + PRE_INIT_OPS is in the order specified, and hence must be reversed. + */ +void +apply_property_operations (Translator_group*tg, SCM pre_init_ops) +{ + SCM correct_order = scm_reverse (pre_init_ops); + for (SCM s = correct_order; gh_pair_p (s); s = ly_cdr (s)) + { + SCM entry = ly_car (s); + SCM type = ly_car (entry); + entry = ly_cdr (entry); + + if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush")) + { + SCM val = ly_cddr (entry); + val = gh_pair_p (val) ? ly_car (val) : SCM_UNDEFINED; + + execute_pushpop_property (tg, ly_car (entry), ly_cadr (entry), val); + } + else if (type == ly_symbol2scm ("assign")) + { + tg->internal_set_property (ly_car (entry), ly_cadr (entry)); + } + } +} + +/* + Return the object alist for SYM, checking if its base in enclosing + contexts has changed. The alist is updated if necessary. + */ +SCM +updated_grob_properties (Translator_group* tg, SCM sym) +{ + assert (gh_symbol_p (sym)); + + tg = tg->where_defined (sym); + SCM daddy_props + = (tg->daddy_trans_) + ? updated_grob_properties (tg->daddy_trans_, sym) + : SCM_EOL; + + SCM props = tg->internal_get_property (sym); + + if (!gh_pair_p (props)) + { + programming_error ("grob props not a pair?"); + return SCM_EOL; + } + + SCM based_on = gh_cdr (props); + if (based_on == daddy_props) + { + return gh_car (props); + } + else + { + SCM copy = daddy_props; + SCM * tail = © + SCM p = gh_car (props); + while (p != based_on) + { + *tail = gh_cons (gh_car (p), daddy_props); + tail = SCM_CDRLOC (*tail); + p = SCM_CDR (p); + } + + scm_set_car_x (props, copy); + scm_set_cdr_x (props, daddy_props); + + return copy; + } +} + +Item* +make_item_from_properties (Translator_group* tg, SCM x) +{ + SCM props = updated_grob_properties (tg, x); + return new Item (props); +} + +Spanner* +make_spanner_from_properties (Translator_group *tg, SCM x) +{ + SCM props = updated_grob_properties (tg, x); + return new Spanner (props); +} + diff --git a/lily/translator-scheme.cc b/lily/translator-scheme.cc index 750c3617ed..1ccee6c729 100644 --- a/lily/translator-scheme.cc +++ b/lily/translator-scheme.cc @@ -199,7 +199,7 @@ LY_DEFINE(ly_context_pushpop_property, SCM_ASSERT_TYPE(gh_symbol_p (grob), grob, SCM_ARG2, __FUNCTION__, "symbol"); SCM_ASSERT_TYPE(gh_symbol_p (eltprop), eltprop, SCM_ARG3, __FUNCTION__, "symbol"); - tg->execute_pushpop_property (grob, eltprop, val); + execute_pushpop_property (tg, grob, eltprop, val); return SCM_UNDEFINED; } diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index aecfe99c24..6c7f843499 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -23,8 +23,6 @@ % \consists "Repeat_engraver" \consists "Volta_engraver" \consists "Separating_line_group_engraver" - SeparatingGroupSpanner \override #'spacing-procedure - = #Separating_group_spanner::set_spacing_rods_and_seqs \consists "Dot_column_engraver" % perhaps move to Voice context? @@ -471,7 +469,7 @@ AncientRemoveEmptyStaffContext = \translator { explicitClefVisibility = #all-visible explicitKeySignatureVisibility = #all-visible - autoBeamSettings = #default-auto-beam-settings + autoBeamSettings = #(cons default-auto-beam-settings '()) autoBeaming = ##t scriptDefinitions = #default-script-alist diff --git a/ly/property-init.ly b/ly/property-init.ly index e308097166..c784a0ba52 100644 --- a/ly/property-init.ly +++ b/ly/property-init.ly @@ -219,7 +219,7 @@ forgetAccidentals = { %% %% DO NOT USE THIS. IT CAN LEAD TO CRASHES. -turnOff = #'() +turnOff = #(cons '() '()) % For drawing vertical chord brackets with \arpeggio % This is a shorthand for the value of the molecule-callback property -- 2.39.5