From: Han-Wen Nienhuys <hanwen@xs4all.nl> Date: Tue, 9 Jan 2007 14:52:21 +0000 (+0100) Subject: Coverage fixes: remove tweak registration/application, gnome backend, X-Git-Tag: release/2.11.11-1~36 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=801b2c64360b181dabe76d02bb001b88e2643bb6;p=lilypond.git Coverage fixes: remove tweak registration/application, gnome backend, object key dumper/undumper. --- diff --git a/lily/auto-beam-engraver.cc b/lily/auto-beam-engraver.cc index f98f5a110a..073aec59f2 100644 --- a/lily/auto-beam-engraver.cc +++ b/lily/auto-beam-engraver.cc @@ -186,8 +186,7 @@ Auto_beam_engraver::create_beam () Can't use make_spanner_from_properties() because we have to use beam_settings_. */ - Spanner *beam = new Spanner (beam_settings_, - context ()->get_grob_key ("Beam")); + Spanner *beam = new Spanner (beam_settings_, 0); for (vsize i = 0; i < stems_->size (); i++) Beam::add_stem (beam, (*stems_)[i]); diff --git a/lily/context-key-manager.cc b/lily/context-key-manager.cc deleted file mode 100644 index 9dd8251138..0000000000 --- a/lily/context-key-manager.cc +++ /dev/null @@ -1,100 +0,0 @@ -/* - context-key-manager.cc -- implement Context_key_manager - - source file of the GNU LilyPond music typesetter - - (c) 2006--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> - -*/ - -#include "context-key-manager.hh" -#include "object-key.hh" -#include "lilypond-key.hh" -#include "main.hh" - -Context_key_manager::Context_key_manager (Object_key const *key) -{ - key_ = key; -} - -void -Context_key_manager::unprotect () const -{ - if (key_) - ((Object_key *)key_)->unprotect (); -} - - -Object_key const * -Context_key_manager::get_context_key (Moment now, string type, string id) -{ - if (!use_object_keys) - return 0; - - string now_key = type + "@" + id; - - int disambiguation_count = 0; - if (context_counts_.find (now_key) != context_counts_.end ()) - disambiguation_count = context_counts_[now_key]; - - context_counts_[now_key] = disambiguation_count + 1; - - return new Lilypond_context_key (key (), - now, - type, id, - disambiguation_count); -} - - -Object_key const * -Context_key_manager::get_grob_key (Moment m, string name) -{ - if (!use_object_keys) - return 0; - - return create_grob_key (m, name); -} - -/* - We want to have a key for some objects anyway, so we can invent a - unique identifier for each (book,score) tuple. -*/ -Object_key const * -Context_key_manager::create_grob_key (Moment now, string name) -{ - int disambiguation_count = 0; - if (grob_counts_.find (name) != grob_counts_.end ()) - disambiguation_count = grob_counts_[name]; - grob_counts_[name] = disambiguation_count + 1; - - Object_key *k = new Lilypond_grob_key (key (), - now, - name, - disambiguation_count); - - return k; -} - -void -Context_key_manager::gc_mark () const -{ - if (key_) - scm_gc_mark (key_->self_scm ()); - -} - -void -Context_key_manager::clear () -{ - if (!use_object_keys) - return; - - grob_counts_.clear (); - context_counts_.clear (); -} - -Context_key_manager::Context_key_manager (Context_key_manager const &src) -{ - (void)src; - assert (false); -} diff --git a/lily/context.cc b/lily/context.cc index 8a0fbade98..53bca3b07b 100644 --- a/lily/context.cc +++ b/lily/context.cc @@ -47,7 +47,6 @@ Context::check_removal () } Context::Context (Context const &src) - : key_manager_ (src.key_manager_) { assert (false); } @@ -70,7 +69,6 @@ Context::add_context (Context *child) Context::Context (Object_key const *key) - : key_manager_ (key) { daddy_context_ = 0; aliases_ = SCM_EOL; @@ -92,12 +90,6 @@ Context::Context (Object_key const *key) event_source_->unprotect (); events_below_ = new Dispatcher (); events_below_->unprotect (); - - /* - UGH UGH - const correctness. - */ - key_manager_.unprotect(); } /* TODO: this shares code with find_create_context (). */ @@ -267,7 +259,7 @@ Context::create_context_from_event (SCM sev) SCM ops = ev->get_property ("ops"); SCM type_scm = ev->get_property ("type"); string type = ly_symbol2string (type_scm); - Object_key const *key = key_manager_.get_context_key (now_mom(), type, id); + Object_key const *key = 0; vector<Context_def*> path = unsmob_context_def (definition_)->path_to_acceptable_context (type_scm, get_output_def ()); @@ -629,23 +621,10 @@ Context::print_smob (SCM s, SCM port, scm_print_state *) return 1; } -Object_key const * -Context::get_grob_key (string name) -{ - return key_manager_.get_grob_key (now_mom (), name); -} - -Object_key const * -Context::get_context_key (string name, string id) -{ - return key_manager_.get_context_key (now_mom (), name, id); -} - SCM Context::mark_smob (SCM sm) { Context *me = (Context *) SCM_CELL_WORD_1 (sm); - me->key_manager_.gc_mark(); scm_gc_mark (me->context_list_); scm_gc_mark (me->aliases_); @@ -689,17 +668,6 @@ Context::get_parent_context () const return daddy_context_; } -void -Context::clear_key_disambiguations () -{ - if (!use_object_keys) - return; - - key_manager_.clear (); - for (SCM s = context_list_; scm_is_pair (s); s = scm_cdr (s)) - unsmob_context (scm_car (s))->clear_key_disambiguations (); -} - /* Ugh. Where to put this? */ diff --git a/lily/engraver.cc b/lily/engraver.cc index 7d67363c54..f5fe392b13 100644 --- a/lily/engraver.cc +++ b/lily/engraver.cc @@ -115,7 +115,7 @@ Engraver::internal_make_grob (SCM symbol, SCM cause, char const *name, char cons SCM props = updated_grob_properties (context (), symbol); - Object_key const *key = context ()->get_grob_key (name); + Object_key const *key = 0; Grob *grob = 0; SCM handle = scm_sloppy_assq (ly_symbol2scm ("meta"), props); diff --git a/lily/global-context.cc b/lily/global-context.cc index 6484f9b4b9..6bfbe20454 100644 --- a/lily/global-context.cc +++ b/lily/global-context.cc @@ -92,8 +92,6 @@ Global_context::prepare (SCM sev) else prev_mom_ = now_mom_; now_mom_ = *mom; - - clear_key_disambiguations (); } Moment diff --git a/lily/grob.cc b/lily/grob.cc index 57f8621dc5..02bf6a1b50 100644 --- a/lily/grob.cc +++ b/lily/grob.cc @@ -79,7 +79,7 @@ Grob::Grob (SCM basicprops, Grob::Grob (Grob const &s, int copy_index) : dim_cache_ (s.dim_cache_) { - key_ = (use_object_keys) ? new Copied_key (s.key_, copy_index) : 0; + key_ = 0; // (use_object_keys) ? new Copied_key (s.key_, copy_index) : 0; original_ = (Grob *) & s; self_scm_ = SCM_EOL; diff --git a/lily/include/context-key-manager.hh b/lily/include/context-key-manager.hh deleted file mode 100644 index fb8e27b943..0000000000 --- a/lily/include/context-key-manager.hh +++ /dev/null @@ -1,43 +0,0 @@ -/* - context-key-manager.hh -- declare Context_key_manager - - source file of the GNU LilyPond music typesetter - - (c) 2006--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> - -*/ - -#ifndef CONTEXT_KEY_MANAGER_HH -#define CONTEXT_KEY_MANAGER_HH - -#include "lily-proto.hh" - -#include <map> -using namespace std; - -class Context_key_manager -{ - Object_key const *key_; - map<string, int> grob_counts_; - map<string, int> context_counts_; - - -protected: - friend class Context; - - Context_key_manager (Object_key const *); - Context_key_manager (Context_key_manager const &src); - - - void unprotect () const; - void gc_mark () const; - void clear (); - Object_key const *key () const { return key_; } - Object_key const *create_grob_key (Moment, string); - Object_key const *get_grob_key (Moment, string); - Object_key const *get_context_key (Moment, string, string); -}; - -#endif /* CONTEXT_KEY_MANAGER_HH */ - - diff --git a/lily/include/context.hh b/lily/include/context.hh index 25fbb12589..a8866708f2 100644 --- a/lily/include/context.hh +++ b/lily/include/context.hh @@ -9,11 +9,12 @@ #ifndef CONTEXT_HH #define CONTEXT_HH -#include "context-key-manager.hh" #include "listener.hh" #include "moment.hh" #include "std-vector.hh" #include "virtual-methods.hh" +#include "scm-hash.hh" +#include "lily-proto.hh" class Context { @@ -37,7 +38,7 @@ protected: SCM definition_; /* Additions to the Context_def, given by \with */ SCM definition_mods_; - Context_key_manager key_manager_; + // Context_key_manager key_manager_; SCM properties_scm_; SCM context_list_; diff --git a/lily/include/object-key-dumper.hh b/lily/include/object-key-dumper.hh deleted file mode 100644 index 75b0862cd0..0000000000 --- a/lily/include/object-key-dumper.hh +++ /dev/null @@ -1,40 +0,0 @@ -/* - object-key-dumper.hh -- declare Object_key_dumper - - source file of the GNU LilyPond music typesetter - - (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#ifndef OBJECT_KEY_DUMPER_HH -#define OBJECT_KEY_DUMPER_HH - -#include <map> -using namespace std; - -#include "object-key.hh" - -typedef map<Object_key const *, Object_key const *, Object_key_less> Key_to_key_map; -typedef map<Object_key const *, int> Pointer_to_int_map; -typedef map<int, Object_key const *> Int_to_key_map; - -class Object_key_dumper -{ - SCM file_contents_; - Key_to_key_map serialized_keys_; - Pointer_to_int_map key_serial_numbers_; - int next_available_; - - SCM key_serial (int); - SCM serialize_key (Object_key const *); - DECLARE_SMOBS (Object_key_dumper); -public: - Object_key_dumper (); - SCM get_file_contents () const; - SCM dump_key (Object_key const *); -}; - -DECLARE_UNSMOB (Object_key_dumper, key_dumper); - -#endif /* OBJECT_KEY_DUMPER_HH */ - diff --git a/lily/include/object-key-undumper.hh b/lily/include/object-key-undumper.hh deleted file mode 100644 index 556735e483..0000000000 --- a/lily/include/object-key-undumper.hh +++ /dev/null @@ -1,30 +0,0 @@ -/* - object-key-undumper.hh -- declare Object_key_undumper - - source file of the GNU LilyPond music typesetter - - (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#ifndef OBJECT_KEY_UNDUMPER_HH -#define OBJECT_KEY_UNDUMPER_HH - -#include <map> -using namespace std; - -#include "object-key.hh" - -typedef map<int, Object_key const *> Int_to_key_map; - -struct Object_key_undumper -{ - DECLARE_SMOBS (Object_key_undumper); - Int_to_key_map keys_; -public: - void parse_contents (SCM); - Object_key_undumper (); - Object_key const *get_key (int k); -}; -DECLARE_UNSMOB (Object_key_undumper, key_undumper); - -#endif diff --git a/lily/include/tweak-registration.hh b/lily/include/tweak-registration.hh index 9e26cb59be..6b912279f8 100644 --- a/lily/include/tweak-registration.hh +++ b/lily/include/tweak-registration.hh @@ -13,7 +13,6 @@ using namespace std; #include "lily-proto.hh" -#include "object-key.hh" typedef map<Object_key const *, SCM, Object_key_less> Tweak_map; diff --git a/lily/main.cc b/lily/main.cc index 4cec327b0b..d395128f53 100644 --- a/lily/main.cc +++ b/lily/main.cc @@ -391,7 +391,6 @@ main_with_guile (void *, int, char **) ly_c_init_guile (); call_constructors (); - init_global_tweak_registry (); init_fontconfig (); init_freetype (); diff --git a/lily/object-key-dumper-scheme.cc b/lily/object-key-dumper-scheme.cc deleted file mode 100644 index 3790b16f89..0000000000 --- a/lily/object-key-dumper-scheme.cc +++ /dev/null @@ -1,42 +0,0 @@ -/* - object-key-dumper-scheme.cc -- implement Object_key_dumper bindings - - source file of the GNU LilyPond music typesetter - - (c) 2005--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#include "object-key-dumper.hh" - -#include "moment.hh" - -LY_DEFINE (ly_make_dumper, "ly:make-dumper", - 0, 0, 0, - (), - "Create a key dumper. ") -{ - Object_key_dumper *u = new Object_key_dumper (); - return u->unprotect (); -} - -LY_DEFINE (ly_dumper_definitions, "ly:dumper-definitions", - 1, 0, 0, - (SCM dumper), - "Return list of key definitions. ") -{ - Object_key_dumper *u = unsmob_key_dumper (dumper); - SCM_ASSERT_TYPE (u, dumper, SCM_ARG1, __FUNCTION__, "dumper"); - return u->get_file_contents (); -} - -LY_DEFINE (ly_dumper_key_serial, "ly:dumper-key-serial", - 2, 0, 0, - (SCM dumper, SCM key), - "Return the key serial number @var{key}. ") -{ - Object_key_dumper *u = unsmob_key_dumper (dumper); - Object_key *k = unsmob_key (key); - SCM_ASSERT_TYPE (u, dumper, SCM_ARG1, __FUNCTION__, "dumper"); - SCM_ASSERT_TYPE (k, key, SCM_ARG2, __FUNCTION__, "key"); - return u->dump_key (k); -} diff --git a/lily/object-key-dumper.cc b/lily/object-key-dumper.cc deleted file mode 100644 index c835c1ef63..0000000000 --- a/lily/object-key-dumper.cc +++ /dev/null @@ -1,97 +0,0 @@ -/* - object-key-dumper.cc -- implement Object_key_dumper - - source file of the GNU LilyPond music typesetter - - (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#include "object-key-dumper.hh" - -#include "moment.hh" - -#include "ly-smobs.icc" - -SCM -Object_key_dumper::mark_smob (SCM smob) -{ - Object_key_dumper *dumper = (Object_key_dumper *) SCM_CELL_WORD_1 (smob); - - for (Key_to_key_map::const_iterator i (dumper->serialized_keys_.begin ()); - i != dumper->serialized_keys_.end (); - i++) - scm_gc_mark ((*i).first->self_scm ()); - return SCM_EOL; -} - -int -Object_key_dumper::print_smob (SCM, SCM port, scm_print_state*) -{ - scm_puts ("#<Object_key_dumper>", port); - return 1; -} - -IMPLEMENT_DEFAULT_EQUAL_P (Object_key_dumper); -IMPLEMENT_SMOBS (Object_key_dumper); - -Object_key_dumper::Object_key_dumper () -{ - file_contents_ = SCM_EOL; - next_available_ = 0; - smobify_self (); -} - -SCM -Object_key_dumper::key_serial (int k) -{ - return scm_list_2 (ly_symbol2scm ("key"), - scm_from_int (k)); -} - -SCM -Object_key_dumper::serialize_key (Object_key const *key) -{ - SCM skey = key->dump (); - for (SCM s = skey; scm_is_pair (s); s = scm_cdr (s)) - { - if (Object_key const *sub_key = unsmob_key (scm_car (s))) - scm_set_car_x (s, dump_key (sub_key)); - else if (Moment *mom = unsmob_moment (scm_car (s))) - scm_set_car_x (s, - scm_list_2 (ly_symbol2scm ("unquote"), - mom->as_scheme ())); - } - - file_contents_ = scm_cons (scm_list_3 (ly_symbol2scm ("define-key"), - scm_from_int (next_available_), - skey), - file_contents_); - - serialized_keys_[key] = key; - key_serial_numbers_[key] = next_available_; - SCM retval = key_serial (next_available_); - next_available_++; - - return retval; -} - -SCM -Object_key_dumper::dump_key (Object_key const *key) -{ - if (key_serial_numbers_.find (key) != key_serial_numbers_.end ()) - return key_serial (key_serial_numbers_[key]); - else if (Object_key const *serialized = serialized_keys_[key]) - return key_serial (key_serial_numbers_[ serialized_keys_ [serialized] ]); - - return serialize_key (key); -} - -SCM -Object_key_dumper::get_file_contents () const -{ - return scm_reverse (file_contents_); -} - -Object_key_dumper::~Object_key_dumper () -{ -} diff --git a/lily/object-key-undumper-scheme.cc b/lily/object-key-undumper-scheme.cc deleted file mode 100644 index 4cbd79d92e..0000000000 --- a/lily/object-key-undumper-scheme.cc +++ /dev/null @@ -1,44 +0,0 @@ -/* - object-key-undumper-scheme.cc -- implement Object_key_undumper bindings - - source file of the GNU LilyPond music typesetter - - (c) 2005--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#include "object-key-undumper.hh" - -LY_DEFINE (ly_undumper_read_keys, "ly:undumper-read-keys", - 2, 0, 0, - (SCM undumper, SCM keys), - "Read serialized @var{keys} into @var{undumper}.") -{ - Object_key_undumper *u = unsmob_key_undumper (undumper); - SCM_ASSERT_TYPE (u, undumper, SCM_ARG1, __FUNCTION__, "Undumper"); - - u->parse_contents (keys); - return SCM_UNSPECIFIED; -} - -LY_DEFINE (ly_make_undumper, "ly:make-undumper", - 0, 0, 0, - (), - "Create a key undumper. ") -{ - Object_key_undumper *u = new Object_key_undumper (); - return u->unprotect (); -} - -LY_DEFINE (ly_undumper_lookup, "ly:undumper-lookup", - 2, 0, 0, - (SCM undumper, SCM serial), - "Return the object key for number @var{serial}. ") - -{ - Object_key_undumper *u = unsmob_key_undumper (undumper); - - SCM_ASSERT_TYPE (u, undumper, SCM_ARG1, __FUNCTION__, "undumper"); - SCM_ASSERT_TYPE (scm_is_integer (serial), serial, SCM_ARG2, __FUNCTION__, "integer"); - return u->get_key (scm_to_int (serial))->self_scm (); -} - diff --git a/lily/object-key-undumper.cc b/lily/object-key-undumper.cc deleted file mode 100644 index a52a21594f..0000000000 --- a/lily/object-key-undumper.cc +++ /dev/null @@ -1,86 +0,0 @@ -/* - object-key-undumper.cc -- implement Object_key_undumper - - source file of the GNU LilyPond music typesetter - - (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#include "object-key-undumper.hh" - -#include "ly-smobs.icc" - -IMPLEMENT_SMOBS (Object_key_undumper); -IMPLEMENT_DEFAULT_EQUAL_P (Object_key_undumper); - -SCM -Object_key_undumper::mark_smob (SCM smob) -{ - Object_key_undumper *undumper = (Object_key_undumper *) SCM_CELL_WORD_1 (smob); - for (Int_to_key_map::const_iterator i (undumper->keys_.begin ()); - i != undumper->keys_.end (); i++) - scm_gc_mark ((*i).second->self_scm ()); - - return SCM_BOOL_F; -} - -int -Object_key_undumper::print_smob (SCM s, SCM port, scm_print_state*) -{ - (void) s; - scm_puts ("#<Object_key_undumper>", port); - return 1; -} - -Object_key_undumper::Object_key_undumper () -{ - smobify_self (); -} - -void -Object_key_undumper::parse_contents (SCM contents) -{ - for (SCM s = contents; scm_is_pair (s); s = scm_cdr (s)) - { - SCM entry = scm_car (s); - if (scm_car (entry) != ly_symbol2scm ("define-key")) - continue; - - int number = scm_to_int (scm_cadr (entry)); - SCM skey = scm_caddr (entry); - - SCM new_key = SCM_EOL; - SCM *tail = &new_key; - for (SCM t = skey; scm_is_pair (t); t = scm_cdr (t)) - { - SCM item = scm_car (t); - if (scm_is_pair (item) - && scm_car (item) == ly_symbol2scm ("key")) - { - int index = scm_to_int (scm_cadr (item)); - Object_key const *key = get_key (index); - *tail = scm_cons (key->self_scm (), SCM_EOL); - } - else - *tail = scm_cons (item, SCM_EOL); - tail = SCM_CDRLOC (*tail); - } - - Object_key *k = Object_key::undump (new_key); - keys_[number] = k; - k->unprotect (); - } -} - -Object_key const * -Object_key_undumper::get_key (int idx) -{ - Int_to_key_map::const_iterator i (keys_.find (idx)); - assert (i != keys_.end ()); - - return (*i).second; -} - -Object_key_undumper::~Object_key_undumper () -{ -} diff --git a/lily/program-option.cc b/lily/program-option.cc index fd1327622f..80930efbf3 100644 --- a/lily/program-option.cc +++ b/lily/program-option.cc @@ -7,12 +7,12 @@ */ #include "program-option.hh" -#include "profile.hh" #include <cstdio> #include <cstring> using namespace std; +#include "profile.hh" #include "international.hh" #include "main.hh" #include "parse-scm.hh" @@ -21,7 +21,6 @@ using namespace std; /* Write midi as formatted ascii stream? */ bool do_midi_debugging_global; -bool use_object_keys; bool debug_skylines; /* @@ -86,11 +85,6 @@ void internal_set_option (SCM var, SCM val) lily_1_8_compatibility_used = to_boolean (val); val = scm_from_bool (to_boolean (val)); } - else if (var == ly_symbol2scm ("object-keys")) - { - use_object_keys = to_boolean (val); - val = scm_from_bool (to_boolean (val)); - } else if (var == ly_symbol2scm ("strict-infinity-checking")) { strict_infinity_checking = to_boolean (val); diff --git a/lily/score-engraver.cc b/lily/score-engraver.cc index fb2088f79a..e1359ae4c3 100644 --- a/lily/score-engraver.cc +++ b/lily/score-engraver.cc @@ -79,7 +79,7 @@ Score_engraver::initialize () SCM props = updated_grob_properties (context (), ly_symbol2scm ("System")); - Object_key const *sys_key = context ()->get_grob_key ("System"); + Object_key const *sys_key = 0; pscore_->typeset_system (new System (props, sys_key)); system_ = pscore_->root_system (); diff --git a/lily/system.cc b/lily/system.cc index b0110a5ebb..b804e43a31 100644 --- a/lily/system.cc +++ b/lily/system.cc @@ -252,21 +252,6 @@ System::add_column (Paper_column *p) Axis_group_interface::add_element (this, p); } -void -apply_tweaks (Grob *g, bool broken) -{ - if (bool (g->original ()) == broken) - { - SCM tweaks = global_registry_->get_tweaks (g); - for (SCM s = tweaks; scm_is_pair (s); s = scm_cdr (s)) - { - SCM proc = scm_caar (s); - SCM rest = scm_cdar (s); - scm_apply_1 (proc, g->self_scm (), rest); - } - } -} - void System::pre_processing () { @@ -286,9 +271,6 @@ System::pre_processing () fixup_refpoints (all_elements_->array ()); - for (vsize i = 0; i < all_elements_->size (); i++) - apply_tweaks (all_elements_->grob (i), false); - for (vsize i = 0; i < all_elements_->size (); i++) { Grob *g = all_elements_->grob (i); @@ -309,7 +291,6 @@ System::post_processing () { Grob *g = all_elements_->grob (i); - apply_tweaks (g, true); (void) g->get_property ("after-line-breaking"); } diff --git a/lily/tie-engraver.cc b/lily/tie-engraver.cc index 0841b73a6a..e6d48dfea0 100644 --- a/lily/tie-engraver.cc +++ b/lily/tie-engraver.cc @@ -123,8 +123,7 @@ Tie_engraver::acknowledge_note_head (Grob_info i) if (ly_is_equal (right_ev->get_property ("pitch"), left_ev->get_property ("pitch"))) { - Grob *p = new Spanner (heads_to_tie_[i].tie_definition_, - context ()->get_grob_key ("Tie")); + Grob *p = new Spanner (heads_to_tie_[i].tie_definition_, 0); SCM cause = heads_to_tie_[i].tie_event_ ? heads_to_tie_[i].tie_event_->self_scm () diff --git a/lily/tweak-engraver.cc b/lily/tweak-engraver.cc deleted file mode 100644 index c87902f9ba..0000000000 --- a/lily/tweak-engraver.cc +++ /dev/null @@ -1,47 +0,0 @@ -/* - tweak-engraver.cc -- implement Tweak_engraver - - source file of the GNU LilyPond music typesetter - - (c) 2005--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> - -*/ - -#include "engraver.hh" - -#include "grob.hh" -#include "stream-event.hh" -#include "translator.icc" - -class Tweak_engraver : public Engraver -{ - TRANSLATOR_DECLARATIONS (Tweak_engraver); - -protected: - DECLARE_ACKNOWLEDGER (grob); -}; - -Tweak_engraver::Tweak_engraver() -{ -} - -void -Tweak_engraver::acknowledge_grob (Grob_info info) -{ - if (Stream_event *ev = info.event_cause ()) - { - for (SCM s = ev->get_property ("tweaks"); - scm_is_pair (s); s = scm_cdr (s)) - { - info.grob ()->set_property (scm_caar (s), scm_cdar (s)); - } - } -} - -ADD_ACKNOWLEDGER (Tweak_engraver, grob); -ADD_TRANSLATOR (Tweak_engraver, - /* doc */ "Read the @code{tweaks} property from the originating event, and set properties." , - - /* create */ "", - /* read */ "", - /* write */ ""); diff --git a/lily/tweak-registration-scheme.cc b/lily/tweak-registration-scheme.cc deleted file mode 100644 index 79ce72e104..0000000000 --- a/lily/tweak-registration-scheme.cc +++ /dev/null @@ -1,73 +0,0 @@ -/* - tweak-registration-scheme.cc -- implement Tweak_registry bindings - - source file of the GNU LilyPond music typesetter - - (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#include "tweak-registration.hh" -#include "grob.hh" -#include "object-key-undumper.hh" - -LY_DEFINE (ly_clear_tweak_registry, "ly:tweak-clear-registry", - 0, 0, 0, (), - "Clear global tweak registry") -{ - global_registry_->clear (); - return SCM_UNSPECIFIED; -} - -LY_DEFINE (ly_grob_insert_tweak, "ly:grob-insert-tweak", - 2, 0, 0, - (SCM grob, SCM tweak), - "add new tweak for grob.") -{ - Grob *gr = unsmob_grob (grob); - SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "Grob"); - SCM_ASSERT_TYPE (scm_list_p (tweak) == SCM_BOOL_T - && ly_is_procedure (scm_car (tweak)), - tweak, SCM_ARG2, __FUNCTION__, "Tweak"); - - global_registry_->insert_grob_tweak (gr, tweak); - return SCM_UNSPECIFIED; -} - -LY_DEFINE (ly_grob_replace_tweak, "ly:grob-replace-tweak", - 2, 0, 0, - (SCM grob, SCM tweak), - "Replace tweak for grob.") -{ - Grob *gr = unsmob_grob (grob); - SCM_ASSERT_TYPE (gr, grob, SCM_ARG1, __FUNCTION__, "Grob"); - SCM_ASSERT_TYPE (scm_list_p (tweak) == SCM_BOOL_T - && ly_is_procedure (scm_car (tweak)), - tweak, SCM_ARG2, __FUNCTION__, "Tweak"); - - global_registry_->replace_grob_tweak (gr, tweak); - return SCM_UNSPECIFIED; -} - -LY_DEFINE (ly_tweak_read_keys, "ly:tweak-define-keys", - 1, 0, 0, (SCM keys), - "Read keys") -{ - global_registry_->undumper ()->parse_contents (keys); - return SCM_UNSPECIFIED; -} - -LY_DEFINE (ly_all_tweaks, "ly:all-tweaks", - 0, 0, 0, (), - "all tweaks") -{ - return global_registry_->list_tweaks (); -} - -LY_DEFINE (ly_tweak_read_tweaks, "ly:tweak-define-tweaks", - 1, 0, 0, (SCM tweaks), - "Read tweaks") -{ - for (SCM s = tweaks; scm_is_pair (s); s = scm_cdr (s)) - global_registry_->insert_tweak_from_file (scm_car (s)); - return SCM_UNSPECIFIED; -} diff --git a/lily/tweak-registration.cc b/lily/tweak-registration.cc deleted file mode 100644 index b04704d219..0000000000 --- a/lily/tweak-registration.cc +++ /dev/null @@ -1,138 +0,0 @@ -/* - tweak-registration.cc -- implement Tweak_registry - - source file of the GNU LilyPond music typesetter - - (c) 2004--2007 Han-Wen Nienhuys <hanwen@xs4all.nl> -*/ - -#include "tweak-registration.hh" - -#include "object-key-undumper.hh" -#include "grob.hh" - -#include "ly-smobs.icc" - -Tweak_registry::Tweak_registry () -{ - undumper_ = 0; - smobify_self (); - undumper_ = new Object_key_undumper (); - undumper_->unprotect (); -} - -Tweak_registry::~Tweak_registry () -{ -} - -void -Tweak_registry::clear () -{ - tweaks_.clear (); - undumper_ = new Object_key_undumper (); - undumper_->unprotect (); -} - -void -Tweak_registry::insert_tweak_from_file (SCM tweak) -{ - SCM skey = scm_car (tweak); - - assert (scm_is_pair (skey) - && scm_car (skey) == ly_symbol2scm ("key")); - - Object_key const *key = undumper_->get_key (scm_to_int (scm_cadr (skey))); - - SCM existing = SCM_EOL; - Tweak_map::const_iterator prev = tweaks_.find (key); - if (prev != tweaks_.end ()) - existing = (*prev).second; - - tweaks_[key] = scm_cons (scm_cdr (tweak), existing); -} - -void -Tweak_registry::insert_grob_tweak (Grob *g, SCM tweak) -{ - Object_key const *key = g->key (); - if (tweaks_.find (key) == tweaks_.end ()) - tweaks_[key] = SCM_EOL; - - tweaks_[key] = scm_cons (tweak, tweaks_[key]); -} - -void -Tweak_registry::replace_grob_tweak (Grob *g, SCM tweak) -{ - Object_key const *key = g->key (); - tweaks_[key] = scm_cons (tweak, SCM_EOL); -} - -SCM -Tweak_registry::get_tweaks (Grob *g) -{ - Object_key const *key = g->key (); - if (tweaks_.find (key) == tweaks_.end ()) - return SCM_EOL; - return tweaks_[key]; -} - -SCM -Tweak_registry::list_tweaks () -{ - SCM retval = SCM_EOL; - for (Tweak_map::const_iterator i (tweaks_.begin ()); - i != tweaks_.end (); - i++) - { - Object_key const *key = (*i).first; - for (SCM t = (*i).second; scm_is_pair (t); t = scm_cdr (t)) - retval = scm_cons (scm_cons (key->self_scm (), scm_car (t)), retval); - } - - return retval; -} - -SCM -Tweak_registry::mark_smob (SCM smob) -{ - Tweak_registry *me = (Tweak_registry *) SCM_CELL_WORD_1 (smob); - - for (Tweak_map::const_iterator i (me->tweaks_.begin ()); - i != me->tweaks_.end (); - i++) - { - scm_gc_mark ((*i).first->self_scm ()); - scm_gc_mark ((*i).second); - } - - if (me->undumper_) - scm_gc_mark (me->undumper_->self_scm ()); - - return SCM_EOL; -} - -int -Tweak_registry::print_smob (SCM smob, SCM port, scm_print_state*) -{ - (void) smob; // smother warning. - scm_puts ("#<Tweak_registry>", port); - return 1; -} - -Object_key_undumper * -Tweak_registry::undumper () const -{ - return undumper_; -} - -IMPLEMENT_DEFAULT_EQUAL_P (Tweak_registry); -IMPLEMENT_SMOBS (Tweak_registry); - -Tweak_registry *global_registry_; - -void -init_global_tweak_registry () -{ - global_registry_ = new Tweak_registry (); -} diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index f3416f1bb9..047812c23a 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -479,7 +479,6 @@ AncientRemoveEmptyStaffContext = \context { \consists "Vertical_align_engraver" \consists "Stanza_number_align_engraver" \consists "Bar_number_engraver" - \consists "Tweak_engraver" \consists "Parenthesis_engraver" \defaultchild "Staff" diff --git a/scm/define-music-properties.scm b/scm/define-music-properties.scm index b9901d5d86..bb9d8ca81e 100644 --- a/scm/define-music-properties.scm +++ b/scm/define-music-properties.scm @@ -96,9 +96,6 @@ It must take a single argument, being the context.") (quoted-context-id ,string? "The id of the context to direct quotes to, eg., @code{cue}.") (quoted-transposition ,ly:pitch? "The pitch used for the quote, overriding \\transposition") (to-relative-callback ,procedure? "How to transform a piece of music to relative pitches") - (tweaks ,list? "An alist of properties to override in the backend -for the grob made of this event.") - (repeat-count ,integer? "do a @code{\repeat} how ofen?") (span-direction ,ly:dir? "Does this start or stop a spanner?") (span-type ,string? "What kind of spanner should be created? diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm index 9e8cf4510d..e69de29bb2 100644 --- a/scm/framework-gnome.scm +++ b/scm/framework-gnome.scm @@ -1,421 +0,0 @@ -;;;; framework-gnome.scm -- -;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2004--2006 Jan Nieuwenhuizen <janneke@gnu.org> - -;;;; See output-gnome.scm for usage information. - - -(define-module (scm framework-gnome)) - -(use-modules (guile) - (oop goops) - (scm page) - (scm paper-system) - (lily)) - -(use-modules - (srfi srfi-2) - (ice-9 regex) - (gnome gtk) - (gnome gtk gdk-event) - (gnome gw canvas)) - -(define-public (output-framework basename book scopes fields ) - (gnome-main book basename)) - -(define SCROLLBAR-SIZE 20) -(define BUTTON-HEIGHT 25) -(define PANELS-HEIGHT 80) - -(define PIXELS-PER-UNIT 2) -;; 2.5?? -(define OUTPUT-SCALE (* 2.5 PIXELS-PER-UNIT)) -(define-public output-scale OUTPUT-SCALE) - -(define (debugf string . rest) - (if #f - (apply stderr (cons string rest)))) - -(define-class <gnome-outputter> () - (name #:init-value "untitled" #:init-keyword #:name #:accessor name) - - ;; FIXME - (dragging #:init-value #f #:accessor dragging) - (drag-origin #:init-value #f #:accessor drag-origin) - (drag-location #:init-value #f #:accessor drag-location) - - (page-stencils ;;#:init-value '#() - #:init-keyword #:page-stencils #:accessor page-stencils) - (window #:init-value (make <gtk-window> #:type 'toplevel) #:accessor window) - (scrolled #:init-value (make <gtk-scrolled-window>) #: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) - (grob #:init-value #f #:accessor grob) - (item-grobs #:init-value (make-hash-table 31) #:accessor item-grobs) - (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 <gnome-outputter>)) - (let* ((save (make <gtk-button> #:label "Save")) - (exit (make <gtk-button> #:label "Exit")) - (next (make <gtk-button> #:label "Next")) - (prev (make <gtk-button> #:label "Previous")) - (vbox (make <gtk-vbox> #:homogeneous #f)) - (hbox (make <gtk-hbox> #: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 <gnome-outputter>. - ;;(set-child-packing vbox hbox #f #f 0 'end) - ;;(set-child-packing hbox button #f #f 0 'end) - - (set-size-request exit (quotient (window-width go) 2) BUTTON-HEIGHT) - - - (add hbox next) - (add hbox prev) - (add hbox save) - (add hbox exit) - - ;; signals - (connect exit 'clicked (lambda (b) (gtk-main-quit))) - (connect save 'clicked (lambda (b) (save-tweaks go))) - (connect next 'clicked (lambda (b) (dump-page go (1+ (page-number go))))) - (connect prev 'clicked (lambda (b) (dump-page go (1- (page-number go))))) - (connect (window go) 'key-press-event - (lambda (w e) (key-press-event go w e))) - - (show-all (window go)))) - - -(define (gnome-main book name) - (let* ((paper (ly:paper-book-paper book)) - (paper-width (ly:output-def-lookup paper 'paper-width)) - (paper-height (ly:output-def-lookup paper 'paper-height)) - (page-width (inexact->exact (ceiling (* OUTPUT-SCALE paper-width)))) - (page-height (inexact->exact (ceiling (* OUTPUT-SCALE paper-height)))) - ;;(page-width (inexact->exact (ceiling paper-width))) - ;;(page-height (inexact->exact (ceiling paper-height))) - - (screen-width (gdk-screen-width)) - (screen-height (gdk-screen-height)) - (desktop-height (- screen-height PANELS-HEIGHT)) - - (go (make <gnome-outputter> - #:name name - #:page-stencils (list->vector (map page-stencil (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. - ;; possibly a goops 1.6.4 problem - (initialize go) - - (dump-page go 0) - - (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 yet. - ;;(map destroy (gtk-container-get-children main-canvas)) - ;;(map destroy text-items) - - (set! (text-items go) '()) - (debugf "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 ifs #f) -(define (get-ifs) - (if (not ifs) - (set! ifs (getenv "IFS"))) - (if (not ifs) - (set! ifs " ")) - ifs) - -(define (spawn-editor location) - (let* ((file-name (car location)) - (line (cadr location)) - (char (caddr location)) - (column (cadddr location)) - (command (get-editor-command file line char column))) - (debugf "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 (get-location grob) - (and-let* ((p (procedure? point-and-click)) - (g grob) - (cause (ly:grob-property grob 'cause)) - (music-origin (if (ly:event? cause) - (ly:event-property cause 'origin) - ;; How come #<unspecified> [and '()] - ;; are #t? :-( - #f))) - (if (ly:input-location? music-origin) - (ly:input-location music-origin) - #f))) - -;; todo: how to integrate nicely? -;(define-public (tweak-grob-property grob sym val) -; (set! (ly:grob-property grob sym) val)) - - -(define-method (tweak (go <gnome-outputter>) item offset) - (let* ((grob (hashq-ref (item-grobs go) item #f)) - (extra-offset (ly:grob-property grob 'extra-offset)) - (origin (if (null? extra-offset) '(0 . 0) - (offset-flip-y extra-offset)))) - - (if grob - (ly:grob-replace-tweak - grob (list tweak-grob-property - 'extra-offset - (offset-flip-y (offset-add origin offset))))))) - -(define-method (save-tweaks (go <gnome-outputter>)) - (let* ((dumper (ly:make-dumper)) - (tweaks (ly:all-tweaks)) - (serialized-tweaks - (map - (lambda (tweak) (append - (list (ly:dumper-key-serial dumper (car tweak)) - (list 'unquote (procedure-name (cadr tweak)))) - (cddr tweak))) - tweaks))) - - (if (not (null? serialized-tweaks)) - (let ((file (open-file (string-append (name go) ".twy") "w"))) - (format file - ";;;tweaks. Generated file. Do not edit. -(ly:tweak-clear-registry) -(ly:tweak-define-keys `~S) -(ly:tweak-define-tweaks `~S)" - (ly:dumper-definitions dumper) - serialized-tweaks))))) - -;;;(define (item-event go grob item event) -(define (item-event go item event) - ;;(stderr "EVENT: ~S\n" event) - ;;(stderr "TYPE: ~S\n" (gdk-event:type event)) - (case (gdk-event:type event) - ((enter-notify) (gobject-set-property item 'fill-color "red")) - ((leave-notify) (gobject-set-property item 'fill-color "black")) - ((motion-notify) (if (ly:grob? (dragging go)) - (let ((x (gdk-event-motion:x event)) - (y (gdk-event-motion:y event)) - (s output-scale) - (r (drag-location go))) - ;;(stderr "MOVED AT: ~S ~S\n" x y) - (move item (/ (- x (car r)) s) (/ (- y (cdr r)) s)) - (set! (drag-location go) (cons x y))))) - ((button-release) (if (ly:grob? (dragging go)) - (let ((x (gdk-event-button:x event)) - (y (gdk-event-button:y event)) - (s output-scale) - (o (drag-origin go)) - (r (drag-location go))) - (move item (/ (- x (car r)) s) (/ (- y (cdr r)) s)) - (set! (drag-location go) #f) - (set! (drag-origin go) #f) - (stderr "RELEASE at: ~S ~S\n" x y) - (set! (dragging go) #f) - (tweak go item (cons (/ (- x (car o)) s) - (/ (- y (cdr o)) s)))))) - ((button-press) - (let ((button (gdk-event-button:button event))) - (cond - ((= button 1) - (if (null? (gdk-event-button:modifiers event)) - (let ((x (gdk-event-button:x event)) - (y (gdk-event-button:y event))) - (stderr "CLICK at: ~S ~S\n" x y) - (set! (dragging go) (hashq-ref (item-grobs go) item #f)) - (set! (drag-origin go) (cons x y)) - (set! (drag-location go) (cons x y))) - (begin - (stderr "CLICK WITH MODIFIERS: ~S\n" - (gdk-event-button:modifiers event)) - - ;; some modifier, do jump to source - (and-let* ((grob (hashq-ref (item-grobs go) item #f)) - (location (get-location grob))) - (location-callback location))))) - ((= button 2) - (and-let* ((grob (hashq-ref (item-grobs go) item #f))) - - (let ((properties (ly:grob-properties grob)) - (basic-properties (ly:grob-basic-properties grob)) - (x (inexact->exact (gdk-event-button:x-root event))) - (y (inexact->exact (gdk-event-button:y-root event)))) - - (debugf "GROB: ~S\n" grob) - (debugf "PROPERTIES: ~S\n" properties) - (debugf "BASIC PROPERTIES: ~S\n" basic-properties) - - ;; FIXME: dialog iso window? - ;; http://www.gtk.org/tutorial/sec-textentries.html - (let ((window (make <gtk-window>)) - (vbox (make <gtk-vbox>)) - (ok (make <gtk-button> #:label "Ok"))) - - (add window vbox) - (connect ok 'clicked (lambda (b) (destroy window))) - - (for-each - (lambda (x) - (let ((label (make <gtk-label> - ;;#:label (symbol->string (car x)))) - #:label (format #f "~S" (car x)))) - ;;(symbol->string (car x)))) - (entry (make <gtk-entry> - #:text (format #f "~S" (cdr x)))) - (hbox (make <gtk-hbox>))) - (add hbox label) - (add hbox entry) - (set-size-request label 150 BUTTON-HEIGHT) - (add vbox hbox))) - (append properties basic-properties)) - (add vbox ok) - - (show-all window) - (move window x y)))))))) - - ((2button-press) (gobject-set-property item 'fill-color "green")) - ((key-press) - (let ((keyval (gdk-event-key:keyval event)) - (mods (gdk-event-key:modifiers event)) - (step (quotient (pixels-per-unit go) 2))) - (cond ((and (null? mods) - (eq? keyval gdk:Up)) - (tweak go item (cons 0 (- 0 step)))) - ((and (null? mods) - (eq? keyval gdk:Down)) - (tweak go item (cons 0 step))) - ((and (null? mods) - (eq? keyval gdk:Left)) - (tweak go item (cons (- 0 step) 0))) - ((and (null? mods) - (eq? keyval gdk:Right)) - (tweak go item (cons step 0))))))) - #t) - -(define (scale-canvas go factor) - (set! (pixels-per-unit go) (* (pixels-per-unit go) factor)) - (set-pixels-per-unit (canvas go) (pixels-per-unit go)) - (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 go))) - -(define (key-press-event go item event) - (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 (eq? keyval gdk:s) - (equal? mods '(control-mask modifier-mask))) - (save-tweaks go)) - ((and #t ;;(null? mods) - (eq? keyval gdk:plus)) - (scale-canvas go 2)) - ((and #t ;; (null? mods) - (eq? keyval gdk:minus)) - (scale-canvas go 0.5)) - ((or (eq? keyval gdk:Page-Up) - (eq? keyval gdk:BackSpace)) - (dump-page go (1- (page-number go)))) - ((or (eq? keyval gdk:Page-Down) - (eq? keyval gdk:space)) - (dump-page go (1+ (page-number go))))) - #f)) - -(define (new-canvas go) - (set! (canvas go) (make <gnome-canvas>)) - (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 <gnome-canvas-rect> - #: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 - ((ly:grob? result) (set! (grob go) result)) - ((is-a? result <gnome-canvas-item>) - - ;; AAARGH; grobs happen after stencils - ;; (connect result 'event (lambda (w e) (item-event go (grob go) w e))) - (connect result 'event (lambda (w e) (item-event go w e))) - (if (grob go) - (hashq-set! (item-grobs go) result (grob go))) - (set! (grob go) #f) - - (if (is-a? result <gnome-canvas-text>) - (set! (text-items go) (cons result (text-items go)))))))) diff --git a/scm/lily.scm b/scm/lily.scm index 5daa01c53d..d4e05a4af1 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -38,7 +38,6 @@ ensure that all refs to parsed objects are dead. This is an internal option, an (delete-intermediate-files #f "delete unusable PostScript files") (dump-profile #f "dump timing information for each file") - (dump-tweaks #f "dump page layout and tweaks for each score having the tweak-key layout property set.") (dump-signatures #f "dump output signatures of each system. Used for regression testing.") (eps-box-padding #f "Pad EPS bounding box left edge. Guarantee alignment between systems in LaTeX.") @@ -54,8 +53,6 @@ ensure that all refs to parsed objects are dead. This is an internal option, an (old-relative #f "relative for simultaneous music works similar to chord syntax") - (object-keys #f - "experimental mechanism for remembering tweaks") (point-and-click #t "use point & click") (paper-size "a4" "the default paper size") (pixmap-format "png16m" "GS format to use for pixel images") diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index ccb6d9d04b..e69de29bb2 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -1,339 +0,0 @@ -;;;; output-gnome.scm -- implement GNOME canvas output -;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2004--2006 Jan Nieuwenhuizen <janneke@gnu.org> - -;;;; TODO: -;;;; -;;;; * .cff MUST NOT be in fc's fontpath. -;;;; - workaround: remove mf/out from ~/.fonts.conf, -;;;; instead add ~/.fonts and symlink all /mf/out/*otf there. -;;;; - bug in fontconfig/freetype/pango? - -;;; * check: blot+scaling -;;; * Figure out and fix font scaling and character placement -;;; * EC font package: add missing X font directories and AFMs -;;; * User-interface, keybindings -;;; * Implement missing stencil functions -;;; * Implement missing commands -;;; * More information in stencils, e.g., location and grob tag. -;;; * Embedded Lily: -;;; - allow GnomeCanvas or `toplevel' GtkWindow to be created -;;; outside of LilyPond -;;; - lilylib. -;;; * Release schedule and packaging of dependencies. -;;; - g-wrap-1.9.3 is already in incoming. -;;; - guile-gnome-platform-2.8.0 will probably be packaged early 2005. - -;;; You need: -;;; -;;; * Rotty's g-wrap >= 1.9.3 -;;; * guile-gnome-platform >= 2.7.97 -;;; * pango >= 1.6.0 -;;; -;;; See also: guile-gtk-general@gnu.org - -;;; Try it -;;; -;;; * Install gnome/gtk and libffi development stuff -;;; -;;; * Install [pango, g-wrap and] guile-gnome from source, -;;; see buildscripts/guile-gnome.sh -;;; -;;; * Build LilyPond with gui support: configure --enable-gui -;;; -;;; * Supposing that LilyPond was built in ~/cvs/savannah/lilypond, -;;; tell fontconfig about the feta fonts dir and run fc-cache -" -cat > ~/.fonts.conf << EOF -<fontconfig> -<dir>~/cvs/savannah/lilypond/mf/out</dir> -<dir>/usr/share/texmf/fonts/type1/public/ec-fonts-mftraced</dir> -</fontconfig> -EOF -fc-cache -" -;;; or copy all your .pfa/.pfb's to ~/.fonts if your fontconfig -;;; already looks there for fonts. Check if it works by doing: -" -fc-list | grep -i lily -" -;;; -;;; * Setup environment -" -export GUILE_LOAD_PATH=$HOME/usr/pkg/g-wrap/share/guile/site:$HOME/usr/pkg/g-wrap/share/guile/site/g-wrap:$HOME/usr/pkg/guile-gnome/share/guile:$GUILE_LOAD_PATH -export LD_LIBRARY_PATH=$HOME/usr/pkg/pango/lib:$HOME/usr/pkg/g-wrap/lib:$HOME/usr/pkg/guile-gnome/lib:$LD_LIBRARY_PATH -export XEDITOR='/usr/bin/emacsclient --no-wait +%l:%c %f' -" -;;; * Also for GNOME point-and-click, you need to set XEDITOR and add -" -#(ly:set-point-and-click 'line-column) -" -;;; to your .ly. -;;; -;;; * Run lily: -" -lilypond -fgnome input/simple-song.ly -" -;;; point-and-click: (mouse-1) click on a graphical object; -;;; grob-property-list: (mouse-3) click on a graphical object. - -(define-module (scm output-gnome)) -(define this-module (current-module)) - -(use-modules - (guile) - (ice-9 regex) - (srfi srfi-13) - (lily) - (gnome gtk) - (gnome gw canvas)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; globals - -;;; set by framework-gnome.scm -(define canvas-root #f) -(define output-scale #f) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; helper functions - -(define (utf-8 i) - (cond - ((< i #x80) (list (integer->char i))) - ((< i #x800) (map integer->char - (list (+ #xc0 (quotient i #x40)) - (+ #x80 (modulo i #x40))))) - ((< i #x10000) - (let ((x (quotient i #x1000)) - (y (modulo i #x1000))) - (map integer->char - (list (+ #xe0 x) - (+ #x80 (quotient y #x40)) - (+ #x80 (modulo y #x40)))))) - (else (begin (stderr "programming-error: utf-8 too big:~x\n" i) - (list (integer->char 32)))))) - -(define (integer->utf-8-string integer) - (list->string (utf-8 integer))) - -(define (char->utf-8-string char) - (list->string (utf-8 (char->integer char)))) - -(define (string->utf-8-string string) - (apply - string-append - (map (lambda (x) (char->utf-8-string x)) (string->list string)))) - -(define (music-font? font) - (let ((family (car (font-name-style font)))) - (string=? (substring family 0 (min (string-length family) 10)) - "Emmentaler"))) - -;;; FONT may be font smob, or pango font string -(define (pango-font-name font) - (if (string? font) - (list font "Regular") - (apply format (append '(#f "~a, ~a") (font-name-style font))))) - -;;; FONT may be font smob, or pango font string -(define (canvas-font-size font) - ;; FIXME: 1.85? - (* 1.85 - (if (string? font) - 12 - (* output-scale (modified-font-metric-font-scaling font))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Wrappers from guile-gnome TLA -;;; guile-gnome-devel@gnu.org--2004 -;;; http://arch.gna.org/guile-gnome/archive-2004 -;;; -;;; janneke@gnu.org--2004-gnome -;;; http://lilypond.org/~janneke/{arch}/2004-gnome -;;; -(if (not (defined? '<gnome-canvas-path-def>)) - (begin - (define-class <gnome-canvas-path-def> (<gobject>) - (closure #:init-value (gnome-canvas-path-def-new) - #:init-keyword #:path-def - #:getter get-def #:setter set-def)) - - (define-method (moveto (this <gnome-canvas-path-def>) x y) - (gnome-canvas-path-def-moveto (get-def this) x y)) - (define-method (curveto (this <gnome-canvas-path-def>) x1 y1 x2 y2 x3 y3) - (gnome-canvas-path-def-curveto (get-def this) x1 y1 x2 y2 x3 y3)) - (define-method (lineto (this <gnome-canvas-path-def>) x y) - (gnome-canvas-path-def-lineto (get-def this) x y)) - (define-method (closepath (this <gnome-canvas-path-def>)) - (gnome-canvas-path-def-closepath (get-def this))) - (define-method (reset (this <gnome-canvas-path-def>)) - (gnome-canvas-path-def-reset (get-def this))) - - (define -set-path-def set-path-def) - (define -get-path-def get-path-def) - - (define-method (set-path-def (this <gnome-canvas-shape>) - (def <gnome-canvas-path-def>)) - (-set-path-def this (get-def def))) - - (define-method (get-path-def (this <gnome-canvas-shape>)) - (make <gnome-canvas-path-def> #:path-def (-get-path-def this))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; stencil outputters -;;; - -;;; catch-all for missing stuff -;;; comment this out to see find out what functions you miss :-) -(define (dummy . foo) #f) -(map (lambda (x) (module-define! this-module x dummy)) - (append - (ly:all-stencil-expressions) - (ly:all-output-backend-commands))) - -;; two beziers -(define (bezier-sandwich lst thick) - (let* ((def (make <gnome-canvas-path-def>)) - (bezier (make <gnome-canvas-bpath> - #:parent (canvas-root) - #:fill-color "black" - #:outline-color "black" - #:width-units thick - #:join-style 'round))) - - (reset def) - - ;; FIXME: LST is pre-mangled for direct ps stack usage - ;; cl cr r l 0 1 2 3 - ;; cr cl l r 4 5 6 7 - - (moveto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3)))) - (curveto def (car (list-ref lst 0)) (- (cdr (list-ref lst 0))) - (car (list-ref lst 1)) (- (cdr (list-ref lst 1))) - (car (list-ref lst 2)) (- (cdr (list-ref lst 2)))) - - (lineto def (car (list-ref lst 7)) (- (cdr (list-ref lst 7)))) - (curveto def (car (list-ref lst 4)) (- (cdr (list-ref lst 4))) - (car (list-ref lst 5)) (- (cdr (list-ref lst 5))) - (car (list-ref lst 6)) (- (cdr (list-ref lst 6)))) - (lineto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3)))) - - (closepath def) - (set-path-def bezier def) - bezier)) - -(define (char font i) - (text font (ly:font-index-to-charcode font i))) - -(define (dashed-line thick on off dx dy) - (draw-line thick 0 0 dx dy)) - -(define (draw-line thick x1 y1 x2 y2) - (let* ((def (make <gnome-canvas-path-def>)) - (props (make <gnome-canvas-bpath> - #:parent (canvas-root) - #:fill-color "black" - #:outline-color "black" - #:width-units thick))) - (reset def) - (moveto def x1 (- y1)) - (lineto def x2 (- y2)) - (set-path-def props def) - props)) - - -;; FIXME: the framework-gnome backend needs to see every item that -;; gets created. All items created here must should be put in a group -;; that gets returned. -(define (glyph-string font postscript-font-name w-x-y-named-glyphs) - (for-each - (lambda (x) - - ;; UGR, glyph names not found - (stderr "GLYPH:~S\n" (caddr x)) - (stderr "ID:~S\n" (ly:font-glyph-name-to-charcode font (caddr x))) - (placebox (cadr x) (caddr x) - (make <gnome-canvas-text> - #:parent (canvas-root) - ;;#:x 0.0 #:y (if (music-font? font) 0.15 0.69) - #:x 0.0 #:y 0.0 - #:anchor 'west - #:font (pango-font-name font) - #:size-points (canvas-font-size font) - #:size-set #t - #:text - (integer->utf-8-string - (ly:font-glyph-name-to-charcode font (cadddr x)))))) - w-x-y-named-glyphs)) - -(define (grob-cause offset grob) - grob) - - -(define (named-glyph font name) - (text font (ly:font-glyph-name-to-charcode font name))) - -(define (placebox x y expr) - (let ((item expr)) - ;;(if item - ;; FIXME ugly hack to skip #unspecified ... - (if (and item (not (eq? item (if #f #f)))) - (begin - (move item (* output-scale x) (* output-scale (- y))) - (affine-relative item output-scale 0 0 output-scale 0 0) - item) - #f))) - -(define (polygon coords blot-diameter) - (let* ((def (make <gnome-canvas-path-def>)) - (props (make <gnome-canvas-bpath> - #:parent (canvas-root) - #:fill-color "black" - #:outline-color "black" - #:join-style 'round) - #:width-units blot-diameter) - (points (ly:list->offsets '() coords)) - (last-point (car (last-pair points)))) - - (reset def) - (moveto def (car last-point) (cdr last-point)) - (for-each (lambda (x) (lineto def (car x) (cdr x))) points) - (closepath def) - (set-path-def props def) - props)) - -(define (round-filled-box breapth width depth height blot-diameter) - (let ((r (/ blot-diameter 2))) - (make <gnome-canvas-rect> - #:parent (canvas-root) - #:x1 (- r breapth) #:y1 (- depth r) #:x2 (- width r) #:y2 (- r height) - #:fill-color "black" - #:outline-color "black" - #:width-units blot-diameter - #:join-style 'round))) - -(define (text font s) - (make <gnome-canvas-text> - #:parent (canvas-root) - ;;#:x 0.0 #:y 0.0 - #:x 0.0 #:y (if (music-font? font) 0.15 0.69) - #:anchor (if (music-font? font) 'west 'south-west) - #:font (pango-font-name font) - #:size-points (canvas-font-size font) - #:size-set #t - #:text (if (integer? s) - (integer->utf-8-string s) - (string->utf-8-string s)))) - -(define (utf-8-string pango-font-description string) - (make <gnome-canvas-text> - #:parent (canvas-root) - #:x 0.0 #:y 0.0 - #:anchor 'west - #:font pango-font-description - #:size-points (canvas-font-size pango-font-description) - #:size-set #t - #:text string))