X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Flily-guile.cc;h=a7c8b58919ee7badfc53bd63077f245120943569;hb=ea9e5d2536fd8234d1c7e48acc26e161d1df90d4;hp=6b96a31315177fbfdd1e1df303b93f019155c2a7;hpb=a517dce054511941847288622f7840ff9d2bd353;p=lilypond.git diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index 6b96a31315..a7c8b58919 100644 --- a/lily/lily-guile.cc +++ b/lily/lily-guile.cc @@ -3,7 +3,7 @@ source file of the GNU LilyPond music typesetter - (c) 1998--2002 Jan Nieuwenhuizen + (c) 1998--2003 Jan Nieuwenhuizen Han-Wen Nienhuys */ @@ -13,6 +13,20 @@ #include #include /* isinf */ #include /* strdup, strchr */ +#include + +#include "lily-proto.hh" + +/* macosx fix: + + + source-file.hh includes cmath which undefines isinf and isnan +*/ +inline int my_isinf(Real r) { return isinf(r); } +inline int my_isnan(Real r) { return isnan(r); } + + + #include "libc-extension.hh" #include "lily-guile.hh" #include "main.hh" @@ -27,28 +41,6 @@ // #define TEST_GC -#ifdef PARANOID -#include -#undef gh_pair_p -bool -ly_pair_p (SCM x) -{ -#if 0 - assert (!SCM_CONSP (x) || (*(scm_t_bits*) SCM2PTR (SCM_CAR (x))) != scm_tc_free_cell); - assert (!SCM_CONSP (x) || (*(scm_t_bits*) SCM2PTR (SCM_CDR (x))) != scm_tc_free_cell); -#elif GUILE_MINOR_VERSION < 5 - assert (!SCM_CONSP (x) || !SCM_FREEP (SCM_CAR (x))); - assert (!SCM_CONSP (x) || !SCM_FREEP (SCM_CDR (x))); -#else - assert (!SCM_CONSP (x) || !SCM_FREE_CELL_P (SCM_CAR (x))); - assert (!SCM_CONSP (x) || !SCM_FREE_CELL_P (SCM_CDR (x))); -#endif - //return SCM_NFALSEP (scm_pair_p (x)); - return gh_pair_p (x); -} -#define gh_pair_p ly_pair_p -#endif - SCM ly_last (SCM list) { @@ -78,8 +70,6 @@ ly_quote_scm (SCM s) return scm_list_n (ly_symbol2scm ("quote"), s, SCM_UNDEFINED); } - - String ly_symbol2string (SCM s) { @@ -87,7 +77,6 @@ ly_symbol2string (SCM s) return String ((Byte*)SCM_STRING_CHARS (s), (int) SCM_STRING_LENGTH (s)); } - String gulp_file_to_string (String fn) { @@ -96,17 +85,16 @@ gulp_file_to_string (String fn) { String e = _f ("can't find file: `%s'", fn); e += " "; - e += _f ("(load path: `%s')", global_path.string ()); + e += _f ("(load path: `%s')", global_path.to_string ()); error (e); } else if (verbose_global_b) progress_indication ("[" + s); - int n; char * str = gulp_file (s, &n); String result (str); - delete str; + delete[] str; if (verbose_global_b) progress_indication ("]"); @@ -114,12 +102,10 @@ gulp_file_to_string (String fn) return result; } -LY_DEFINE(ly_gulp_file, "ly-gulp-file", 1,0, 0, +LY_DEFINE(ly_gulp_file, "ly:gulp-file", 1,0, 0, (SCM name), - "Read the file named @var{name}, and return its contents in a string. The -file is looked up using the lilypond search path. - -") + "Read the file named @var{name}, and return its contents in a string. The " +" file is looked up using the lilypond search path.") { return scm_makfrom0str (gulp_file_to_string (ly_scm2string (name)).to_str0 ()); } @@ -163,7 +149,7 @@ index_set_cell (SCM s, Direction d, SCM v) return s; } -LY_DEFINE(ly_warning,"ly-warn", 1, 0, 0, +LY_DEFINE(ly_warning,"ly:warn", 1, 0, 0, (SCM str),"Scheme callable function to issue the warning @code{msg}.") { SCM_ASSERT_TYPE (gh_string_p (str), str, SCM_ARG1, __FUNCTION__, "string"); @@ -171,10 +157,9 @@ LY_DEFINE(ly_warning,"ly-warn", 1, 0, 0, return SCM_BOOL_T; } -LY_DEFINE(ly_isdir, "dir?", 1,0, 0, (SCM s), - "type predicate. A direction is a -1, 0 or 1, where -1 represents left or -down and 1 represents right or up. -") +LY_DEFINE(ly_dir_p, "ly:dir?", 1,0, 0, (SCM s), + "type predicate. A direction is a -1, 0 or 1, where -1 represents " + "left or down and 1 represents right or up. ") { if (gh_number_p (s)) { @@ -185,7 +170,7 @@ down and 1 represents right or up. } bool -ly_number_pair_p (SCM p) +is_number_pair (SCM p) { return gh_pair_p (p) && gh_number_p (ly_car (p)) && gh_number_p (ly_cdr (p)); } @@ -201,26 +186,27 @@ void add_scm_init_func (void (*f) ()) scm_init_funcs_->push (f); } -extern void init_cxx_function_smobs (); - void -ly_init_guile () +ly_init_ly_module (void *) { - SCM last_mod = scm_current_module (); - scm_set_current_module (scm_c_resolve_module ("guile")); - - init_cxx_function_smobs (); for (int i=scm_init_funcs_->size () ; i--;) (scm_init_funcs_->elem (i)) (); if (verbose_global_b) progress_indication ("\n"); + + scm_primitive_load_path (scm_makfrom0str ("lily.scm")); +} - scm_primitive_load_path (scm_makfrom0str ("lily.scm")); +SCM lily_module ; - scm_set_current_module (last_mod); +void +ly_init_guile () +{ + lily_module = scm_c_define_module ("lily", ly_init_ly_module, 0); + scm_c_use_module ("lily"); } unsigned int ly_scm_hash (SCM s) @@ -231,7 +217,7 @@ unsigned int ly_scm_hash (SCM s) bool -ly_dir_p (SCM s) +is_direction (SCM s) { if (gh_number_p (s)) { @@ -243,7 +229,7 @@ ly_dir_p (SCM s) bool -ly_axis_p (SCM s) +is_axis (SCM s) { if (gh_number_p (s)) { @@ -319,17 +305,11 @@ ly_scm2offset (SCM s) gh_scm2double (ly_cdr (s))); } - -/* - convert without too many decimals, and leave a space at the end. - */ - -LY_DEFINE(ly_number2string, "ly-number->string", 1, 0,0, +LY_DEFINE(ly_number2string, "ly:number->string", 1, 0,0, (SCM s), - " converts @var{num} to a string without generating many decimals. It -leaves a space at the end. -") + " converts @var{num} to a string without generating many decimals. It " +"leaves a space at the end.") { SCM_ASSERT_TYPE (gh_number_p (s), s, SCM_ARG1, __FUNCTION__, "number"); @@ -339,7 +319,7 @@ leaves a space at the end. { Real r (gh_scm2double (s)); - if (isinf (r) || isnan (r)) + if (my_isinf (r) || my_isnan (r)) { programming_error ("Infinity or NaN encountered while converting Real number; setting to zero."); r = 0.0; @@ -359,7 +339,7 @@ leaves a space at the end. Undef this to see if GUILE GC is causing too many swaps. */ -// #define TEST_GC +//#define TEST_GC #ifdef TEST_GC #include @@ -379,26 +359,27 @@ wave_sweep_goodbye (void *dummy1, void *dummy2, void *dummy3) #include "version.hh" -LY_DEFINE(ly_version, "ly-version", 0, 0, 0, (), - "Return the current lilypond version as a list, e.g. -@code{(1 3 127 uu1)}. -") +LY_DEFINE(ly_version, "ly:version", 0, 0, 0, (), + "Return the current lilypond version as a list, e.g. @code{(1 3 127 uu1)}. ") { - char const* vs = "\' (" MAJOR_VERSION " " MINOR_VERSION " " PATCH_LEVEL " " MY_PATCH_LEVEL ")" ; + char const* vs = "\'(" MAJOR_VERSION " " MINOR_VERSION " " PATCH_LEVEL " " MY_PATCH_LEVEL ")" ; return gh_eval_str ((char*)vs); } -LY_DEFINE(ly_unit, "ly-unit", 0, 0, 0, (), +LY_DEFINE(ly_unit, "ly:unit", 0, 0, 0, (), "Return the unit used for lengths as a string.") { return scm_makfrom0str (INTERNAL_UNIT); } -LY_DEFINE(ly_verbose, "ly-verbose", 0, 0, 0, (), - "Return whether lilypond is being run in verbose mode.") + + +LY_DEFINE(ly_dimension_p, "ly:dimension?", 1, 0, 0, (SCM d), + "Return @var{d} is a number. Used to distinguish length " + "variables from normal numbers.") { - return gh_bool2scm (verbose_global_b); + return scm_number_p (d); } static void @@ -498,6 +479,10 @@ parse_symbol_list (const char * list) char *orig = s; SCM create_list = SCM_EOL; + char * e = s + strlen (s) - 1; + while (e >= s && isspace (*e)) + *e -- = 0; + for (char * p = s; *p; p++) { if (*p == '\n') @@ -571,19 +556,35 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) if (val == SCM_EOL || val == SCM_BOOL_F) return ok; - - SCM type = SCM_EOL; + if (!gh_symbol_p (sym)) +#if 0 + return false; +#else + /* + This is used for autoBeamSettings. - if (gh_symbol_p (sym)) - type = scm_object_property (sym, type_symbol); + TODO: deprecate the use of \override and \revert for + autoBeamSettings? + + or use a symbol autoBeamSettingS? + */ + return true; +#endif + + SCM type = scm_object_property (sym, type_symbol); if (type != SCM_EOL && !gh_procedure_p (type)) { - warning (_f ("Can't find property type-check for `%s' (%s). Perhaps you made a typing error? Doing assignment anyway.", + warning (_f ("Can't find property type-check for `%s' (%s).", ly_symbol2string (sym).to_str0 (), - ly_symbol2string (type_symbol).to_str0 () - - )); + ly_symbol2string (type_symbol).to_str0 ()) + + " " + _ ("Perhaps you made a typing error?")); + + /* Be strict when being anal :) */ + if (internal_type_checking_global_b) + abort (); + + warning (_ ("Doing assignment anyway.")); } else { @@ -698,8 +699,6 @@ int_list_to_slice (SCM l) } - - /* Return I-th element, or last elt L. If I < 0, then we take the first element. @@ -714,3 +713,51 @@ robust_list_ref(int i, SCM l) return gh_car(l); } + + + +Real +robust_scm2double (SCM k, double x) +{ + if (gh_number_p (k)) + x = gh_scm2double (k); + return x; +} + +Interval +robust_scm2interval (SCM k, Drul_array v) +{ + Interval i; + i[LEFT]= v[LEFT]; + i[RIGHT]= v[RIGHT]; + if (is_number_pair (k)) + i = ly_scm2interval (k); + return i; +} + +Drul_array +robust_scm2drul (SCM k, Drul_array v) +{ + if (is_number_pair (k)) + v = ly_scm2interval (k); + return v; +} + +Offset +robust_scm2offset (SCM k, Offset o) +{ + if (is_number_pair (k)) + o = ly_scm2offset (k); + + return o; +} + + +int +robust_scm2int (SCM k, int o) +{ + if (scm_integer_p (k) == SCM_BOOL_T) + o = gh_scm2int (k); + + return o; +}