X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fstream-event-scheme.cc;h=ccc37e0110d599717a439aac311d76549841bd30;hb=b872748c6aa8bb721ced458691b38ac2fac5dfc8;hp=1f890782a44cbfc09dca7c79626ac050b32c80ec;hpb=f3487cef38f45d65137225ece9f5c289569138bd;p=lilypond.git diff --git a/lily/stream-event-scheme.cc b/lily/stream-event-scheme.cc index 1f890782a4..ccc37e0110 100644 --- a/lily/stream-event-scheme.cc +++ b/lily/stream-event-scheme.cc @@ -1,44 +1,81 @@ /* - stream-event.cc -- implement Scheme bindings for Stream_event + This file is part of LilyPond, the GNU music typesetter. - source file of the GNU LilyPond music typesetter + Copyright (C) 2006--2015 Erik Sandberg - (c) 2006 Erik Sandberg + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . */ #include "stream-event.hh" +LY_DEFINE (ly_stream_event_p, "ly:stream-event?", + 1, 0, 0, (SCM obj), + "Is @code{@var{obj}} a @code{Stream_event} object?") +{ + return scm_from_bool (unsmob (obj)); +} + LY_DEFINE (ly_make_stream_event, "ly:make-stream-event", - 1, 1, 0, (SCM cl, SCM proplist), - "Creates a stream event of class @var{cl} with the given mutable property list.\n" ) + 1, 1, 0, (SCM cl, SCM proplist), + "Create a stream event of class @var{cl} with the given" + " mutable property list.") { - 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 + LY_ASSERT_TYPE (ly_is_pair, cl, 1); + + /* should be scm_list_p, but scm_list_p is expensive. */ + LY_ASSERT_TYPE (scm_is_pair, proplist, 2); + + if (SCM_UNBNDP (proplist)) proplist = SCM_EOL; + Stream_event *e = new Stream_event (cl, proplist); return e->unprotect (); } -LY_DEFINE (ly_event_property, "ly:event-property", - 2, 0, 0, (SCM sev, SCM sym), - "Get the property @var{sym} of stream event @var{mus}.\n" - "If @var{sym} is undefined, return @code{'()}.\n") +LY_DEFINE (ly_event_property, "ly:event-property", + 2, 1, 0, (SCM sev, SCM sym, SCM val), + "Get the property @var{sym} of stream event @var{sev}." + " If @var{sym} is undefined, return @var{val} or" + " @code{'()} if @var{val} is not specified.") { - Stream_event *e = unsmob_stream_event (sev); - SCM_ASSERT_TYPE (e, sev, SCM_ARG1, __FUNCTION__, "stream event"); - SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); - - return e->internal_get_property (sym); + LY_ASSERT_SMOB (Stream_event, sev, 1); + return ly_prob_property (sev, sym, val); } -LY_DEFINE (ly_event_set_property, "ly:event-set-property!", +LY_DEFINE (ly_event_set_property_x, "ly:event-set-property!", 3, 0, 0, (SCM ev, SCM sym, SCM val), - "Set property @var{sym} in event @var{ev} to @var{val}."){ - Stream_event *sc = unsmob_stream_event (ev); - SCM_ASSERT_TYPE (sc, ev, SCM_ARG1, __FUNCTION__, "event"); + "Set property @var{sym} in event @var{ev} to @var{val}.") +{ + LY_ASSERT_SMOB (Stream_event, ev, 1); + LY_ASSERT_TYPE (ly_is_symbol, sym, 2); + 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@tie{}@var{m}.") +{ + SCM copy = m; + if (Stream_event *ev = unsmob (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; +}