X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=lily%2Flily-guile.cc;h=812f344a70855ab458f12d83f0bcac09fffc66cf;hb=43d1c731756070519bb1229b30c7a83f275e2c6e;hp=ac0e1176a3851aed0f78582277cdacf750f441ac;hpb=ba858880848d6aca1de4401d185860eb2017a01c;p=lilypond.git diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index ac0e1176a3..812f344a70 100644 --- a/lily/lily-guile.cc +++ b/lily/lily-guile.cc @@ -4,8 +4,7 @@ source file of the GNU LilyPond music typesetter (c) 1998--2004 Jan Nieuwenhuizen - - Han-Wen Nienhuys + Han-Wen Nienhuys */ @@ -73,7 +72,7 @@ ly_quote_scm (SCM s) String ly_symbol2string (SCM s) { - assert (is_symbol (s)); + assert (ly_c_symbol_p (s)); return String ((Byte*)SCM_STRING_CHARS (s), (int) SCM_STRING_LENGTH (s)); } @@ -122,37 +121,37 @@ ly_display_scm (SCM s) } }; -String -ly_scm2string (SCM s) +char const * +ly_scm2str0 (SCM string) { - assert (ly_c_string_p (s)); + SCM_ASSERT_TYPE (ly_c_string_p (string), string, SCM_ARG1, + __FUNCTION__, "string"); + return SCM_STRING_CHARS (string); +} - char *p = SCM_STRING_CHARS (s); - String r (p); - return r; +String +ly_scm2string (SCM string) +{ + return ly_scm2str0 (string); } char * ly_scm2newstr (SCM str, size_t *lenp) { - char *new_str; - size_t len; - SCM_ASSERT_TYPE (ly_c_string_p (str), str, SCM_ARG1, __FUNCTION__, "string"); - len = SCM_STRING_LENGTH (str); - new_str = (char *) malloc ((len + 1) * sizeof (char)); - - if (new_str == NULL) - return NULL; - - memcpy (new_str, SCM_STRING_CHARS (str), len); - new_str[len] = '\0'; - - if (lenp != NULL) - *lenp = len; + size_t len = SCM_STRING_LENGTH (str); + if (char *new_str = (char *) malloc ((len + 1) * sizeof (char))) + { + memcpy (new_str, SCM_STRING_CHARS (str), len); + new_str[len] = '\0'; - return new_str; + if (lenp) + *lenp = len; + + return new_str; + } + return 0; } SCM @@ -173,21 +172,39 @@ index_set_cell (SCM s, Direction d, SCM v) return s; } -LY_DEFINE (ly_warning,"ly:warn", 1, 0, 0, - (SCM str), "Scheme callable function to issue the warning @code{msg}.") +LY_DEFINE (ly_warn, "ly:warn", + 1, 0, 1, (SCM str, SCM rest), + "Scheme callable function to issue the warning @code{msg}. " + "The message is formatted with @code{format} and @code{rest}.") { SCM_ASSERT_TYPE (ly_c_string_p (str), str, SCM_ARG1, __FUNCTION__, "string"); progress_indication ("\n"); + + str = scm_simple_format (SCM_BOOL_F, str, rest); warning ("lily-guile: " + ly_scm2string (str)); - return SCM_BOOL_T; + return SCM_UNSPECIFIED; +} + +LY_DEFINE (ly_programming_error, "ly:programming-error", + 1, 0, 1, (SCM str, SCM rest), + "Scheme callable function to issue the warning @code{msg}. " + "The message is formatted with @code{format} and @code{rest}.") +{ + SCM_ASSERT_TYPE (ly_c_string_p (str), str, SCM_ARG1, __FUNCTION__, "string"); + progress_indication ("\n"); + + str = scm_simple_format (SCM_BOOL_F, str, rest); + programming_error (ly_scm2string (str)); + return SCM_UNSPECIFIED; } -LY_DEFINE (ly_dir_p, "ly:dir?", 1,0, 0, (SCM s), +LY_DEFINE (ly_dir_p, "ly:dir?", + 1, 0, 0, (SCM s), "type predicate. A direction is @code{-1}, @code{0} or " "@code{1}, where @code{-1} represents " "left or down and @code{1} represents right or up.") { - if (is_number (s)) + if (ly_c_number_p (s)) { int i = ly_scm2int (s); return (i>= -1 && i <= 1) ? SCM_BOOL_T : SCM_BOOL_F; @@ -198,7 +215,8 @@ LY_DEFINE (ly_dir_p, "ly:dir?", 1,0, 0, (SCM s), bool is_number_pair (SCM p) { - return ly_c_pair_p (p) && is_number (ly_car (p)) && is_number (ly_cdr (p)); + return ly_c_pair_p (p) + && ly_c_number_p (ly_car (p)) && ly_c_number_p (ly_cdr (p)); } typedef void (*Void_fptr) (); @@ -212,7 +230,6 @@ void add_scm_init_func (void (*f) ()) scm_init_funcs_->push (f); } - void ly_init_ly_module (void *) { @@ -234,17 +251,16 @@ ly_c_init_guile () scm_c_use_module ("lily"); } -unsigned int ly_scm_hash (SCM s) +unsigned int +ly_scm_hash (SCM s) { return scm_ihashv (s, ~1u); } - - bool is_direction (SCM s) { - if (is_number (s)) + if (ly_c_number_p (s)) { int i = ly_scm2int (s); return i>= -1 && i <= 1; @@ -252,11 +268,10 @@ is_direction (SCM s) return false; } - bool is_axis (SCM s) { - if (is_number (s)) + if (ly_c_number_p (s)) { int i = ly_scm2int (s); return i== 0 || i == 1; @@ -267,7 +282,7 @@ is_axis (SCM s) Direction to_dir (SCM s) { - return SCM_INUMP (s) ? (Direction) ly_scm2int (s) : CENTER; + return scm_is_integer (s) ? (Direction) ly_scm2int (s) : CENTER; } Interval @@ -292,7 +307,7 @@ ly_interval2scm (Drul_array i) bool to_boolean (SCM s) { - return is_boolean (s) && ly_scm2bool (s); + return ly_c_boolean_p (s) && ly_scm2bool (s); } /* Appendable list L: the cdr contains the list, the car the last cons @@ -315,7 +330,6 @@ appendable_list_append (SCM l, SCM elt) scm_set_car_x (l, newcons); } - SCM ly_offset2scm (Offset o) { @@ -329,12 +343,11 @@ ly_scm2offset (SCM s) ly_scm2double (ly_cdr (s))); } - LY_DEFINE (ly_number2string, "ly:number->string", 1, 0, 0, (SCM s), "Convert @var{num} to a string without generating many decimals.") { - SCM_ASSERT_TYPE (is_number (s), s, SCM_ARG1, __FUNCTION__, "number"); + SCM_ASSERT_TYPE (ly_c_number_p (s), s, SCM_ARG1, __FUNCTION__, "number"); char str[400]; // ugh. @@ -386,7 +399,7 @@ ly_deep_copy (SCM src) { if (ly_c_pair_p (src)) return scm_cons (ly_deep_copy (ly_car (src)), ly_deep_copy (ly_cdr (src))); - else if (is_vector (src)) + else if (ly_c_vector_p (src)) { int len = SCM_VECTOR_LENGTH (src); SCM nv = scm_c_make_vector (len, SCM_UNDEFINED); @@ -527,7 +540,7 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) if (val == SCM_EOL || val == SCM_BOOL_F) return ok; - if (!is_symbol (sym)) + if (!ly_c_symbol_p (sym)) #if 0 return false; #else @@ -544,7 +557,7 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) SCM type = scm_object_property (sym, type_symbol); - if (type != SCM_EOL && !is_procedure (type)) + if (type != SCM_EOL && !ly_c_procedure_p (type)) { warning (_f ("Can't find property type-check for `%s' (%s).", ly_symbol2string (sym).to_str0 (), @@ -560,7 +573,7 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) else { if (val != SCM_EOL - && is_procedure (type) + && ly_c_procedure_p (type) && scm_call_1 (type, val) == SCM_BOOL_F) { SCM errport = scm_current_error_port (); @@ -595,7 +608,7 @@ ly_unique (SCM list) for (SCM i = list; ly_c_pair_p (i); i = ly_cdr (i)) { if (!ly_c_pair_p (ly_cdr (i)) - || !is_equal (ly_car (i), ly_cadr (i))) + || !ly_c_equal_p (ly_car (i), ly_cadr (i))) unique = scm_cons (ly_car (i), unique); } return scm_reverse_x (unique, SCM_EOL); @@ -658,7 +671,7 @@ ly_split_list (SCM s, SCM list) { SCM i = ly_car (after); after = ly_cdr (after); - if (is_equal (i, s)) + if (ly_c_equal_p (i, s)) break; before = scm_cons (i, before); } @@ -699,7 +712,7 @@ int_list_to_slice (SCM l) Slice s; s.set_empty (); for (; ly_c_pair_p (l); l = ly_cdr (l)) - if (is_number (ly_car (l))) + if (ly_c_number_p (ly_car (l))) s.add_point (ly_scm2int (ly_car (l))); return s; } @@ -719,7 +732,7 @@ robust_list_ref (int i, SCM l) Real robust_scm2double (SCM k, double x) { - if (is_number (k)) + if (ly_c_number_p (k)) x = ly_scm2double (k); return x; } @@ -764,9 +777,9 @@ alist_to_hashq (SCM alist) { int i = scm_ilength (alist); if (i < 0) - return scm_make_vector (scm_int2num (0), SCM_EOL); + return scm_c_make_hash_table (0); - SCM tab = scm_make_vector (scm_int2num (i), SCM_EOL); + SCM tab = scm_c_make_hash_table (i); for (SCM s = alist; ly_c_pair_p (s); s = ly_cdr (s)) { SCM pt = ly_cdar (s); @@ -779,9 +792,35 @@ alist_to_hashq (SCM alist) /* Debugging mem leaks: */ -LY_DEFINE (ly_protects, "ly:protects", 0, 0, 0, (), +LY_DEFINE (ly_protects, "ly:protects", + 0, 0, 0, (), "Return hash of protected objects.") { return scm_protects; } #endif + + +#if HAVE_PANGO_FC_FONT_MAP_ADD_DECODER_FIND_FUNC + +#include "pangofc-afm-decoder.hh" + +LY_DEFINE (ly_pango_add_afm_decoder, "ly:pango-add-afm-decoder", + 1, 0, 0, (SCM font_family), + "Add pango afm decoder for FONT-FAMILY.") +{ + SCM_ASSERT_TYPE (ly_c_string_p (font_family), font_family, SCM_ARG1, __FUNCTION__, "font_family"); + pango_fc_afm_add_decoder (ly_scm2newstr (font_family, 0)); + return SCM_UNSPECIFIED; +} + +#endif + +LY_DEFINE (ly_gettext, "ly:gettext", + 1, 0, 0, (SCM string), + "Gettext wrapper.") +{ + SCM_ASSERT_TYPE (ly_c_string_p (string), string, SCM_ARG1, + __FUNCTION__, "string"); + return scm_makfrom0str (gettext (ly_scm2str0 (string))); +}