source file of the GNU LilyPond music typesetter
- (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
- Han-Wen Nienhuys <hanwen@cs.uu.nl>
+ (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+ Han-Wen Nienhuys <hanwen@xs4all.nl>
*/
#include "lily-guile.hh"
#include <cstring> /* strdup, strchr */
#include <cctype>
+using namespace std;
+
#include "config.hh"
#include "dimensions.hh"
#include "misc.hh"
#include "offset.hh"
#include "pitch.hh"
+#include "string-convert.hh"
#include "source-file.hh"
#include "version.hh"
#include "warn.hh"
return scm_list_n (ly_symbol2scm ("quote"), s, SCM_UNDEFINED);
}
-String
+string
ly_symbol2string (SCM s)
{
/*
return ly_scm2string (str);
}
-String
-gulp_file_to_string (String fn, bool must_exist)
+string
+gulp_file_to_string (string fn, bool must_exist, int size)
{
- String s = global_path.find (fn);
+ string s = global_path.find (fn);
if (s == "")
{
if (must_exist)
{
- String e = _f ("can't find file: `%s'", fn);
+ string e = _f ("can't find file: `%s'", fn);
e += " ";
e += _f ("(load path: `%s')", global_path.to_string ());
error (e);
if (be_verbose_global)
progress_indication ("[" + s);
- int n;
- char *str = gulp_file (s, &n);
- String result ((Byte *) str, n);
- delete[] str;
+ vector<char> chars = gulp_file (s, size);
+ string result (&chars[0], chars.size ());
if (be_verbose_global)
progress_indication ("]");
return result;
}
-extern "C" {
- // maybe gdb 5.0 becomes quicker if it doesn't do fancy C++ typing?
- void
- ly_display_scm (SCM s)
- {
- scm_display (s, scm_current_output_port ());
- scm_newline (scm_current_output_port ());
- }
-};
+void
+ly_display_scm (void *s)
+{
+ scm_display ((SCM)s, scm_current_output_port ());
+ scm_newline (scm_current_output_port ());
+}
-String
+string
ly_scm2string (SCM str)
{
assert (scm_is_string (str));
- return String ((Byte *)scm_i_string_chars (str),
+ return string (scm_i_string_chars (str),
(int) scm_i_string_length (str));
}
if (lenp)
*lenp = len;
-
+
return new_str;
}
return 0;
SCM
index_get_cell (SCM s, Direction d)
{
-
+
assert (d);
return (d == LEFT) ? scm_car (s) : scm_cdr (s);
}
scm_set_cdr_x (s, v);
return s;
}
-
+
bool
is_number_pair (SCM p)
{
}
typedef void (*Void_fptr) ();
-Array<Void_fptr> *scm_init_funcs_;
+vector<Void_fptr> *scm_init_funcs_;
void add_scm_init_func (void (*f) ())
{
if (!scm_init_funcs_)
- scm_init_funcs_ = new Array<Void_fptr>;
+ scm_init_funcs_ = new vector<Void_fptr>;
- scm_init_funcs_->push (f);
+ scm_init_funcs_->push_back (f);
}
-#if KPATHSEA
-extern "C" {
- void initialize_kpathsea ();
-}
-#endif
-
void
ly_init_ly_module (void *)
{
- for (int i = scm_init_funcs_->size (); i--;)
- (scm_init_funcs_->elem (i)) ();
+ for (vsize i = scm_init_funcs_->size (); i--;)
+ (scm_init_funcs_->at (i)) ();
if (be_verbose_global)
- progress_indication ("\n");
-
-#if KPATHSEA
- if (is_TeX_format_global)
- initialize_kpathsea ();
-#endif
+ {
+ progress_indication ("[");
+ scm_display (scm_c_eval_string ("(%search-load-path \"lily.scm\")"),
+ scm_current_error_port ());
+ progress_indication ("]\n");
+ }
scm_primitive_load_path (scm_makfrom0str ("lily.scm"));
}
return src;
}
-
-
/* looks the key up in the cdrs of the alist-keys
- ignoring the car and ignoring non-pair keys.
Returns first match found, i.e.
if (scm_is_pair (alist))
{
SCM trykey = scm_caar (alist);
- if (scm_is_pair (trykey) && to_boolean (scm_equal_p (key, scm_cdr (trykey))))
+ if (scm_is_pair (trykey)
+ && to_boolean (scm_equal_p (key, scm_cdr (trykey))))
return scm_car (alist);
- else
- return ly_assoc_cdr (key, scm_cdr (alist));
+ return ly_assoc_cdr (key, scm_cdr (alist));
}
return SCM_BOOL_F;
}
-/* LST has the form "sym1 sym2 sym3\nsym4\nsym5"
- i.e. \n and ' ' can be used interchangeably as separators. */
SCM
-parse_symbol_list (char const *lst)
-{
- char *s = strdup (lst);
- 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')
- *p = ' ';
-
- if (!s[0])
- s = 0;
-
- while (s)
- {
- char *next = strchr (s, ' ');
- if (next)
- *next++ = 0;
-
- create_list = scm_cons (ly_symbol2scm (s), create_list);
- s = next;
- }
+ly_string_array_to_scm (vector<string> a)
+{
+ SCM s = SCM_EOL;
+ for (vsize i = a.size (); i ; i--)
+ s = scm_cons (ly_symbol2scm (a[i - 1].c_str ()), s);
+ return s;
+}
- free (orig);
- return create_list;
+/* SYMBOLS is a whitespace separated list. */
+SCM
+parse_symbol_list (char const *symbols)
+{
+ while (isspace (*symbols))
+ *symbols++;
+ string s = symbols;
+ replace_all (s, '\n', ' ');
+ replace_all (s, '\t', ' ');
+ return ly_string_array_to_scm (string_split (s, ' '));
}
SCM
return lst;
}
-String
+string
print_scm_val (SCM val)
{
- String realval = ly_scm2string (ly_write2scm (val));
+ string realval = ly_scm2string (ly_write2scm (val));
if (realval.length () > 200)
- realval = realval.left_string (100)
+ realval = realval.substr (0, 100)
+ "\n :\n :\n"
- + realval.right_string (100);
+ + realval.substr (realval.length () - 100);
return realval;
}
if (type != SCM_EOL && !ly_is_procedure (type))
{
warning (_f ("can't find property type-check for `%s' (%s).",
- ly_symbol2string (sym).to_str0 (),
- ly_symbol2string (type_symbol).to_str0 ())
+ ly_symbol2string (sym).c_str (),
+ ly_symbol2string (type_symbol).c_str ())
+ " " + _ ("perhaps a typing error?"));
/* Be strict when being anal :) */
SCM typefunc = ly_lily_module_constant ("type-name");
SCM type_name = scm_call_1 (typefunc, type);
- message (_f ("type check for `%s' failed; value `%s' must be of type `%s'",
- ly_symbol2string (sym).to_str0 (),
+ warning (_f ("type check for `%s' failed; value `%s' must be of type `%s'",
+ ly_symbol2string (sym).c_str (),
print_scm_val (val),
- ly_scm2string (type_name).to_str0 ()));
+ ly_scm2string (type_name).c_str ()));
progress_indication ("\n");
}
}
return pa < pb ? -1 : 1;
}
-/* Modify LST in place: qsort it. */
+/* Modify LST in place: qsort it.
+
+FIXME: unused, junk? */
SCM
ly_list_qsort_uniq_x (SCM lst)
{
return x;
}
+Direction
+robust_scm2dir (SCM d, Direction def)
+{
+ if (is_direction (d))
+ def = to_dir (d);
+ return def;
+}
+
Interval
robust_scm2interval (SCM k, Drul_array<Real> v)
{
return v;
}
+Drul_array<bool>
+robust_scm2booldrul (SCM k, Drul_array<bool> def)
+{
+ if (scm_is_pair (k))
+ {
+ def[LEFT] = to_boolean (scm_car (k));
+ def[RIGHT] = to_boolean (scm_cdr (k));
+ }
+ return def;
+}
+
Offset
robust_scm2offset (SCM k, Offset o)
{
return o;
}
+string
+robust_scm2string (SCM k, string s)
+{
+ if (scm_is_string (k))
+ s = ly_scm2string (k);
+ return s;
+}
+
int
robust_scm2int (SCM k, int o)
{
{
SCM x = SCM_EOL;
for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
- {
- x = scm_cons (scm_cdar (p), x);
- }
+ x = scm_cons (scm_cdar (p), x);
return x;
}
return scm_call_1 (func, tab);
}
+int
+procedure_arity (SCM proc)
+{
+ assert (ly_is_procedure (proc));
+ SCM arity = scm_procedure_property (proc,
+ ly_symbol2scm ("arity"));
+
+ SCM fixed = scm_car (arity);
+ return scm_to_int (fixed);
+}
+
+string
+mangle_cxx_identifier (string cxx_id)
+{
+ if (cxx_id.substr (0, 3) == "ly_")
+ cxx_id = cxx_id.replace (0, 3, "ly:");
+ else
+ {
+ cxx_id = String_convert::to_lower (cxx_id);
+ cxx_id = "ly:" + cxx_id;
+ }
+ if (cxx_id.substr (cxx_id.length () - 2) == "_p")
+ cxx_id = cxx_id.replace (cxx_id.length () - 2, 1, "?");
+ else if (cxx_id.substr (cxx_id.length () - 2) == "_x")
+ cxx_id = cxx_id.replace (cxx_id.length () - 2, 1, "!");
+
+ cxx_id = replace_all (cxx_id, '_', '-');
+ return cxx_id;
+}
+