+2004-02-11 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * 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 <hanwen@xs4all.nl>
+
+ * TODO: new file.
+
2004-02-10 Jan Nieuwenhuizen <janneke@gnu.org>
* debian/: Late Debian update (sorry Anthony).
$(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
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::
#
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
--- /dev/null
+
+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
+
+
MAJOR_VERSION=2
MINOR_VERSION=1
PATCH_LEVEL=20
-MY_PATCH_LEVEL=
+MY_PATCH_LEVEL=hwn1
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 <as b>
- <g b>
- <g cis>
- } \\
- {
-\property Staff.Arpeggio \set #'arpeggio-direction =#-1
-<cis, e, gis, b, cis>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 {
+ <g b>
+ <g cis>
+ } \\
+ {
+ \property Staff.Arpeggio \set #'arpeggio-direction =#-1
+ <cis, e, gis, b, cis>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 }
}
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);
}
/**
--- /dev/null
+#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<Translator_group*> (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<Context_def> 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);
+}
+
{
}
-
-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()
{
}
Score_engraver * top_engraver () const;
- Item * internal_make_item (SCM);
- Spanner * internal_make_spanner (SCM);
public:
Engraver_group_engraver * get_daddy_grav () const;
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
-
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 */
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);
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
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);
}
/*
{
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
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));
}
}
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 {
scm_gc_unprotect_object (startm->self_scm ());
}
-
Music* seq = MY_MAKE_MUSIC("SequentialMusic");
seq->set_mus_property ("elements", ms);
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);
}
{
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;
}
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);
}
*/
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);
pscore_ = new Paper_score;
pscore_->paper_ = dynamic_cast<Paper_def*> (get_output_def ());
- SCM props = get_property ("System");
+ SCM props = updated_grob_properties (this, ly_symbol2scm ("System"));
pscore_->typeset_line (new System (props));
}
}
-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)
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);
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<Translator_group*> (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<Context_def> 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)
{
}
-/*
- 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)
{
}
-/*
- 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);
- }
- }
- }
-}
-
/*
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)
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
--- /dev/null
+/*
+translator-property.cc -- implement manipulation of
+
+ immutable Grob property lists.
+
+source file of the GNU LilyPond music typesetter
+
+(c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ */
+
+#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);
+}
+
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;
}
% \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?
explicitClefVisibility = #all-visible
explicitKeySignatureVisibility = #all-visible
- autoBeamSettings = #default-auto-beam-settings
+ autoBeamSettings = #(cons default-auto-beam-settings '())
autoBeaming = ##t
scriptDefinitions = #default-script-alist
%%
%% 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
projects / lilypond.git / commitdiff