From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Sun, 24 Dec 2006 15:12:18 +0000 (+0100)
Subject: bugfixes and cleanups for stream-events.
X-Git-Tag: release/2.10.5-1~12
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=d53bf353471d8762b3fcebd5228ab8c71f62cf37;p=lilypond.git
bugfixes and cleanups for stream-events.
Better typechecks, and implement copy_mutable_properties()
for reliable copying.
---
diff --git a/lily/dispatcher-scheme.cc b/lily/dispatcher-scheme.cc
index 2a2720656c..8500cf9811 100644
--- a/lily/dispatcher-scheme.cc
+++ b/lily/dispatcher-scheme.cc
@@ -38,10 +38,11 @@ LY_DEFINE (ly_add_listener, "ly:add-listener",
SCM_ASSERT_TYPE (l, list, SCM_ARG1, __FUNCTION__, "listener");
SCM_ASSERT_TYPE (d, disp, SCM_ARG2, __FUNCTION__, "dispatcher");
- for (int arg=SCM_ARG3; scm_is_pair (cl); cl = scm_cdr (cl), arg++)
+ for (int arg = SCM_ARG3; scm_is_pair (cl); cl = scm_cdr (cl), arg++)
{
- SCM_ASSERT_TYPE (scm_symbol_p (cl), cl, arg, __FUNCTION__, "symbol");
- d->add_listener (*l, scm_car (cl));
+ SCM sym = scm_car (cl);
+ SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, arg, __FUNCTION__, "symbol");
+ d->add_listener (*l, sym);
}
return SCM_UNDEFINED;
diff --git a/lily/duration-scheme.cc b/lily/duration-scheme.cc
index fb4bb10263..361036256d 100644
--- a/lily/duration-scheme.cc
+++ b/lily/duration-scheme.cc
@@ -53,13 +53,13 @@ LY_DEFINE (ly_make_duration, "ly:make-duration",
"(whole, half, quarter, etc.) and a number of augmentation\n"
"dots. \n")
{
- SCM_ASSERT_TYPE (scm_integer_p (length) == SCM_BOOL_T,
+ SCM_ASSERT_TYPE (scm_is_integer (length),
length, SCM_ARG1, __FUNCTION__, "integer");
int dots = 0;
if (dotcount != SCM_UNDEFINED)
{
- SCM_ASSERT_TYPE (scm_integer_p (dotcount) == SCM_BOOL_T,
+ SCM_ASSERT_TYPE (scm_is_integer (dotcount),
dotcount, SCM_ARG2, __FUNCTION__, "integer");
dots = scm_to_int (dotcount);
}
diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc
index 069cd605fc..9b6aaeb7fd 100644
--- a/lily/general-scheme.cc
+++ b/lily/general-scheme.cc
@@ -297,7 +297,7 @@ LY_DEFINE (ly_stderr_redirect, "ly:stderr-redirect",
1, 1, 0, (SCM file_name, SCM mode),
"Redirect stderr to FILE-NAME, opened with MODE.")
{
- SCM_ASSERT_TYPE (scm_string_p (file_name), file_name, SCM_ARG1,
+ SCM_ASSERT_TYPE (scm_is_string (file_name), file_name, SCM_ARG1,
__FUNCTION__, "file_name");
char const *m = "w";
if (mode != SCM_UNDEFINED && scm_string_p (mode))
diff --git a/lily/include/stream-event.hh b/lily/include/stream-event.hh
index 4e1688f6f4..9f226f48db 100644
--- a/lily/include/stream-event.hh
+++ b/lily/include/stream-event.hh
@@ -18,15 +18,16 @@ class Stream_event : public Prob
public:
Stream_event ();
VIRTUAL_COPY_CONSTRUCTOR (Stream_event, Stream_event);
- // todo: remove unneeded constructors
+
Stream_event (SCM event_class, SCM mutable_props=SCM_EOL);
Stream_event (SCM class_name, Input *);
- Stream_event (Stream_event *ev);
Input *origin () const;
void set_spot (Input *i);
bool internal_in_event_class (SCM class_name);
+ virtual SCM copy_mutable_properties () const;
+
DECLARE_SCHEME_CALLBACK (undump, (SCM));
DECLARE_SCHEME_CALLBACK (dump, (SCM));
@@ -36,5 +37,6 @@ public:
Stream_event *unsmob_stream_event (SCM);
DECLARE_TYPE_P (Stream_event);
+SCM ly_event_deep_copy (SCM);
#endif /* STREAM_EVENT_HH */
diff --git a/lily/music.cc b/lily/music.cc
index 1253e72860..a6e18cabb4 100644
--- a/lily/music.cc
+++ b/lily/music.cc
@@ -185,7 +185,7 @@ Music::compress (Moment factor)
}
/*
-TODO: make transposition non-destructive
+ This mutates alist. Hence, make sure that it is not changed
*/
SCM
transpose_mutable (SCM alist, Pitch delta)
diff --git a/lily/scheme-listener-scheme.cc b/lily/scheme-listener-scheme.cc
index b8946871c0..7e8370068f 100644
--- a/lily/scheme-listener-scheme.cc
+++ b/lily/scheme-listener-scheme.cc
@@ -16,7 +16,7 @@ LY_DEFINE (ly_make_listener, "ly:make-listener",
"\n"
" @var{callback} should take exactly one argument." )
{
- SCM_ASSERT_TYPE (scm_procedure_p (callback), callback, SCM_ARG1, __FUNCTION__, "procedure");
+ SCM_ASSERT_TYPE (ly_is_procedure (callback), callback, SCM_ARG1, __FUNCTION__, "procedure");
Scheme_listener *l = new Scheme_listener (callback);
SCM listener = GET_LISTENER (l->call).smobbed_copy ();
l->unprotect ();
diff --git a/lily/stream-event-scheme.cc b/lily/stream-event-scheme.cc
index ea93654961..947ff14b30 100644
--- a/lily/stream-event-scheme.cc
+++ b/lily/stream-event-scheme.cc
@@ -13,12 +13,13 @@ LY_DEFINE (ly_make_stream_event, "ly:make-stream-event",
"Creates a stream event of class @var{cl} with the given mutable property list.\n" )
{
SCM_ASSERT_TYPE (scm_is_symbol (cl), cl, SCM_ARG1, __FUNCTION__, "symbol");
- if (proplist != SCM_UNDEFINED)
- {
- SCM_ASSERT_TYPE (scm_list_p (proplist), proplist, SCM_ARG2, __FUNCTION__, "association list");
- }
- else
+
+ /* should be scm_list_p, but scm_list_p is expensive. */
+ SCM_ASSERT_TYPE (scm_is_pair (proplist), proplist, SCM_ARG2, __FUNCTION__, "association list");
+
+ if (proplist == SCM_UNDEFINED)
proplist = SCM_EOL;
+
Stream_event *e = new Stream_event (cl, proplist);
return e->unprotect ();
}
@@ -42,3 +43,20 @@ LY_DEFINE (ly_event_set_property, "ly:event-set-property!",
SCM_ASSERT_TYPE (sc, ev, SCM_ARG1, __FUNCTION__, "event");
return ly_prob_set_property_x (ev, sym, val);
}
+
+LY_DEFINE (ly_event_deep_copy, "ly:event-deep-copy",
+ 1, 0, 0, (SCM m),
+ "Copy @var{m} and all sub expressions of @var{m}")
+{
+ SCM copy = m;
+ if (Stream_event *ev = unsmob_stream_event (m))
+ {
+ ev = ev->clone ();
+ copy = ev->unprotect ();
+ }
+ else if (scm_is_pair (m))
+ copy = scm_cons (ly_event_deep_copy (scm_car (m)),
+ ly_event_deep_copy (scm_cdr (m)));
+
+ return copy;
+}
diff --git a/lily/stream-event.cc b/lily/stream-event.cc
index ff736d8832..12219884b1 100644
--- a/lily/stream-event.cc
+++ b/lily/stream-event.cc
@@ -35,11 +35,10 @@ Stream_event::Stream_event (SCM class_name, Input *origin)
set_spot (origin);
}
-Stream_event::Stream_event (Stream_event *ev)
- : Prob (ly_symbol2scm ("Stream_event"), SCM_EOL)
+SCM
+Stream_event::copy_mutable_properties () const
{
- mutable_property_alist_ = scm_copy_tree (ev->mutable_property_alist_);
- immutable_property_alist_ = ev->immutable_property_alist_;
+ return ly_event_deep_copy (mutable_property_alist_);
}
Input *