]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/lily-guile.cc
Doc: Augment section about titles (3103)
[lilypond.git] / lily / lily-guile.cc
index 4d6f6a79c6440c331d54f090853cda0439243500..27909a6bc2a43bccca2bcce48fdb029099f3eb6d 100644 (file)
@@ -1,7 +1,7 @@
 /*
   This file is part of LilyPond, the GNU music typesetter.
 
-  Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+  Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
   Han-Wen Nienhuys <hanwen@xs4all.nl>
 
   LilyPond is free software: you can redistribute it and/or modify
@@ -62,7 +62,7 @@ ly_scm_write_string (SCM s)
 SCM
 ly_quote_scm (SCM s)
 {
-  return scm_list_n (ly_symbol2scm ("quote"), s, SCM_UNDEFINED);
+  return scm_list_2 (ly_symbol2scm ("quote"), s);
 }
 
 string
@@ -71,8 +71,13 @@ ly_symbol2string (SCM s)
   /*
     Ugh. this is not very efficient.
   */
-  SCM str = scm_symbol_to_string (s);
-  return ly_scm2string (str);
+  return ly_scm2string (scm_symbol_to_string (s));
+}
+
+string
+robust_symbol2string (SCM sym, string str)
+{
+  return scm_is_symbol (sym) ? ly_symbol2string (sym) : str;
 }
 
 string
@@ -92,14 +97,12 @@ gulp_file_to_string (string fn, bool must_exist, int size)
       return s;
     }
 
-  if (be_verbose_global)
-    progress_indication ("[" + s);
+  debug_output ("[" + s, true);
 
   vector<char> chars = gulp_file (s, size);
   string result (&chars[0], chars.size ());
 
-  if (be_verbose_global)
-    progress_indication ("]\n");
+  debug_output ("]\n", false);
 
   return result;
 }
@@ -180,7 +183,7 @@ ly_scm_hash (SCM s)
 bool
 is_axis (SCM s)
 {
-  if (scm_is_number (s))
+  if (scm_is_integer (s))
     {
       int i = scm_to_int (s);
       return i == 0 || i == 1;
@@ -228,7 +231,8 @@ is_direction (SCM s)
 Interval
 ly_scm2interval (SCM p)
 {
-  return Interval (scm_to_double (scm_car (p)), scm_to_double (scm_cdr (p)));
+  return Interval (scm_to_double (scm_car (p)),
+                   scm_to_double (scm_cdr (p)));
 }
 
 Drul_array<Real>
@@ -322,25 +326,6 @@ ly_scm2offsets (SCM s)
 /*
   ALIST
 */
-
-bool
-alist_equal_p (SCM a, SCM b)
-{
-  for (SCM s = a;
-       scm_is_pair (s); s = scm_cdr (s))
-    {
-      SCM key = scm_caar (s);
-      SCM val = scm_cdar (s);
-      SCM l = scm_assoc (key, b);
-
-      if (l == SCM_BOOL_F
-          || !ly_is_equal (scm_cdr (l), val))
-
-        return false;
-    }
-  return true;
-}
-
 SCM
 ly_alist_vals (SCM alist)
 {
@@ -370,8 +355,23 @@ SCM
 ly_deep_copy (SCM src)
 {
   if (scm_is_pair (src))
-    return scm_cons (ly_deep_copy (scm_car (src)), ly_deep_copy (scm_cdr (src)));
-  else if (scm_is_vector (src))
+    {
+      SCM res = SCM_EOL;
+      do
+        {
+          res = scm_cons (ly_deep_copy (scm_car (src)), res);
+          src = scm_cdr (src);
+        }
+      while (scm_is_pair (src));
+      // Oh, come on, GUILE.  Why do you require the second argument
+      // of scm_reverse_x to be a proper list?  That makes no sense.
+      // return scm_reverse_x (res, ly_deep_copy (src));
+      SCM last_cons = res;
+      res = scm_reverse_x (res, SCM_EOL);
+      scm_set_cdr_x (last_cons, ly_deep_copy (src));
+      return res;
+    }
+  if (scm_is_vector (src))
     {
       int len = scm_c_vector_length (src);
       SCM nv = scm_c_make_vector (len, SCM_UNDEFINED);
@@ -380,6 +380,7 @@ ly_deep_copy (SCM src)
           SCM si = scm_from_int (i);
           scm_vector_set_x (nv, si, ly_deep_copy (scm_vector_ref (src, si)));
         }
+      return nv;
     }
   return src;
 }
@@ -409,20 +410,10 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol)
   if (val == SCM_EOL || val == SCM_BOOL_F)
     return ok;
 
+  // If undefined, some internal function caused it...should never happen.
+  assert (val != SCM_UNDEFINED);
   if (!scm_is_symbol (sym))
-#if 0
     return false;
-#else
-    /*
-      This is used for autoBeamSettings.
-
-      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);
 
@@ -542,6 +533,28 @@ robust_scm2double (SCM k, double x)
   return x;
 }
 
+vector<Real>
+ly_scm2floatvector (SCM l)
+{
+  vector<Real> floats;
+  for (SCM s = l; scm_is_pair (s); s = scm_cdr (s))
+    floats.push_back (robust_scm2double (scm_car (s), 0.0));
+  return floats;
+}
+
+SCM
+ly_floatvector2scm (vector<Real> v)
+{
+  SCM l = SCM_EOL;
+  SCM *tail = &l;
+  for (vsize i = 0; i < v.size (); i++)
+    {
+      *tail = scm_cons (scm_from_double (v[i]), SCM_EOL);
+      tail = SCM_CDRLOC (*tail);
+    }
+  return l;
+}
+
 string
 robust_scm2string (SCM k, string s)
 {
@@ -558,9 +571,29 @@ robust_scm2int (SCM k, int o)
   return o;
 }
 
+vsize
+robust_scm2vsize (SCM k, vsize o)
+{
+  if (scm_integer_p (k) == SCM_BOOL_T)
+    {
+      int i = scm_to_int (k);
+      if (i >= 0)
+        return (vsize) i;
+    }
+  return o;
+}
+
 SCM
 ly_rational2scm (Rational r)
 {
+  if (r.is_infinity ())
+    {
+      if (r > Rational (0))
+        return scm_inf ();
+
+      return scm_difference (scm_inf (), SCM_UNDEFINED);
+    }
+
   return scm_divide (scm_from_int64 (r.numerator ()),
                      scm_from_int64 (r.denominator ()));
 }
@@ -568,6 +601,22 @@ ly_rational2scm (Rational r)
 Rational
 ly_scm2rational (SCM r)
 {
+  if (scm_is_true (scm_inf_p (r)))
+    {
+      if (scm_is_true (scm_positive_p (r)))
+        {
+          Rational r;
+          r.set_infinite (1);
+          return r;
+        }
+      else
+        {
+          Rational r;
+          r.set_infinite (-1);
+          return r;
+        }
+    }
+
   return Rational (scm_to_int64 (scm_numerator (r)),
                    scm_to_int64 (scm_denominator (r)));
 }
@@ -575,12 +624,20 @@ ly_scm2rational (SCM r)
 Rational
 robust_scm2rational (SCM n, Rational rat)
 {
-  if (ly_is_fraction (n))
+  if (ly_is_rational (n))
     return ly_scm2rational (n);
   else
     return rat;
 }
 
+bool
+ly_is_rational (SCM n)
+{
+  return (scm_is_real (n)
+          && (scm_is_true (scm_exact_p (n))
+              || scm_is_true (scm_inf_p (n))));
+}
+
 SCM
 alist_to_hashq (SCM alist)
 {