From 2be67678488b5829a52acdf36ab4278477375b6d Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 16 Jun 2004 15:09:14 +0000 Subject: [PATCH] * scm/lily.scm (ly:all-stencil-expressions): * scm/lily.scm (ly:all-output-backend-commands): New function. * scm/safe-lily.scm (safe-objects): Add them. * scm/framework-gnome.scm (): New class. * scm/output-gnome.scm: Move non-stencil evaluators to framework. --- ChangeLog | 7 + input/simple-song.ly | 7 +- input/test/page-breaks.ly | 2 + lily/accidental-engraver.cc | 229 ++++++++--------- lily/bar-engraver.cc | 11 +- lily/global-context.cc | 15 +- lily/grace-iterator.cc | 8 +- lily/include/grob.hh | 83 +++--- lily/key-engraver.cc | 5 +- lily/ly-module.cc | 3 - lily/my-lily-lexer.cc | 4 +- lily/parse-scm.cc | 23 +- lily/stem.cc | 273 +++++++++----------- lily/time-signature-engraver.cc | 8 +- scm/framework-gnome.scm | 291 ++++++++++++++++++++- scm/lily.scm | 67 +++-- scm/output-gnome.scm | 430 ++++---------------------------- scm/output-ps.scm | 17 ++ scm/output-tex.scm | 11 +- scm/safe-lily.scm | 39 ++- 20 files changed, 725 insertions(+), 808 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0b5ae37121..21e8e250ad 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,12 @@ 2004-06-16 Jan Nieuwenhuizen + * lily/: Stray janitorial cleanups. + + * scm/lily.scm (ly:all-stencil-expressions): + * scm/lily.scm (ly:all-output-backend-commands): New function. + + * scm/safe-lily.scm (safe-objects): Add them. + * scm/framework-gnome.scm (): New class. * scm/output-gnome.scm: Move non-stencil evaluators to framework. diff --git a/input/simple-song.ly b/input/simple-song.ly index 2a98ae5cad..d68971a6de 100644 --- a/input/simple-song.ly +++ b/input/simple-song.ly @@ -1,6 +1,3 @@ -% remove-me -#(ly:set-point-and-click 'line-column) - %% A simple song in LilyPond << \relative { @@ -16,3 +13,7 @@ %% Optional helper for automatic updating by convert-ly. May be omitted. \version "2.3.4" + +%% Optional helper for quick click and edit mode. May be omitted +#(ly:set-point-and-click 'line-column) + diff --git a/input/test/page-breaks.ly b/input/test/page-breaks.ly index 470d73758b..af74904525 100644 --- a/input/test/page-breaks.ly +++ b/input/test/page-breaks.ly @@ -1,3 +1,4 @@ +#(ly:set-point-and-click 'line-column) \version "2.3.4" \header { @@ -23,6 +24,7 @@ texidoc = "Stress optimal page breaking. This should look #(set-default-paper-size "a6") + pattern = { a b c d \break } \book { \score { diff --git a/lily/accidental-engraver.cc b/lily/accidental-engraver.cc index 2503e2338d..a43cf8b6a6 100644 --- a/lily/accidental-engraver.cc +++ b/lily/accidental-engraver.cc @@ -1,32 +1,37 @@ /* accidental-engraver.cc -- implement accidental_engraver + source file of the GNU LilyPond music typesetter + (c) 1997--2004 Han-Wen Nienhuys Modified 2001--2002 by Rune Zedeler */ +#include "accidental-placement.hh" +#include "arpeggio.hh" +#include "context.hh" +#include "engraver-group-engraver.hh" +#include "engraver.hh" #include "event.hh" -#include "spanner.hh" #include "item.hh" -#include "tie.hh" +#include "protected-scm.hh" #include "rhythmic-head.hh" -#include "engraver-group-engraver.hh" -#include "accidental-placement.hh" #include "side-position-interface.hh" -#include "engraver.hh" -#include "arpeggio.hh" +#include "spanner.hh" +#include "tie.hh" #include "warn.hh" -#include "context.hh" -#include "protected-scm.hh" -struct Accidental_entry { +class Accidental_entry +{ +public: bool done_; - Music * melodic_; - Grob * accidental_; + Music *melodic_; + Grob *accidental_; Context *origin_; - Grob* head_; + Grob *head_; bool tied_; + Accidental_entry (); }; @@ -34,15 +39,15 @@ Accidental_entry::Accidental_entry () { tied_ = false; done_ = false; - melodic_ =0; + melodic_ = 0; accidental_ = 0; origin_ = 0; head_ = 0; } -struct Accidental_engraver : Engraver { - - +class Accidental_engraver : public Engraver +{ +public: int get_bar_number (); void update_local_key_signature (); @@ -54,18 +59,17 @@ protected: virtual void initialize (); virtual void process_acknowledged_grobs (); virtual void finalize (); -public: +public: Protected_scm last_keysig_; // ugh. - /* - Urgh. Since the accidentals depend on lots of variables, we have to - store all information before we can really create the accidentals. - */ + /* Urgh. Since the accidentals depend on lots of variables, we have + to store all information before we can really create the + accidentals. */ Link_array left_objects_; Link_array right_objects_; - Grob * accidental_placement_; + Grob *accidental_placement_; Array accidentals_; Link_array ties_; @@ -82,12 +86,12 @@ public: */ static void -set_property_on_children (Context * trans, const char * sym, SCM val) +set_property_on_children (Context *trans, char const *sym, SCM val) { trans->set_property (sym, ly_deep_copy (val)); for (SCM p = trans->children_contexts (); ly_c_pair_p (p); p = ly_cdr (p)) { - Context *trg = unsmob_context (ly_car (p)); + Context *trg = unsmob_context (ly_car (p)); set_property_on_children (trg, sym, ly_deep_copy (val)); } } @@ -98,22 +102,18 @@ Accidental_engraver::Accidental_engraver () last_keysig_ = SCM_EOL; } - void Accidental_engraver::update_local_key_signature () { last_keysig_ = get_property ("keySignature"); set_property_on_children (context (), "localKeySignature", last_keysig_); - Context * trans = context ()->get_parent_context (); + Context *trans = context ()->get_parent_context (); - /* - Huh. Don't understand what this is good for. --hwn. - */ + /* Huh. Don't understand what this is good for. --hwn. */ while (trans && trans->where_defined (ly_symbol2scm ("localKeySignature"))) { - trans->set_property ("localKeySignature", - ly_deep_copy (last_keysig_)); + trans->set_property ("localKeySignature", ly_deep_copy (last_keysig_)); trans = trans->get_parent_context (); } } @@ -124,25 +124,18 @@ Accidental_engraver::initialize () update_local_key_signature (); } -/* - - Calculates the number of accidentals on basis of the current local key - sig (passed as argument) - - * First check step+octave (taking into account barnumbers if necessary). - * Then check the global signature (only step). - - - - Returns number of accidentals (0, 1 or 2). +/** Calculate the number of accidentals on basis of the current local key + sig (passed as argument) + + * First check step+octave (taking into account barnumbers if necessary). + + * Then check the global signature (only step). - -*/ + Return number of accidentals (0, 1 or 2). */ static int -number_accidentals_from_sig (bool *different, - SCM sig, Pitch *pitch, int curbarnum, SCM laziness, - bool ignore_octave) +number_accidentals_from_sig (bool *different, SCM sig, Pitch *pitch, + int curbarnum, SCM laziness, bool ignore_octave) { int n = pitch->get_notename (); int o = pitch->get_octave (); @@ -158,8 +151,7 @@ number_accidentals_from_sig (bool *different, if (ly_c_pair_p (prev_local)) { if (ly_c_pair_p (ly_cdr (prev_local)) - && ly_c_number_p (laziness) - ) + && ly_c_number_p (laziness)) { int barnum = ly_scm2int (ly_cddr (prev_local)); @@ -173,13 +165,9 @@ number_accidentals_from_sig (bool *different, if (prev_alt == SCM_BOOL_F) prev_alt = scm_assoc (scm_int2num (n), sig); - prev_alt = (prev_alt == SCM_BOOL_F) ? scm_int2num (0) : ly_cdr (prev_alt); - /* - UGH. prev_acc can be #t in case of ties. What is this for? - - */ + /* UGH. prev_acc can be #t in case of ties. What is this for? */ int p = ly_c_number_p (prev_alt) ? ly_scm2int (prev_alt) : 0; int num; @@ -196,7 +184,7 @@ number_accidentals_from_sig (bool *different, static int number_accidentals (bool *different, - Pitch *pitch, Context * origin, + Pitch *pitch, Context *origin, SCM accidentals, int curbarnum) { int number = 0; @@ -206,7 +194,8 @@ number_accidentals (bool *different, warning (_f ("Accidental typesetting list must begin with context-name: %s", ly_scm2string (ly_car (accidentals)).to_str0 ())); - for (; ly_c_pair_p (accidentals) && origin; accidentals = ly_cdr (accidentals)) + for (; ly_c_pair_p (accidentals) && origin; + accidentals = ly_cdr (accidentals)) { // If pair then it is a new accidentals typesetting rule to be checked SCM rule = ly_car (accidentals); @@ -240,7 +229,7 @@ number_accidentals (bool *different, */ else if (ly_c_symbol_p (rule)) { - Context * dad = origin; + Context *dad = origin; while (dad && !dad->is_alias (rule)) dad = dad->get_parent_context (); @@ -264,7 +253,7 @@ Accidental_engraver::get_bar_number () Moment mp = (unsmob_moment (smp)) ? *unsmob_moment (smp) : Moment (0); if (mp.main_part_ < Rational (0)) - bn --; + bn--; return bn; } @@ -279,16 +268,16 @@ Accidental_engraver::process_acknowledged_grobs () int barnum = get_bar_number (); bool extra_natural_b = get_property ("extraNatural") == SCM_BOOL_T; - for (int i = 0; i < accidentals_.size (); i++) + for (int i = 0; i < accidentals_.size (); i++) { if (accidentals_[i].done_ ) continue; accidentals_[i].done_ = true; - Grob * support = accidentals_[i].head_; - Music * note = accidentals_[i].melodic_; - Context * origin = accidentals_[i].origin_; + Grob *support = accidentals_[i].head_; + Music *note = accidentals_[i].melodic_; + Context *origin = accidentals_[i].origin_; - Pitch * pitch = unsmob_pitch (note->get_property ("pitch")); + Pitch *pitch = unsmob_pitch (note->get_property ("pitch")); if (!pitch) continue; @@ -327,34 +316,25 @@ Accidental_engraver::process_acknowledged_grobs () level, so that we get the property settings for Accidental from the respective Voice. */ - Grob * a = make_item_from_properties (origin->implementation (), - ly_symbol2scm ("Accidental"), - note->self_scm () - ); + Grob *a + = make_item_from_properties (origin->implementation (), + ly_symbol2scm ("Accidental"), + note->self_scm ()); a->set_parent (support, Y_AXIS); if (!accidental_placement_) - { - accidental_placement_ = make_item ("AccidentalPlacement", a->self_scm ()); - } - + accidental_placement_ = make_item ("AccidentalPlacement", + a->self_scm ()); Accidental_placement::add_accidental (accidental_placement_, a); - - - SCM accs = scm_cons (scm_int2num (pitch->get_alteration ()), SCM_EOL); + SCM accs = scm_cons (scm_int2num (pitch->get_alteration ()), + SCM_EOL); if (num == 2 && extra_natural_b) accs = scm_cons (scm_int2num (0), accs); - /* TODO: - - add cautionary option in accidental. - */ + /* TODO: add cautionary option in accidental. */ if (cautionary) - { - a->set_property ("cautionary", SCM_BOOL_T); - } - + a->set_property ("cautionary", SCM_BOOL_T); support->set_property ("accidental-grob", a->self_scm ()); @@ -374,9 +354,6 @@ Accidental_engraver::process_acknowledged_grobs () } } - - - void Accidental_engraver::finalize () { @@ -386,18 +363,17 @@ Accidental_engraver::finalize () void Accidental_engraver::stop_translation_timestep () { - for (int j = ties_.size (); j --; ) + for (int j = ties_.size (); j--;) { - Grob * r = Tie::head (ties_[j], RIGHT); + Grob *r = Tie::head (ties_[j], RIGHT); for (int i = accidentals_.size (); i--;) if (accidentals_[i].head_ == r) { - if (Grob * g = accidentals_[i].accidental_) + if (Grob *g = accidentals_[i].accidental_) { g->set_property ("tie", ties_[j]->self_scm ()); - accidentals_[i].tied_ = true; + accidentals_[i].tied_ = true; } - ties_.del (j); break; } @@ -407,19 +383,20 @@ Accidental_engraver::stop_translation_timestep () { int barnum = get_bar_number (); - Music * note = accidentals_[i].melodic_; + Music *note = accidentals_[i].melodic_; Context * origin = accidentals_[i].origin_; - Pitch * pitch = unsmob_pitch (note->get_property ("pitch")); + Pitch *pitch = unsmob_pitch (note->get_property ("pitch")); if (!pitch) continue; - + int n = pitch->get_notename (); int o = pitch->get_octave (); int a = pitch->get_alteration (); SCM key = scm_cons (scm_int2num (o), scm_int2num (n)); - while (origin && origin->where_defined (ly_symbol2scm ("localKeySignature"))) + while (origin + && origin->where_defined (ly_symbol2scm ("localKeySignature"))) { /* huh? we set props all the way to the top? @@ -443,22 +420,20 @@ Accidental_engraver::stop_translation_timestep () not really really correct if there are more than one noteheads with the same notename. */ - localsig = ly_assoc_front_x - (localsig, key, scm_cons (scm_int2num (a), scm_int2num (barnum))); - + localsig = ly_assoc_front_x (localsig, key, + scm_cons (scm_int2num (a), + scm_int2num (barnum))); change = true; } if (change) - origin->set_property ("localKeySignature", localsig); - + origin->set_property ("localKeySignature", localsig); + origin = origin->get_parent_context (); } } - accidental_placement_ = 0; - accidentals_.clear (); left_objects_.clear (); right_objects_.clear (); @@ -467,7 +442,7 @@ Accidental_engraver::stop_translation_timestep () void Accidental_engraver::acknowledge_grob (Grob_info info) { - Music * note = info.music_cause (); + Music *note = info.music_cause (); if (note && note->is_mus_type ("note-event") @@ -487,46 +462,44 @@ Accidental_engraver::acknowledge_grob (Grob_info info) } } else if (Tie::has_interface (info.grob_)) - { - ties_.push (dynamic_cast (info.grob_)); - } + ties_.push (dynamic_cast (info.grob_)); else if (Arpeggio::has_interface (info.grob_)) - { - left_objects_.push (info.grob_); - } - else if (info.grob_->internal_has_interface (ly_symbol2scm ("finger-interface"))) - { - left_objects_.push (info.grob_); - } + left_objects_.push (info.grob_); + else if (info.grob_ + ->internal_has_interface (ly_symbol2scm ("finger-interface"))) + left_objects_.push (info.grob_); } void Accidental_engraver::process_music () { SCM sig = get_property ("keySignature"); - /* Detect key sig changes. - Update all parents and children - */ + Update all parents and children. */ if (last_keysig_ != sig) - { - update_local_key_signature (); - } + update_local_key_signature (); } - - - - ENTER_DESCRIPTION (Accidental_engraver, - "Make accidentals. Catches note heads, ties and notices key-change " - "events. This engraver usually lives at Staff level, but " + "Make accidentals. " + "Catch note heads, ties and notices key-change events. " + "This engraver usually lives at Staff level, but " "reads the settings for Accidental at @code{Voice} level, " - "so you can @code{\\override} them at @code{Voice}. " - , + "so you can @code{\\override} them at @code{Voice}. ", "Accidental", + "", - "finger-interface rhythmic-head-interface tie-interface arpeggio-interface", - "localKeySignature harmonicAccidentals extraNatural autoAccidentals autoCautionaries", + + "arpeggio-interface ", + "autoAccidentals " + "autoCautionaries", + "finger-interface " + "rhythmic-head-interface " + "tie-interface " + + "extraNatural " + "harmonicAccidentals " + "localKeySignature " + "localKeySignature"); diff --git a/lily/bar-engraver.cc b/lily/bar-engraver.cc index 78008a625f..e62d814c96 100644 --- a/lily/bar-engraver.cc +++ b/lily/bar-engraver.cc @@ -76,15 +76,13 @@ void Bar_engraver::process_acknowledged_grobs () { if (!bar_ && ly_c_string_p (get_property ("whichBar"))) - { - create_bar (); - } + create_bar (); } void Bar_engraver::typeset_bar () { - bar_ =0; + bar_ = 0; } /* @@ -94,9 +92,8 @@ void Bar_engraver::stop_translation_timestep () { if (!bar_) - { - get_score_engraver ()->forbid_breaks (); // guh. Use properties! - } + /* guh. Use properties! */ + get_score_engraver ()->forbid_breaks (); else typeset_bar (); } diff --git a/lily/global-context.cc b/lily/global-context.cc index 77a67639c4..b00124606d 100644 --- a/lily/global-context.cc +++ b/lily/global-context.cc @@ -164,22 +164,19 @@ void Global_context::apply_finalizations () { SCM lst = get_property ("finalizations"); - set_property ("finalizations" , SCM_EOL); - for (SCM s = lst ; ly_c_pair_p (s); s = ly_cdr (s)) - { - scm_primitive_eval (ly_car (s)); // TODO: make safe. - } + set_property ("finalizations", SCM_EOL); + for (SCM s = lst; ly_c_pair_p (s); s = ly_cdr (s)) + /* TODO: make safe. */ + scm_primitive_eval (ly_car (s)); } -/* - Add a function to execute before stepping to the next time step. -*/ +/* Add a function to execute before stepping to the next time step. */ void Global_context::add_finalization (SCM x) { SCM lst = get_property ("finalizations"); lst = scm_cons (x, lst); - set_property ("finalizations" ,lst); + set_property ("finalizations", lst); } Moment diff --git a/lily/grace-iterator.cc b/lily/grace-iterator.cc index a63ad5c814..d68bcad7b3 100644 --- a/lily/grace-iterator.cc +++ b/lily/grace-iterator.cc @@ -17,14 +17,12 @@ void Grace_iterator::process (Moment m) { - Moment main ; + Moment main; main.main_part_ = - start_mom_.grace_part_ + m.grace_part_; Music_wrapper_iterator::process (main); - /* - We can safely do this, since \grace should always be inside - sequential. - */ + /* We can safely do this, since \grace should always be inside + sequential. */ descend_to_child (child_iter_->get_outlet ()); } diff --git a/lily/include/grob.hh b/lily/include/grob.hh index ad0ae53136..314418ad1e 100644 --- a/lily/include/grob.hh +++ b/lily/include/grob.hh @@ -30,40 +30,57 @@ enum Grob_status { typedef void (Grob::*Grob_method_pointer) (void); +// looking at gtk+/pango docstrings .. WIP -/* Basic G[raphical output] O[bject]. */ +/** + * Grob: + * @internal_get_property: get property #NAME. + * + * Class structure for #Grob. + **/ class Grob { +private: + DECLARE_SMOBS (Grob, foo); + void init (); + protected: SCM immutable_property_alist_; SCM mutable_property_alist_; friend class Spanner; - void substitute_mutable_properties(SCM,SCM); + void substitute_mutable_properties (SCM, SCM); char status_; + public: Grob *original_; - /* - TODO: junk this member. - */ + /* TODO: junk this member. */ Paper_score *pscore_; + Dimension_cache dim_cache_[NO_AXES]; Grob (SCM basic_props); Grob (Grob const&); - VIRTUAL_COPY_CONSTRUCTOR(Grob,Grob); + VIRTUAL_COPY_CONSTRUCTOR (Grob, Grob); + DECLARE_SCHEME_CALLBACK (stencil_extent, (SCM smob, SCM axis)); String name () const; - + + /* - properties + Properties */ SCM internal_get_property (SCM) const; void internal_set_property (SCM, SCM val); void add_to_list_property (SCM, SCM); - void warning (String)const; - void programming_error (String)const; + + SCM get_property_alist_chain (SCM) const; + static SCM ly_grob_set_property (SCM, SCM,SCM); + static SCM ly_grob_property (SCM, SCM); + + void warning (String) const; + void programming_error (String) const; Output_def *get_paper () const; void add_dependency (Grob*); @@ -77,60 +94,54 @@ public: virtual void discretionary_processing (); virtual SCM do_derived_mark () const; - Stencil * get_stencil () const; + Stencil *get_stencil () const; SCM get_uncached_stencil () const; - SCM get_property_alist_chain (SCM) const; void suicide (); bool is_live () const; + bool is_empty (Axis a) const; - DECLARE_SCHEME_CALLBACK (stencil_extent, (SCM smob, SCM axis)); - - static SCM ly_grob_set_property (SCM, SCM,SCM); - static SCM ly_grob_property (SCM, SCM); - bool internal_has_interface (SCM intf); - static bool has_interface (Grob*me); + static bool has_interface (Grob *me); virtual void handle_broken_dependencies (); virtual void handle_prebroken_dependencies (); - DECLARE_SMOBS (Grob,foo); - - void init (); -public: - bool is_empty (Axis a) const; - Interval extent (Grob * refpoint, Axis) const; void translate_axis (Real, Axis); - Real relative_coordinate (Grob const* refp, Axis) const; - Grob*common_refpoint (Grob const* s, Axis a) const; + Real relative_coordinate (Grob const *refp, Axis) const; + Grob *common_refpoint (Grob const *s, Axis a) const; // duh. slim down interface here. (todo) - bool has_offset_callback (SCM callback, Axis)const; + bool has_offset_callback (SCM callback, Axis) const; void add_offset_callback (SCM callback, Axis); - bool has_extent_callback (SCM, Axis)const; - void set_extent (SCM , Axis); + bool has_extent_callback (SCM, Axis) const; + void set_extent (SCM, Axis); Real get_offset (Axis a) const; void set_parent (Grob* e, Axis); - Grob *get_parent (Axis a) const { return dim_cache_[a].parent_; } + + // URG + Grob *get_parent (Axis a) const + { + return dim_cache_[a].parent_; + } DECLARE_SCHEME_CALLBACK (fixup_refpoint, (SCM)); }; -DECLARE_UNSMOB(Grob,grob); -Spanner* unsmob_spanner (SCM ); -Item* unsmob_item (SCM ); +DECLARE_UNSMOB (Grob, grob); +Spanner *unsmob_spanner (SCM); +Item *unsmob_item (SCM); -Grob*common_refpoint_of_list (SCM elt_list, Grob * , Axis a); -Grob*common_refpoint_of_array (Link_array const&, Grob * , Axis a); +Grob *common_refpoint_of_list (SCM elt_list, Grob *, Axis a); +Grob *common_refpoint_of_array (Link_array const&, Grob *, Axis a); void set_break_subsititution (SCM criterion); SCM substitute_mutable_property_alist (SCM alist); -Link_array ly_scm2grobs (SCM l); +Link_array ly_scm2grobs (SCM ell); SCM ly_grobs2scm (Link_array a); #endif /* GROB_HH */ diff --git a/lily/key-engraver.cc b/lily/key-engraver.cc index f5e4a02d68..6bff182773 100644 --- a/lily/key-engraver.cc +++ b/lily/key-engraver.cc @@ -88,15 +88,12 @@ Key_engraver::try_music (Music * ev) { if (ev->is_mus_type ("key-change-event")) { + /* do this only once, just to be on the safe side. */ if (!key_ev_) { - /* - do this only once, just to be on the safe side. - */ key_ev_ = ev; read_ev (key_ev_); } - return true; } return false; diff --git a/lily/ly-module.cc b/lily/ly-module.cc index f90176be4f..ab0d15d405 100644 --- a/lily/ly-module.cc +++ b/lily/ly-module.cc @@ -28,16 +28,13 @@ ly_make_anonymous_module (bool safe) SCM mod = SCM_EOL; if (!safe) { - String s = "*anonymous-ly-" + to_string (module_count++) + "*"; mod = scm_c_define_module (s.to_str0 (), ly_init_anonymous_module, 0); - ly_use_module (mod, global_lily_module); } else { SCM proc = ly_scheme_function ("make-safe-lilypond-module"); - mod = scm_call_0 (proc); } return mod; diff --git a/lily/my-lily-lexer.cc b/lily/my-lily-lexer.cc index a2ad7efaf0..6accfaa91d 100644 --- a/lily/my-lily-lexer.cc +++ b/lily/my-lily-lexer.cc @@ -168,7 +168,7 @@ My_lily_lexer::lookup_identifier_symbol (SCM sym) SCM My_lily_lexer::lookup_identifier (String name) { - return lookup_identifier_symbol ( ly_symbol2scm (name.to_str0 ())); + return lookup_identifier_symbol (ly_symbol2scm (name.to_str0 ())); } void @@ -177,7 +177,7 @@ My_lily_lexer::start_main_input () // yy_flex_debug = 1; new_input (main_input_name_, sources_); /* Do not allow \include in --safe-mode */ - allow_includes_b_ = allow_includes_b_ && ! safe_global_b; + allow_includes_b_ = allow_includes_b_ && !safe_global_b; scm_module_define (ly_car (scopes_), ly_symbol2scm ("input-file-name"), diff --git a/lily/parse-scm.cc b/lily/parse-scm.cc index 8fd3cb3ab9..5156ae6623 100644 --- a/lily/parse-scm.cc +++ b/lily/parse-scm.cc @@ -15,10 +15,10 @@ SCM internal_ly_parse_scm (Parse_start * ps) { - Source_file* sf =ps->start_location_.source_file_; + Source_file *sf =ps->start_location_.source_file_; SCM port = sf->get_port (); - int off = ps->start_location_.defined_str0_ - sf->to_str0(); + int off = ps->start_location_.defined_str0_ - sf->to_str0 (); scm_seek (port, scm_long2num (off), scm_long2num (SEEK_SET)); SCM from = scm_ftell (port); @@ -26,12 +26,12 @@ internal_ly_parse_scm (Parse_start * ps) SCM form; SCM answer = SCM_UNSPECIFIED; - /* Read expression from port */ + /* Read expression from port. */ if (!SCM_EOF_OBJECT_P (form = scm_read (port))) { + SCM function = ly_scheme_function ("make-safe-lilypond-module"); if (ps->safe_) - answer = scm_eval (form, - scm_call_0 (ly_scheme_function ("make-safe-lilypond-module"))); + answer = scm_eval (form, function); else answer = scm_primitive_eval (form); } @@ -60,10 +60,10 @@ catch_protected_parse_body (void *p) } SCM -parse_handler (void * data, SCM tag, SCM args) +parse_handler (void *data, SCM tag, SCM args) { - Parse_start* ps = (Parse_start*) data; - (void) tag; // prevent warning + Parse_start* ps = (Parse_start *) data; + (void) tag; ps->start_location_.error (_("GUILE signaled an error for the expression beginning here")); @@ -102,11 +102,12 @@ protected_ly_parse_scm (Parse_start *ps) bool parse_protect_global = true; -/* Try parsing. Upon failure return SCM_UNDEFINED. */ +/* Try parsing. Upon failure return SCM_UNDEFINED. + FIXME: shouldn't we return SCM_UNSCPECIFIED -- jcn */ SCM -ly_parse_scm (char const* s, int *n, Input i, bool safe) +ly_parse_scm (char const *s, int *n, Input i, bool safe) { - Parse_start ps ; + Parse_start ps; ps.str = s; ps.start_location_ = i; ps.safe_ = safe; diff --git a/lily/stem.cc b/lily/stem.cc index e359efb9eb..c7914a0540 100644 --- a/lily/stem.cc +++ b/lily/stem.cc @@ -36,7 +36,7 @@ #include "stem-tremolo.hh" void -Stem::set_beaming (Grob*me, int beam_count, Direction d) +Stem::set_beaming (Grob *me, int beam_count, Direction d) { SCM pair = me->get_property ("beaming"); @@ -46,39 +46,32 @@ Stem::set_beaming (Grob*me, int beam_count, Direction d) me->set_property ("beaming", pair); } - SCM l = index_get_cell (pair, d); - for (int i = 0; i< beam_count; i++) - { - l = scm_cons (scm_int2num (i), l); - } - index_set_cell (pair, d, l); + SCM lst = index_get_cell (pair, d); + for (int i = 0; i < beam_count; i++) + lst = scm_cons (scm_int2num (i), lst); + index_set_cell (pair, d, lst); } - Interval -Stem::head_positions (Grob*me) +Stem::head_positions (Grob *me) { - if (!head_count (me)) + if (head_count (me)) { - Interval iv; - return iv; + Drul_array e (extremal_heads (me)); + return Interval (Staff_symbol_referencer::get_position (e[DOWN]), + Staff_symbol_referencer::get_position (e[UP])); } - - Drul_array e (extremal_heads (me)); - - return Interval (Staff_symbol_referencer::get_position (e[DOWN]), - Staff_symbol_referencer::get_position (e[UP])); + return Interval (); } - Real Stem::chord_start_y (Grob *me) { Interval hp = head_positions (me); - if (hp.is_empty ()) - return 0; - return hp[get_direction (me)] * Staff_symbol_referencer::staff_space (me) - * 0.5; + if (!hp.is_empty ()) + return hp[get_direction (me)] * Staff_symbol_referencer::staff_space (me) + * 0.5; + return 0; } Real @@ -104,9 +97,9 @@ Stem::get_direction (Grob *me) if (!d) { - d = get_default_dir (me); - // urg, AAARGH! - set_grob_direction (me, d); + d = get_default_dir (me); + // urg, AAARGH! + set_grob_direction (me, d); } return d; } @@ -115,7 +108,7 @@ void Stem::set_stemend (Grob *me, Real se) { // todo: margins - Direction d= get_direction (me); + Direction d = get_direction (me); if (d && d * head_positions (me)[get_direction (me)] >= se*d) me->warning (_ ("Weird stem size; check for narrow beams")); @@ -125,7 +118,7 @@ Stem::set_stemend (Grob *me, Real se) /* Note head that determines hshift for upstems WARNING: triggers direction */ -Grob* +Grob * Stem::support_head (Grob *me) { if (head_count (me) == 1) @@ -135,30 +128,30 @@ Stem::support_head (Grob *me) } int -Stem::head_count (Grob*me) +Stem::head_count (Grob *me) { - return Pointer_group_interface::count (me, "note-heads"); + return Pointer_group_interface::count (me, "note-heads"); } /* The note head which forms one end of the stem. WARNING: triggers direction */ -Grob* +Grob * Stem::first_head (Grob *me) { Direction d = get_direction (me); - if (!d) - return 0; - return extremal_heads (me)[-d]; + if (d) + return extremal_heads (me)[-d]; + return 0; } /* The note head opposite to the first head. */ -Grob* +Grob * Stem::last_head (Grob *me) { Direction d = get_direction (me); - if (!d) - return 0; - return extremal_heads (me)[d]; + if (d) + return extremal_heads (me)[d]; + return 0; } /* START is part where stem reaches `last' head. */ @@ -173,7 +166,8 @@ Stem::extremal_heads (Grob *me) Drul_array exthead; exthead[LEFT] = exthead[RIGHT] =0; - for (SCM s = me->get_property ("note-heads"); ly_c_pair_p (s); s = ly_cdr (s)) + for (SCM s = me->get_property ("note-heads"); ly_c_pair_p (s); + s = ly_cdr (s)) { Grob *n = unsmob_grob (ly_car (s)); int p = Staff_symbol_referencer::get_rounded_position (n); @@ -181,7 +175,7 @@ Stem::extremal_heads (Grob *me) Direction d = LEFT; do { - if (d* p > d* extpos[d]) + if (d * p > d * extpos[d]) { exthead[d] = n; extpos[d] = p; @@ -202,9 +196,10 @@ Array Stem::note_head_positions (Grob *me) { Array ps ; - for (SCM s = me->get_property ("note-heads"); ly_c_pair_p (s); s = ly_cdr (s)) + for (SCM s = me->get_property ("note-heads"); ly_c_pair_p (s); + s = ly_cdr (s)) { - Grob * n = unsmob_grob (ly_car (s)); + Grob *n = unsmob_grob (ly_car (s)); int p = Staff_symbol_referencer::get_rounded_position (n); ps.push (p); @@ -250,7 +245,7 @@ Stem::get_default_dir (Grob *me) } Real -Stem::get_default_stem_end_position (Grob*me) +Stem::get_default_stem_end_position (Grob *me) { Real ss = Staff_symbol_referencer::staff_space (me); int durlog = duration_log (me); @@ -266,7 +261,7 @@ Stem::get_default_stem_end_position (Grob*me) { s = me->get_property ("lengths"); if (ly_c_pair_p (s)) - length = 2* ly_scm2double (robust_list_ref (durlog -2, s)); + length = 2 * ly_scm2double (robust_list_ref (durlog - 2, s)); } /* URGURGURG @@ -310,9 +305,9 @@ Stem::get_default_stem_end_position (Grob*me) if (durlog >= 3) { - Interval flag_ext = flag (me).extent (Y_AXIS) ; + Interval flag_ext = flag (me).extent (Y_AXIS); if (!flag_ext.is_empty ()) - minlen += 2 * flag_ext.length () / ss ; + minlen += 2 * flag_ext.length () / ss; /* The clash is smaller for down stems (since the tremolo is angled up.) */ @@ -342,8 +337,7 @@ Stem::get_default_stem_end_position (Grob*me) if (dots) { Real dp = Staff_symbol_referencer::get_position (dots); - Real flagy = flag (me).extent (Y_AXIS)[-dir] * 2 - / ss; + Real flagy = flag (me).extent (Y_AXIS)[-dir] * 2 / ss; /* Very gory: add myself to the X-support of the parent, which should be a dot-column. */ @@ -365,27 +359,22 @@ Stem::get_default_stem_end_position (Grob*me) return st; } - - -/* - - the log of the duration (Number of hooks on the flag minus two) - */ +/* The log of the duration (Number of hooks on the flag minus two) */ int -Stem::duration_log (Grob*me) +Stem::duration_log (Grob *me) { SCM s = me->get_property ("duration-log"); return (ly_c_number_p (s)) ? ly_scm2int (s) : 2; } void -Stem::position_noteheads (Grob*me) +Stem::position_noteheads (Grob *me) { if (!head_count (me)) return; Link_array heads = - Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-heads"); + Pointer_group_interface__extract_grobs (me, (Grob*) 0, "note-heads"); heads.sort (compare_position); Direction dir =get_direction (me); @@ -393,20 +382,18 @@ Stem::position_noteheads (Grob*me) if (dir < 0) heads.reverse (); - Real thick = thickness (me); Grob *hed = support_head (me); Real w = Note_head::head_extent (hed,X_AXIS)[dir]; - for (int i=0; i < heads.size (); i++) - { - heads[i]->translate_axis (w - Note_head::head_extent (heads[i], X_AXIS)[dir], - X_AXIS); - } + for (int i = 0; i < heads.size (); i++) + heads[i]->translate_axis (w - Note_head::head_extent (heads[i], + X_AXIS)[dir], + X_AXIS); - bool parity= true; + bool parity = true; Real lastpos = Real (Staff_symbol_referencer::get_position (heads[0])); - for (int i=1; i < heads.size (); i ++) + for (int i = 1; i < heads.size (); i ++) { Real p = Staff_symbol_referencer::get_position (heads[i]); Real dy =fabs (lastpos- p); @@ -419,26 +406,26 @@ Stem::position_noteheads (Grob*me) { if (parity) { - Real l = Note_head::head_extent (heads[i], X_AXIS).length (); + Real ell = Note_head::head_extent (heads[i], X_AXIS).length (); Direction d = get_direction (me); /* - Reversed head should be shifted l-thickness, but this - looks too crowded, so we only shift l-0.5*thickness. + Reversed head should be shifted ell-thickness, but this + looks too crowded, so we only shift ell-0.5*thickness. This leads to assymetry: Normal heads overlap the stem 100% whereas reversed heads only overlaps the stem 50% - */ - Real reverse_overlap =0.5; - heads[i]->translate_axis ((l-thick*reverse_overlap) * d, X_AXIS); + Real reverse_overlap = 0.5; + heads[i]->translate_axis ((ell - thick * reverse_overlap) * d, + X_AXIS); if (is_invisible (me)) - heads[i]->translate_axis (-thick*(2 - reverse_overlap) * d , X_AXIS); + heads[i]->translate_axis (-thick * (2 - reverse_overlap) * d, + X_AXIS); - /* TODO: For some cases we should kern some more: when the @@ -466,8 +453,7 @@ MAKE_SCHEME_CALLBACK (Stem,before_line_breaking,1); SCM Stem::before_line_breaking (SCM smob) { - Grob*me = unsmob_grob (smob); - + Grob *me = unsmob_grob (smob); /* Do the calculations for visible stems, but also for invisible stems @@ -479,10 +465,8 @@ Stem::before_line_breaking (SCM smob) position_noteheads (me); } else - { - me->set_property ("print-function", SCM_EOL); - } - + me->set_property ("print-function", SCM_EOL); + return SCM_UNSPECIFIED; } @@ -496,7 +480,7 @@ SCM Stem::height (SCM smob, SCM ax) { Axis a = (Axis)ly_scm2int (ax); - Grob * me = unsmob_grob (smob); + Grob *me = unsmob_grob (smob); assert (a == Y_AXIS); SCM mol = me->get_uncached_stencil (); @@ -514,7 +498,7 @@ Stem::height (SCM smob, SCM ax) Stencil -Stem::flag (Grob*me) +Stem::flag (Grob *me) { /* TODO: maybe property stroke-style should take different values, e.g. "" (i.e. no stroke), "single" and "double" (currently, it's @@ -523,14 +507,10 @@ Stem::flag (Grob*me) SCM flag_style_scm = me->get_property ("flag-style"); if (ly_c_symbol_p (flag_style_scm)) - { - flag_style = ly_symbol2string (flag_style_scm); - } - + flag_style = ly_symbol2string (flag_style_scm); + if (flag_style == "no-flag") - { - return Stencil (); - } + return Stencil (); bool adjust = true; @@ -571,8 +551,8 @@ Stem::flag (Grob*me) --hwn. */ int p = Staff_symbol_referencer::get_rounded_position (me); - staffline_offs = Staff_symbol_referencer::on_staffline (me, p) ? - "1" : "0"; + staffline_offs = Staff_symbol_referencer::on_staffline (me, p) + ? "1" : "0"; } else { @@ -585,14 +565,12 @@ Stem::flag (Grob*me) } char dir = (get_direction (me) == UP) ? 'u' : 'd'; - String font_char = - flag_style + to_string (dir) + staffline_offs + to_string (duration_log (me)); + String font_char = flag_style + + to_string (dir) + staffline_offs + to_string (duration_log (me)); Font_metric *fm = Font_interface::get_default_font (me); Stencil flag = fm->find_by_name ("flags-" + font_char); if (flag.is_empty ()) - { - me->warning (_f ("flag `%s' not found", font_char)); - } + me->warning (_f ("flag `%s' not found", font_char)); SCM stroke_style_scm = me->get_property ("stroke-style"); if (ly_c_string_p (stroke_style_scm)) @@ -603,13 +581,9 @@ Stem::flag (Grob*me) String font_char = to_string (dir) + stroke_style; Stencil stroke = fm->find_by_name ("flags-" + font_char); if (stroke.is_empty ()) - { - me->warning (_f ("flag stroke `%s' not found", font_char)); - } + me->warning (_f ("flag stroke `%s' not found", font_char)); else - { - flag.add_stencil (stroke); - } + flag.add_stencil (stroke); } } @@ -627,34 +601,28 @@ Stem::dim_callback (SCM e, SCM ax) if (unsmob_grob (me->get_property ("beam")) || abs (duration_log (me)) <= 2) ; // TODO! else - { - r = flag (me).extent (X_AXIS) - + thickness (me)/2; - } + r = flag (me).extent (X_AXIS) + + thickness (me)/2; return ly_interval2scm (r); } Real -Stem::thickness (Grob* me) +Stem::thickness (Grob *me) { return ly_scm2double (me->get_property ("thickness")) * Staff_symbol_referencer::line_thickness (me); } -MAKE_SCHEME_CALLBACK (Stem,print,1); - +MAKE_SCHEME_CALLBACK (Stem, print, 1); SCM Stem::print (SCM smob) { - Grob*me = unsmob_grob (smob); + Grob *me = unsmob_grob (smob); Stencil mol; Direction d = get_direction (me); - /* - TODO: make the stem start a direction ? - - This is required to avoid stems passing in tablature chords... - */ + /* TODO: make the stem start a direction ? + This is required to avoid stems passing in tablature chords. */ Grob *lh = to_boolean (me->get_property ("avoid-note-head")) ? last_head (me) : lh = first_head (me); @@ -669,7 +637,6 @@ Stem::print (SCM smob) Interval stem_y (y1 ? y1); - // dy? Real dy = Staff_symbol_referencer::staff_space (me) * 0.5; @@ -711,57 +678,42 @@ Stem::print (SCM smob) /* move the stem to right of the notehead if it is up. */ -MAKE_SCHEME_CALLBACK (Stem,off_callback,2); +MAKE_SCHEME_CALLBACK (Stem, off_callback, 2); SCM Stem::off_callback (SCM element_smob, SCM) { Grob *me = unsmob_grob (element_smob); - - Real r=0; - - if (head_count (me) == 0) - { - return scm_make_real (0.0); - } - - if (Grob * f = first_head (me)) - { - Interval head_wid = Note_head::head_extent (f, X_AXIS); - - Real attach =0.0; - - if (is_invisible (me)) - { + Real r = 0.0; + + if (head_count (me)) + if (Grob *f = first_head (me)) + { + Interval head_wid = Note_head::head_extent (f, X_AXIS); + Real attach = 0.0; + + if (is_invisible (me)) attach = 0.0; - } - else + else attach = Note_head::stem_attachment_coordinate (f, X_AXIS); - - Direction d = get_direction (me); - - Real real_attach = head_wid.linear_combination (d * attach); - - r = real_attach; - - /* - If not centered: correct for stem thickness. - */ - if (attach) - { - Real rule_thick - = thickness (me); - r += - d * rule_thick * 0.5; - } - } + Direction d = get_direction (me); + Real real_attach = head_wid.linear_combination (d * attach); + r = real_attach; + + /* If not centered: correct for stem thickness. */ + if (attach) + { + Real rule_thick = thickness (me); + r += - d * rule_thick * 0.5; + } + } return scm_make_real (r); } - -Grob* -Stem::get_beam (Grob*me) +Grob * +Stem::get_beam (Grob *me) { - SCM b= me->get_property ("beam"); + SCM b = me->get_property ("beam"); return unsmob_grob (b); } @@ -907,10 +859,11 @@ Stem::beam_multiplicity (Grob *stem) /* FIXME: Too many properties */ -ADD_INTERFACE (Stem,"stem-interface", - "The stem represent the graphical stem. " - " In addition, it internally connects note heads, beams, tremolos. Rests " - " and whole notes have invisible stems.", +ADD_INTERFACE (Stem, "stem-interface", + "The stem represent the graphical stem. " + "In addition, it internally connects note heads, beams and" + "tremolos. " + "Rests and whole notes have invisible stems.", "tremolo-flag french-beaming " "avoid-note-head thickness " "stem-info beamed-lengths beamed-minimum-free-lengths " @@ -919,13 +872,11 @@ ADD_INTERFACE (Stem,"stem-interface", "note-heads direction length flag-style " "no-stem-extend stroke-style"); - - /****************************************************************/ Stem_info::Stem_info () { - ideal_y_ = shortest_y_ =0; + ideal_y_ = shortest_y_ = 0; dir_ = CENTER; } diff --git a/lily/time-signature-engraver.cc b/lily/time-signature-engraver.cc index 62f0fcac7d..60c9a63411 100644 --- a/lily/time-signature-engraver.cc +++ b/lily/time-signature-engraver.cc @@ -18,7 +18,7 @@ */ class Time_signature_engraver : public Engraver { - Item * time_signature_; + Item *time_signature_; SCM last_time_fraction_; protected: @@ -31,7 +31,7 @@ public: Time_signature_engraver::Time_signature_engraver () { - time_signature_ =0; + time_signature_ = 0; last_time_fraction_ = SCM_BOOL_F; } @@ -41,7 +41,7 @@ Time_signature_engraver::process_music () /* not rigorously safe, since the value might get GC'd and reallocated in the same spot */ - SCM fr= get_property ("timeSignatureFraction"); + SCM fr = get_property ("timeSignatureFraction"); if (!time_signature_ && last_time_fraction_ != fr && ly_c_pair_p (fr)) @@ -70,7 +70,7 @@ Time_signature_engraver::process_music () void Time_signature_engraver::stop_translation_timestep () { - time_signature_ =0; + time_signature_ = 0; } diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm index 57ddbc1ff8..fb1c34914e 100644 --- a/scm/framework-gnome.scm +++ b/scm/framework-gnome.scm @@ -4,29 +4,294 @@ ;;;; ;;;; (c) 2004 Jan Nieuwenhuizen -(define-module (scm framework-gnome) - :use-module (oop goops) - #:export ()) +;;;; See output-gnome.scm for usage information. -;;(define this-module (current-module)) + +(define-module (scm framework-gnome)) (use-modules (guile) (oop goops) (lily)) (use-modules + (ice-9 regex) (gnome gtk) - (gnome gtk gdk-event) - ;; - (scm output-gnome) - ) + (gnome gtk gdk-event)) ;; the name of the module will change to canvas rsn (if (resolve-module '(gnome gw canvas)) (use-modules (gnome gw canvas)) (use-modules (gnome gw libgnomecanvas))) - (define-public (output-framework-gnome outputter book scopes fields basename) - ;;(gnome-main book)))) - (ly:outputter-dump-stencil - outputter - (ly:make-stencil (list 'gnome-main book) '(0 . 0) '(0 . 0)))) + (if #t + (gnome-main book) + (ly:outputter-dump-stencil + outputter + (ly:make-stencil (list 'gnome-main book) '(0 . 0) '(0 . 0))))) + +;; WTF? -- jcn +;; Yay, I *finally* found it! +(define-public output-framework output-framework-gnome) + +(define SCROLLBAR-SIZE 20) +(define BUTTON-HEIGHT 25) +(define PANELS-HEIGHT 80) + +(define PIXELS-PER-UNIT 2) +(define OUTPUT-SCALE (* 2.5 PIXELS-PER-UNIT)) +(define-public output-scale OUTPUT-SCALE) + +(define (stderr string . rest) + ;; debugging + (if #f + (begin + (apply format (cons (current-error-port) (cons string rest))) + (force-output (current-error-port))))) + +(define-class () + (page-stencils ;;#:init-value '#() + #:init-keyword #:page-stencils #:accessor page-stencils) + (window #:init-value (make #:type 'toplevel) #:accessor window) + (scrolled #:init-value (make ) #:accessor scrolled) + (canvas #:init-value #f #:accessor canvas) + (page-number #:init-value 0 #:accessor page-number) + (pixels-per-unit #:init-value PIXELS-PER-UNIT #:accessor pixels-per-unit) + (text-items #:init-value '() #:accessor text-items) + (location #:init-value #f #:accessor location) + (item-locations #:init-value (make-hash-table 31) #:accessor item-locations) + (window-width #:init-keyword #:window-width #:accessor window-width) + (window-height #:init-keyword #:window-height #:accessor window-height) + (canvas-width #:init-keyword #:canvas-width #:accessor canvas-width) + (canvas-height #:init-keyword #:canvas-height #:accessor canvas-height)) + +(define-method (initialize (go )) + (let* ((button (make #:label "Exit")) + (next (make #:label "Next")) + (prev (make #:label "Previous")) + (vbox (make #:homogeneous #f)) + (hbox (make #:homogeneous #f))) + + (set-size-request (window go) (window-width go) (window-height go)) + + (set-size-request (scrolled go) (window-width go) (- (window-height go) + BUTTON-HEIGHT + SCROLLBAR-SIZE)) + + (new-canvas go) + + (add (window go) vbox) + (add vbox (scrolled go)) + + (add (scrolled go) (canvas go)) + + ;; buttons + (add vbox hbox) + (set-size-request hbox (window-width go) BUTTON-HEIGHT) + + ;; hmm? These are broken when using . + ;;(set-child-packing vbox hbox #f #f 0 'end) + ;;(set-child-packing hbox button #f #f 0 'end) + + (set-size-request button (quotient (window-width go) 2) BUTTON-HEIGHT) + + + (add hbox next) + (add hbox prev) + (add hbox button) + + ;; signals + (gtype-instance-signal-connect + button 'clicked (lambda (b) (gtk-main-quit))) + (gtype-instance-signal-connect + next 'clicked (lambda (b) (dump-page go (1+ (page-number go))))) + (gtype-instance-signal-connect + prev 'clicked (lambda (b) (dump-page go (1- (page-number go))))) + (gtype-instance-signal-connect + (window go) 'key-press-event key-press-event) + + (show-all (window go)))) + + +(define-public global-go #f) + +(define (gnome-main book) + (let* ((book-paper (ly:paper-book-book-paper book)) + (hsize (ly:output-def-lookup book-paper 'hsize)) + (vsize (ly:output-def-lookup book-paper 'vsize)) + (page-width (inexact->exact (ceiling (* OUTPUT-SCALE hsize)))) + (page-height (inexact->exact (ceiling (* OUTPUT-SCALE vsize)))) + ;;(page-width (inexact->exact (ceiling hsize))) + ;;(page-height (inexact->exact (ceiling vsize))) + + (screen-width (gdk-screen-width)) + (screen-height (gdk-screen-height)) + (desktop-height (- screen-height PANELS-HEIGHT)) + + (go (make + #:page-stencils (list->vector (ly:paper-book-pages book)) + #:canvas-width page-width + #:canvas-height page-height + #:window-width + ;; huh, *2 -- pixels-per-unit? + (min (+ SCROLLBAR-SIZE (* page-width 2)) screen-width) + #:window-height + (min (+ BUTTON-HEIGHT SCROLLBAR-SIZE (* page-height 2)) + desktop-height)))) + + ;; ugh. The GOOPS doc promises this is called automagically. + (initialize go) + + (dump-page go 0) + + ;; ugh + (set! global-go go) + + (gtk-main))) + +(define (dump-page go number) + (if (or (not (page-stencils go)) + (< number 0) + (>= number (vector-length (page-stencils go)))) + (stderr "No such page: ~S\n" (1+ number)) + + (let ((old-canvas (canvas go))) + (new-canvas go) + (set! (page-number go) number) + + ;; no destroy method for gnome-canvas-text? + ;;(map destroy (gtk-container-get-children main-canvas)) + ;;(map destroy text-items) + + (set! (text-items go) '()) + (stderr "page-stencil ~S: ~S\n" + (page-number go) + (vector-ref (page-stencils go) (page-number go))) + + (ly:interpret-stencil-expression + ;; ;;(vector-ref (page-stencils go) (page-number go)) + (ly:stencil-expr (vector-ref (page-stencils go) (page-number go))) + gnome-output-expression go '(0 . 0)) + + (if old-canvas (destroy old-canvas)) + (add (scrolled go) (canvas go)) + (show (canvas go))))) + +(define x-editor #f) +(define (get-x-editor) + (if (not x-editor) + (set! x-editor (getenv "XEDITOR"))) + x-editor) + +(define ifs #f) +(define (get-ifs) + (if (not ifs) + (set! ifs (getenv "IFS"))) + (if (not ifs) + (set! ifs " ")) + ifs) + +(define (spawn-editor location) + (let* ((line (car location)) + (column (cadr location)) + (file-name (caddr location)) + (template (substring (get-x-editor) 0)) + + ;; Adhere to %l %c %f? + (command + (regexp-substitute/global + #f "%l" (regexp-substitute/global + #f "%c" + (regexp-substitute/global + #f "%f" template 'pre file-name 'post) + 'pre (number->string column) + 'post) + 'pre (number->string line) 'post))) + + (stderr "spawning: ~s\n" command) + (if (= (primitive-fork) 0) + (let ((command-list (string-split command #\ )));; (get-ifs)))) + (apply execlp command-list) + (primitive-exit))))) + +(define location-callback spawn-editor) + +;;(define (item-event item event . data) +(define-public (item-event item event . data) + (case (gdk-event:type event) + ((enter-notify) (gobject-set-property item 'fill-color "red")) + ((leave-notify) (gobject-set-property item 'fill-color "black")) + ((button-press) + + ;;FIXME + (let ((location (hashq-ref (item-locations global-go) item #f))) + + (if location + (location-callback location) + (stderr "no location\n")))) + ((2button-press) (gobject-set-property item 'fill-color "red"))) + #t) + +(define (scale-canvas factor) + (set! pixels-per-unit (* pixels-per-unit factor)) + (set-pixels-per-unit main-canvas pixels-per-unit) + (for-each + (lambda (x) + (let ((scale (gobject-get-property x 'scale)) + (points (gobject-get-property x 'size-points))) + ;;(gobject-set-property x 'scale pixels-per-unit) + (gobject-set-property x 'size-points (* points factor)))) + text-items)) + +(define (key-press-event item event . data) + (let ((keyval (gdk-event-key:keyval event)) + (mods (gdk-event-key:modifiers event))) + (cond ((and (or (eq? keyval gdk:q) + (eq? keyval gdk:w)) + (equal? mods '(control-mask modifier-mask))) + (gtk-main-quit)) + ((and #t ;;(null? mods) + (eq? keyval gdk:plus)) + (scale-canvas 2)) + ((and #t ;; (null? mods) + (eq? keyval gdk:minus)) + (scale-canvas 0.5)) + ((or (eq? keyval gdk:Page-Up) + (eq? keyval gdk:BackSpace)) + ;;FIXME + (dump-page global-go (1- (page-number global-go)))) + ((or (eq? keyval gdk:Page-Down) + (eq? keyval gdk:space)) + ;;FIXME + (dump-page global-go (1+ (page-number global-go))))) + #f)) + +(define (new-canvas go) + (set! (canvas go) (make )) + (set-size-request (canvas go) (window-width go) (window-height go)) + (set-scroll-region (canvas go) 0 0 (canvas-width go) (canvas-height go)) + (set-pixels-per-unit (canvas go) (pixels-per-unit go)) + (make + #:parent (root (canvas go)) + #:x2 (canvas-width go) #:y2 (canvas-height go) + #:fill-color "white")) + +(define output-gnome-module #f) +(define (get-output-gnome-module go) + (if (not output-gnome-module) + (let ((m (resolve-module '(scm output-gnome)))) + (module-define! m 'canvas-root (lambda () (root (canvas go)))) + (module-define! m 'output-scale output-scale) + (set! output-gnome-module m))) + output-gnome-module) + +(define-public (gnome-output-expression go expr) + (let* ((m (get-output-gnome-module go)) + (result (eval expr m))) + (cond + ((and (pair? result) + (eq? (car result) 'location)) + (set! (location go) (cdr result))) + ((is-a? result ) + (gtype-instance-signal-connect result 'event item-event) + (if (location go) + (hashq-set! (item-locations go) result (location go))))))) + diff --git a/scm/lily.scm b/scm/lily.scm index e33299fbe1..fc3018e313 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -374,6 +374,8 @@ L1 is copied, L2 not. ;; output +;;(define-public (output-framework) (write "hello\n")) + (define output-tex-module (make-module 1021 (list (resolve-interface '(scm output-tex))))) (define output-ps-module @@ -382,7 +384,43 @@ L1 is copied, L2 not. (define-public (ps-output-expression expr port) (display (eval expr output-ps-module) port)) +;; TODO: generate this list by registering the stencil expressions +;; stencil expressions should have docstrings. +(define-public (ly:all-stencil-expressions) + "Return list of stencil expressions." + '( + beam + bezier-sandwich + blank + bracket + char + dashed-line + dashed-slur + dot + draw-line + ez-ball + filledbox + horizontal-line + polygon + repeat-slash + round-filled-box + symmetric-x-triangle + text + tuplet + zigzag-line + )) +;; TODO: generate this list by registering the output-backend-commands +;; output-backend-commands should have docstrings. +(define-public (ly:all-output-backend-commands) + "Return list of output backend commands." + '( + comment + define-origin + no-origin + placebox + unknown + )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; other files. @@ -501,34 +539,23 @@ L1 is copied, L2 not. " ") "\n"))) protects)) - outfile) + outfile))) - )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (lilypond-main files) - "Entry point for Lilypond" - (let* - ((failed '()) - (handler (lambda (key arg) - (set! failed (cons arg failed)))) - ) - + "Entry point for LilyPond." + (let* ((failed '()) + (handler (lambda (key arg) (set! failed (cons arg failed))))) (for-each - (lambda (fn) - (catch 'ly-file-failed - (lambda () (ly:parse-file fn)) - handler)) - - files) + (lambda (f) (catch 'ly-file-failed (lambda () (ly:parse-file f)) handler)) + files) (if (pair? failed) (begin - (display (string-append "\n *** Failed files: " (string-join failed) "\n" )) + (display + (string-append "\n *** Failed files: " (string-join failed) "\n")) (exit 1)) - (exit 0)) - - )) - + (exit 0)))) diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 080660ae7f..972a50c703 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -47,7 +47,6 @@ export XEDITOR='/usr/bin/emacsclient --no-wait +%l:%c %f' lilypond-bin -fgnome input/simple-song.ly " - ;;; TODO: ;;; * pango+feta font (see archives gtk-i18n-list@gnome.org and ;;; lilypond-devel) @@ -58,101 +57,39 @@ lilypond-bin -fgnome input/simple-song.ly ;;; * implement missing stencil functions ;;; * implement missing commands ;;; * user-interface, keybindings -;;; * cleanups: (too many) global vars ;;; * papersize, outputscale from book ;;; SCRIPT moved to buildscripts/guile-gnome.sh -(debug-enable 'backtrace) -;;(define-module (scm output-gnome)) -(define-module (scm output-gnome) - #:export ( - char - comment - define-origin - filledbox - horizontal-line - no-origin - placebox - round-filled-box - text - )) +(debug-enable 'backtrace) +(define-module (scm output-gnome)) (define this-module (current-module)) (use-modules (guile) - (ice-9 regex) (srfi srfi-13) (lily) - (gnome gtk) - (gnome gtk gdk-event) - - ;; Hmm, is not imported -- but trying this breaks - ;; framework-gnome in a weird way. - ;;(scm framework-gnome)) - ) + (gnome gtk)) ;; the name of the module will change to canvas rsn (if (resolve-module '(gnome gw canvas)) (use-modules (gnome gw canvas)) (use-modules (gnome gw libgnomecanvas))) -;; ughughughughu ughr huh?? -- defined in framework-gnome -(define PIXELS-PER-UNIT 2) -(define-class () - (page-stencils ;;#:init-value '#() - #:init-keyword #:page-stencils #:accessor page-stencils) - (window #:init-value (make #:type 'toplevel) #:accessor window) - (scrolled #:init-value (make ) #:accessor scrolled) - (canvas #:init-value #f #:accessor canvas) - (page-number #:init-value 0 #:accessor page-number) - (pixels-per-unit #:init-value PIXELS-PER-UNIT #:accessor pixels-per-unit) - (text-items #:init-value '() #:accessor text-items) - (location #:init-value #:f #:accessor location) - (item-locations #:init-value (make-hash-table 31) #:accessor item-locations) - (window-width #:init-keyword #:window-width #:accessor window-width) - (window-height #:init-keyword #:window-height #:accessor window-height) - (canvas-width #:init-keyword #:canvas-width #:accessor canvas-width) - (canvas-height #:init-keyword #:canvas-height #:accessor canvas-height)) - - -(define (dummy . foo) #f) - -;; minimal intercept list: -(define output-interface-intercept - '(comment - define-origin - no-origin)) - -(map (lambda (x) (module-define! this-module x dummy)) - output-interface-intercept) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; globals +(define system-origin '(0 . 0)) -;;; output-scale and font-size fun -;; This used to be: -(define USED-TO-BE-OUTPUT-SCALE 2.83464566929134) -;; However, it seems that we currently have: -(define 2.3.4-OUTPUT-SCALE 1.75729901757299) -;; to go from ly-units to -;; Hmm, is this the source of font size problems wrt titling's right margin? - -;;(define pixels-per-unit 1.0) -;;(define ARBITRARY-OUTPUT-SCALE 5) - -;; Anyway, for on-screen this does not matter: 2 * 2.5 looks fine -(define pixels-per-unit 2.0) -(define ARBITRARY-OUTPUT-SCALE 2.5) - -;;(define output-scale (* OUTPUT-SCALE pixels-per-unit)) -(define output-scale (* ARBITRARY-OUTPUT-SCALE pixels-per-unit)) - +;;; set by framework-gnome.scm: +(define canvas-root #f) +(define output-scale #f) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; helper functions -;; helper functions -- sort this out (define (stderr string . rest) ;; debugging (if #f @@ -184,18 +121,24 @@ lilypond-bin -fgnome input/simple-song.ly (define (draw-rectangle x1 y1 x2 y2 color width-units) (make - #:parent (root (canvas global-go)) #:x1 x1 #:y1 y1 #:x2 x2 #:y2 y2 + #:parent (canvas-root) #:x1 x1 #:y1 y1 #:x2 x2 #:y2 y2 #:fill-color color #:width-units width-units)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; stencil outputters -;;;; +;;; stencil outputters +;;; + +(define (dummy . foo) #f) + +(map (lambda (x) (module-define! this-module x dummy)) + (append + (ly:all-stencil-expressions) + (ly:all-output-backend-commands))) (define (char font i) (text font (utf8 i))) -(define system-origin '(0 . 0)) (define (placebox x y expr) (stderr "item: ~S\n" expr) (let ((item expr)) @@ -207,10 +150,6 @@ lilypond-bin -fgnome input/simple-song.ly (* output-scale (+ (car system-origin) x)) (* output-scale (- (car system-origin) y))) (affine-relative item output-scale 0 0 output-scale 0 0) - - (gtype-instance-signal-connect item 'event item-event) - (if (location global-go) - (hashq-set! (item-locations global-go) item (location global-go))) item) #f))) @@ -264,34 +203,31 @@ lilypond-bin -fgnome input/simple-song.ly (stderr "pango-font-name: ~S\n" (pango-font-name font)) (stderr "pango-font-size: ~S\n" (pango-font-size font)) - (let ((item - (make - #:parent (root (canvas global-go)) - - ;; experimental text placement corrections. - ;; UGHR? What happened to tex offsets? south-west? - ;; is pango doing something 'smart' wrt baseline ? - #:anchor 'south-west - #:x 0.003 #:y 0.123 - - ;; - ;;#:anchor 'west - ;;#:x 0.015 #:y -3.71 - - #:font (pango-font-name font) - - #:size-points (pango-font-size font) - ;;#:size ... - #:size-set #t - - ;;apparently no effect :-( - ;;#:scale 1.0 - ;;#:scale-set #t - - #:fill-color "black" - #:text string))) - (set! (text-items global-go) (cons item (text-items global-go))) - item)) + + (make + #:parent (canvas-root) + + ;; experimental text placement corrections. + ;; UGHR? What happened to tex offsets? south-west? + ;; is pango doing something 'smart' wrt baseline ? + #:anchor 'south-west + #:x 0.003 #:y 0.123 + + ;;#:anchor 'west + ;;#:x 0.015 #:y -3.71 + + #:font (pango-font-name font) + + #:size-points (pango-font-size font) + ;;#:size ... + #:size-set #t + + ;;apparently no effect :-( + ;;#:scale 1.0 + ;;#:scale-set #t + + #:fill-color "black" + #:text string)) (define (filledbox a b c d) (round-filled-box a b c d 0.001)) @@ -301,275 +237,9 @@ lilypond-bin -fgnome input/simple-song.ly ;;(let ((thickness 2)) (filledbox (- x1) (- x2 x1) (* .5 thickness) (* .5 thickness))) -;; origin -- bad name (define (define-origin file line col) - ;; ughr, why is this not passed as [part of] stencil object - (set! (location global-go) (if (procedure? point-and-click) - ;; duh, only silly string append - ;; (point-and-click line col file) - (list line col file) - #f))) - - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; gnome stuff --- move to framework-gnome -;;(define (dump-page (go ) number) - - - -(define SCROLLBAR-SIZE 20) -(define BUTTON-HEIGHT 25) -(define PANELS-HEIGHT 80) - -(define PIXELS-PER-UNIT 2) -(define OUTPUT-SCALE (* 2.5 PIXELS-PER-UNIT)) - -;; helper functions -- sort this out -(define (stderr string . rest) - ;; debugging - (if #t - (begin - (apply format (cons (current-error-port) (cons string rest))) - (force-output (current-error-port))))) - - -;; Hmm, actually, the only vars really needed by output-gnome are -;; * (root (canvas go)) -;; * location -;; * item-locations -;; * pixels-per-unit -;; * text-items -;; -;; so this class could be split in two parts / records? -(define-class () - (page-stencils ;;#:init-value '#() - #:init-keyword #:page-stencils #:accessor page-stencils) - (window #:init-value (make #:type 'toplevel) #:accessor window) - (scrolled #:init-value (make ) #:accessor scrolled) - (canvas #:init-value #f #:accessor canvas) - (page-number #:init-value 0 #:accessor page-number) - (pixels-per-unit #:init-value PIXELS-PER-UNIT #:accessor pixels-per-unit) - (text-items #:init-value '() #:accessor text-items) - (location #:init-value #:f #:accessor location) - (item-locations #:init-value (make-hash-table 31) #:accessor item-locations) - (window-width #:init-keyword #:window-width #:accessor window-width) - (window-height #:init-keyword #:window-height #:accessor window-height) - (canvas-width #:init-keyword #:canvas-width #:accessor canvas-width) - (canvas-height #:init-keyword #:canvas-height #:accessor canvas-height)) - -;;(define-method (initialize (go )) -;; ) - - -(define (gnome-main book) - (let* ((book-paper (ly:paper-book-book-paper book)) - (hsize (ly:output-def-lookup book-paper 'hsize)) - (vsize (ly:output-def-lookup book-paper 'vsize)) - (page-width (inexact->exact (ceiling (* OUTPUT-SCALE hsize)))) - (page-height (inexact->exact (ceiling (* OUTPUT-SCALE vsize)))) - ;;(page-width (inexact->exact (ceiling hsize))) - ;;(page-height (inexact->exact (ceiling vsize))) - - (screen-width (gdk-screen-width)) - (screen-height (gdk-screen-height)) - (desktop-height (- screen-height PANELS-HEIGHT)) - - (go (make - #:page-stencils (list->vector (ly:paper-book-pages book)) - #:canvas-width page-width - #:canvas-height page-height - #:window-width - ;; huh, *2 -- pixels-per-unit? - (min (+ SCROLLBAR-SIZE (* page-width 2)) screen-width) - #:window-height - (min (+ BUTTON-HEIGHT SCROLLBAR-SIZE (* page-height 2)) - desktop-height)))) - - (setup go) - (dump-page go 0) - (gtk-main))) - -(define (setup go) - (let* ((button (make #:label "Exit")) - (next (make #:label "Next")) - (prev (make #:label "Previous")) - (vbox (make #:homogeneous #f)) - (hbox (make #:homogeneous #f))) - - (set-size-request (window go) (window-width go) (window-height go)) - - (new-canvas go) - - (add (window go) vbox) - (add vbox (scrolled go)) - - (add (scrolled go) (canvas go)) - - ;; buttons - (add vbox hbox) - (set-size-request hbox (window-width go) BUTTON-HEIGHT) - - ;; hmm? - ;;(set-child-packing vbox hbox #f #f 0 'end) - ;;(set-child-packing hbox button #f #f 0 'end) - - (set-size-request button (quotient (window-width go) 2) BUTTON-HEIGHT) - (add hbox next) - (add hbox prev) - (add hbox button) - - ;; signals - (gtype-instance-signal-connect - button 'clicked (lambda (b) (gtk-main-quit))) - (gtype-instance-signal-connect - next 'clicked (lambda (b) (dump-page go (1+ (page-number go))))) - (gtype-instance-signal-connect - prev 'clicked (lambda (b) (dump-page go (1- (page-number go))))) - (gtype-instance-signal-connect - (window go) 'key-press-event key-press-event) - - (show-all (window go)))) - -(define (dump-page go number) - (if (or (not (page-stencils go)) - (< number 0) - (>= number (vector-length (page-stencils go)))) - (stderr "No such page: ~S\n" (1+ number)) - - (let ((old-canvas (canvas go))) - (new-canvas go) - (set! (page-number go) number) - - ;; no destroy method for gnome-canvas-text? - ;;(map destroy (gtk-container-get-children main-canvas)) - ;;(map destroy text-items) - - ;;Hmm - ;;(set! main-canvas canvas) - (set! (text-items go) '()) - ;;(ly:outputter-dump-stencil (outputter go) - ;; (vector-ref page-stencils page-number)) - - (stderr "page-stencil ~S: ~S\n" - (page-number go) - (vector-ref (page-stencils go) (page-number go))) - - (ly:interpret-stencil-expression - ;; ;;(vector-ref (page-stencils go) (page-number go)) - (ly:stencil-expr (vector-ref (page-stencils go) (page-number go))) - gnome-output-expression go '(0 . 0)) - ;; ;;(lambda (x) (gnome-output-expression go x)) '(0 . 0)) - - (if old-canvas (destroy old-canvas)) - (add (scrolled go) (canvas go)) - (show (canvas go))))) - -(define x-editor #f) -(define (get-x-editor) - (if (not x-editor) - (set! x-editor (getenv "XEDITOR"))) - x-editor) - -(define ifs #f) -(define (get-ifs) - (if (not ifs) - (set! ifs (getenv "IFS"))) - (if (not ifs) - (set! ifs " ")) - ifs) - -(define (spawn-editor location) - (let* ((line (car location)) - (column (cadr location)) - (file-name (caddr location)) - (template (substring (get-x-editor) 0)) - - ;; Adhere to %l %c %f? - (command - (regexp-substitute/global - #f "%l" (regexp-substitute/global - #f "%c" - (regexp-substitute/global - #f "%f" template 'pre file-name 'post) - 'pre (number->string column) - 'post) - 'pre (number->string line) 'post))) - - (stderr "spawning: ~s\n" command) - (if (= (primitive-fork) 0) - (let ((command-list (string-split command #\ )));; (get-ifs)))) - (apply execlp command-list) - (primitive-exit))))) - -(define location-callback spawn-editor) - -(define (item-event item event . data) - (case (gdk-event:type event) - ((enter-notify) (gobject-set-property item 'fill-color "red")) - ((leave-notify) (gobject-set-property item 'fill-color "black")) - ((button-press) - (let ((location (hashq-ref item-locations item #f))) - (if location - (location-callback location) - (stderr "no location\n")))) - ((2button-press) (gobject-set-property item 'fill-color "red"))) - #t) - -(define (scale-canvas factor) - (set! pixels-per-unit (* pixels-per-unit factor)) - (set-pixels-per-unit main-canvas pixels-per-unit) - (for-each - (lambda (x) - (let ((scale (gobject-get-property x 'scale)) - (points (gobject-get-property x 'size-points))) - ;;(gobject-set-property x 'scale pixels-per-unit) - (gobject-set-property x 'size-points (* points factor)))) - text-items)) - -(define (key-press-event item event . data) - (let ((keyval (gdk-event-key:keyval event)) - (mods (gdk-event-key:modifiers event))) - (cond ((and (or (eq? keyval gdk:q) - (eq? keyval gdk:w)) - (equal? mods '(control-mask modifier-mask))) - (gtk-main-quit)) - ((and #t ;;(null? mods) - (eq? keyval gdk:plus)) - (scale-canvas 2)) - ((and #t ;; (null? mods) - (eq? keyval gdk:minus)) - (scale-canvas 0.5)) - ((or (eq? keyval gdk:Page-Up) - (eq? keyval gdk:BackSpace)) - (dump-page (1- page-number))) - ((or (eq? keyval gdk:Page-Down) - (eq? keyval gdk:space)) - (dump-page (1+ page-number)))) - #f)) - -;;(define (new-canvas go ) -(define (new-canvas go) - (set! (canvas go) (make )) - (set-size-request (canvas go) (window-width go) (window-height go)) - (set-scroll-region (canvas go) 0 0 (canvas-width go) (canvas-height go)) - (set-pixels-per-unit (canvas go) (pixels-per-unit go)) - (make - #:parent (root (canvas go)) - #:x2 (canvas-width go) #:y2 (canvas-height go) - #:fill-color "white")) - - -;;(define output-gnome-module -;; ;;(make-module 1021 (list (resolve-interface '(scm output-gnome))))) -;; this-module) - -(define global-go #f) - -(define-public (gnome-output-expression go expr) - (stderr "HI\n") - (set! global-go go) - (eval expr this-module)) - - + (if (procedure? point-and-click) + ;; duh, only silly string append + ;; (point-and-click line col file) + (list 'location line col file) + #f)) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 4179873e98..4b2619a632 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -17,6 +17,13 @@ (define-module (scm output-ps) #:re-export (quote) + + ;; FIXME + ;;; : Wrong type argument in position 2 (expecting SYMBOLP): (append (ly:all-stencil-expressions) (ly:all-output-backend-commands)) + ;;#:export ,(append (ly:all-stencil-expressions) + ;; (ly:all-output-backend-commands))) + +; ;; UGHXr #:export (unknown blank dot @@ -43,6 +50,7 @@ no-origin )) + (use-modules (guile) (ice-9 regex) (srfi srfi-1) @@ -50,6 +58,15 @@ (scm framework-ps) (lily)) + +;;(map export +;; (append (ly:all-stencil-expressions) (ly:all-output-backend-commands))) + +;; huh? +;;(write (ly:all-output-backend-commands)) +;;(write (ly:all-stencil-expressions)) + + ;;; helper functions, not part of output interface (define (escape-parentheses s) (regexp-substitute/global #f "(^|[^\\])([\\(\\)])" s 'pre 1 "\\" 2 'post)) diff --git a/scm/output-tex.scm b/scm/output-tex.scm index 0943751436..7bc8253ab0 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -3,14 +3,21 @@ ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 1998--2004 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; Han-Wen Nienhuys ;; (debug-enable 'backtrace) -;; the public interface is tight. +;; The public interface is tight. ;; It has to be, because user-code is evalled with this module. +;; ***It should also be clean, well defined, documented and reviewed*** + +;; To be reasonably safe, you probably do not want to use the TeX +;; backend anyway, but rather the PostScript backend. You may want +;; to run gs in a uml sandbox too. + + (define-module (scm output-tex) #:re-export (quote) #:export (unknown diff --git a/scm/safe-lily.scm b/scm/safe-lily.scm index f0dbaab503..10e88ad7ec 100644 --- a/scm/safe-lily.scm +++ b/scm/safe-lily.scm @@ -1,11 +1,18 @@ +;;;; safe-lily.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2004 Han-Wen Nienhuys + (define safe-objects - (map (lambda (sym) - (cons sym (primitive-eval sym))) + (cons sym (primitive-eval sym))) '(ly:add-interface ly:add-moment ly:all-grob-interfaces + ly:all-output-backend-commands + ly:all-stencil-expressions ly:bracket ly:context-find ly:context-id @@ -140,14 +147,14 @@ ly:warn ;; need these for parsing init files: - ;; todo: should have a macro define-safe-public - DOUBLE-FLAT - THREE-Q-FLAT - FLAT - SEMI-FLAT - NATURAL - SEMI-SHARP - SHARP + ;; todo: should have a macro define-safe-public + DOUBLE-FLAT + THREE-Q-FLAT + FLAT + SEMI-FLAT + NATURAL + SEMI-SHARP + SHARP THREE-Q-SHARP DOUBLE-SHARP SEMI-TONE @@ -274,17 +281,9 @@ Vaticana_ligature::brew_ligature_primitive Vaticana_ligature::print Volta_bracket_interface::print - - - - ))) (define-public (make-safe-lilypond-module) - (let* - ((m (make-safe-module))) - (for-each - (lambda (p) (module-define! m (car p) (cdr p))) - safe-objects) + (let* ((m (make-safe-module))) + (for-each (lambda (p) (module-define! m (car p) (cdr p))) safe-objects) m)) - -- 2.39.5