+
+
+/* some SCM abbrevs
+
+ zijn deze nou handig?
+ zijn ze er al in scheme, maar heten ze anders? */
+
+
+/* Remove doubles from (sorted) list */
+SCM
+ly_unique (SCM list)
+{
+ SCM unique = SCM_EOL;
+ for (SCM i = list; ly_c_pair_p (i); i = ly_cdr (i))
+ {
+ if (!ly_c_pair_p (ly_cdr (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);
+}
+
+
+static int
+scm_default_compare (void const *a, void const *b)
+{
+ SCM pa = *(SCM*) a;
+ SCM pb = *(SCM*) b;
+ if (pa == pb)
+ return 0;
+ return pa < pb ? -1 : 1;
+}
+
+/* Modify LST in place: qsort it. */
+SCM
+ly_list_qsort_uniq_x (SCM lst)
+{
+ int len = scm_ilength (lst);
+ SCM *arr = new SCM[len];
+ int k = 0;
+ for (SCM s = lst; SCM_NNULLP (s); s = SCM_CDR (s))
+ arr[k++] = SCM_CAR (s);
+
+ assert (k == len);
+ qsort (arr, len, sizeof (SCM), &scm_default_compare);
+
+ SCM *tail = &lst;
+ for (int i = 0; i < len; i++)
+ if (!i || arr[i] != arr[i - 1])
+ {
+ SCM_SETCAR (*tail, arr[i]);
+ tail = SCM_CDRLOC (*tail);
+ }
+
+ *tail = SCM_EOL;
+ delete[] arr;
+
+ return lst;
+}
+
+
+/* tail add */
+SCM
+ly_snoc (SCM s, SCM list)
+{
+ return ly_append2 (list, scm_list_n (s, SCM_UNDEFINED));
+}
+
+/* Split list at member s, removing s.
+ Return (BEFORE . AFTER) */
+SCM
+ly_split_list (SCM s, SCM list)
+{
+ SCM before = SCM_EOL;
+ SCM after = list;
+ for (; ly_c_pair_p (after);)
+ {
+ SCM i = ly_car (after);
+ after = ly_cdr (after);
+ if (ly_c_equal_p (i, s))
+ break;
+ before = scm_cons (i, before);
+ }
+ return scm_cons ( scm_reverse_x (before, SCM_EOL), after);
+
+}
+
+
+void
+taint (SCM *)
+{
+ /*
+ nop.
+ */
+}
+
+/*
+ display stuff without using stack
+ */
+SCM
+display_list (SCM s)
+{
+ SCM p = scm_current_output_port ();
+
+ scm_puts ("(", p);
+ for (; ly_c_pair_p (s); s =ly_cdr (s))
+ {
+ scm_display (ly_car (s), p);
+ scm_puts (" ", p);
+ }
+ scm_puts (")", p);
+ return SCM_UNSPECIFIED;
+}
+
+Slice
+int_list_to_slice (SCM l)
+{
+ Slice s;
+ s.set_empty ();
+ for (; ly_c_pair_p (l); l = ly_cdr (l))
+ if (ly_c_number_p (ly_car (l)))
+ s.add_point (ly_scm2int (ly_car (l)));
+ return s;
+}
+
+/* Return I-th element, or last elt L. If I < 0, then we take the first
+ element.
+
+ PRE: length (L) > 0 */
+SCM
+robust_list_ref (int i, SCM l)
+{
+ while (i-- > 0 && ly_c_pair_p (ly_cdr (l)))
+ l = ly_cdr (l);
+ return ly_car (l);
+}
+
+Real
+robust_scm2double (SCM k, double x)
+{
+ if (ly_c_number_p (k))
+ x = ly_scm2double (k);
+ return x;
+}
+
+Interval
+robust_scm2interval (SCM k, Drul_array<Real> v)
+{
+ Interval i;
+ i[LEFT]= v[LEFT];
+ i[RIGHT]= v[RIGHT];
+ if (is_number_pair (k))
+ i = ly_scm2interval (k);
+ return i;
+}
+
+Drul_array<Real>
+robust_scm2drul (SCM k, Drul_array<Real> 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 = ly_scm2int (k);
+ return o;
+}
+
+SCM
+alist_to_hashq (SCM alist)
+{
+ int i = scm_ilength (alist);
+ if (i < 0)
+ return scm_make_vector (scm_int2num (0), SCM_EOL);
+
+ SCM tab = scm_make_vector (scm_int2num (i), SCM_EOL);
+ for (SCM s = alist; ly_c_pair_p (s); s = ly_cdr (s))
+ {
+ SCM pt = ly_cdar (s);
+ scm_hashq_set_x (tab, ly_caar (s), pt);
+ }
+ return tab;
+}
+
+#if 1
+/*
+ Debugging mem leaks:
+ */
+LY_DEFINE (ly_protects, "ly:protects",
+ 0, 0, 0, (),
+ "Return hash of protected objects.")
+{
+ return scm_protects;
+}
+#endif
+
+
+#ifdef 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