tab patch 4

[lilypond.git] / lily / lily-guile.cc

diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index cf15fbd9628ab5f790a346e3e84138c401d4e73f..d490e50f60c7347f51aec5e74ba7811f243e9eee 100644 (file)
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -23,6 +23,7 @@
 #include "offset.hh"
 #include "interval.hh"
 #include "pitch.hh"
+#include "dimensions.hh"
 
 SCM
 ly_last (SCM list)
@@ -147,17 +148,24 @@ gulp_file_to_string (String fn)
   return result;
 }
 
-SCM
-ly_gulp_file (SCM fn)
+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.
+
+")
 {
-  return ly_str02scm (gulp_file_to_string (ly_scm2string (fn)).ch_C ());
+  return ly_str02scm (gulp_file_to_string (ly_scm2string (name)).ch_C ());
 }
 
 
 /**
    Read a file, and shove it down GUILE.  GUILE also has file read
    functions, but you can't fiddle with the path of those.
- */
+
+
+   TODO: JUNKME.
+*/
 void
 read_lily_scm_file (String fn)
 {
@@ -205,16 +213,19 @@ index_set_cell (SCM s, Direction d, SCM v)
   return s;
 }
   
-SCM
-ly_warning (SCM str)
+LY_DEFINE(ly_warning,"ly-warn", 1, 0, 0,
+  (SCM str),"Scheme callable function to issue the warning @code{msg}.
+")
 {
   assert (gh_string_p (str));
   warning ("lily-guile: " + ly_scm2string (str));
   return SCM_BOOL_T;
 }
 
-SCM
-ly_isdir_p (SCM s)
+LY_DEFINE(ly_isdir_p,  "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))
     {
@@ -230,12 +241,6 @@ ly_number_pair_p (SCM p)
   return gh_pair_p (p) && gh_number_p (ly_car (p)) && gh_number_p (ly_cdr (p));
 }
 
-bool
-ly_axis_p (SCM a)
-{
-  return gh_number_p (a) && (gh_scm2int (a) == 0 || gh_scm2int (a) == 1); 
-}
-
 typedef void (*Void_fptr) ();
 Array<Void_fptr> *scm_init_funcs_;
 
@@ -289,7 +294,7 @@ unsigned int ly_scm_hash (SCM s)
 
 
 bool
-isdir_b (SCM s)
+ly_dir_p (SCM s)
 {
   if (gh_number_p (s))
     {
@@ -301,7 +306,7 @@ isdir_b (SCM s)
 
 
 bool
-isaxis_b (SCM s)
+ly_axis_p (SCM s)
 {
   if (gh_number_p (s))
     {
@@ -326,7 +331,7 @@ ly_scm2interval (SCM p)
 }
 
 SCM
-ly_interval2scm (Interval i)
+ly_interval2scm (Drul_array<Real> i)
 {
   return gh_cons (gh_double2scm (i[LEFT]),
                  gh_double2scm (i[RIGHT]));
@@ -410,8 +415,11 @@ ly_type (SCM exp)
  */
    
    
-SCM
-ly_number2string (SCM s)
+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.
+")
 {
   assert (gh_number_p (s));
 
@@ -461,28 +469,31 @@ wave_sweep_goodbye (void *dummy1, void *dummy2, void *dummy3)
 
 
 #include "version.hh"
-SCM
-ly_version ()
+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 ")" ;
   
   return gh_eval_str ((char*)vs);
 }
 
-static void
-init_functions ()
+LY_DEFINE(ly_unit,  "ly-unit", 0, 0, 0, (),
+         "Return the unit used for lengths as a string.")
 {
-  scm_c_define_gsubr ("ly-warn", 1, 0, 0,
-                     (Scheme_function_unknown)ly_warning);
-  scm_c_define_gsubr ("ly-version", 0, 0, 0,
-                     (Scheme_function_unknown)ly_version);  
-  scm_c_define_gsubr ("ly-gulp-file", 1,0, 0,
-                     (Scheme_function_unknown)ly_gulp_file);
-  scm_c_define_gsubr ("dir?", 1,0, 0, (Scheme_function_unknown)ly_isdir_p);
-  scm_c_define_gsubr ("ly-number->string", 1, 0,0,
-                     (Scheme_function_unknown) ly_number2string);
+  return ly_str02scm (INTERNAL_UNIT);
+}
 
+LY_DEFINE(ly_verbose,  "ly-verbose", 0, 0, 0, (),
+  "Return whether lilypond is being run in verbose mode.")
+{
+  return gh_bool2scm (verbose_global_b);
+}
 
+static void
+init_functions ()
+{
 #ifdef TEST_GC 
   scm_c_hook_add (&scm_before_mark_c_hook, greet_sweep, 0, 0);
   scm_c_hook_add (&scm_before_sweep_c_hook, wave_sweep_goodbye, 0, 0);
@@ -554,7 +565,9 @@ ly_assoc_cdr (SCM key, SCM alist)
 }
 
 /*
-  LIST has the form "sym1 sym2 sym3" 
+  LIST has the form "sym1 sym2 sym3\nsym4\nsym5"
+
+  i.e. \n and ' ' can be used interchangeably as separators.
  */
 SCM
 parse_symbol_list (const char * list)
@@ -562,9 +575,18 @@ parse_symbol_list (const char * list)
   char * s = strdup (list);
   char *orig = s;
   SCM create_list = SCM_EOL;
+
+  for (char * p = s; *p; p++)
+    {
+      if (*p == '\n')
+       *p = ' ' ;
+    }
+  
   if (!s[0] )
     s = 0;
 
+
+  
   while (s)
     {
       char *next = strchr (s, ' ');
@@ -667,3 +689,52 @@ type_check_assignment (SCM sym, SCM val,  SCM type_symbol)
     }
   return ok;
 }
+
+
+/* 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; gh_pair_p (i); i = ly_cdr (i))
+    {
+      if (!gh_pair_p (ly_cdr (i))
+         || !gh_equal_p (ly_car (i), ly_cadr (i)))
+       unique = gh_cons (ly_car (i), unique);
+    }
+  return scm_reverse_x (unique, SCM_EOL);
+}
+
+/* tail add */
+SCM
+ly_snoc (SCM s, SCM list)
+{
+  return gh_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 (; gh_pair_p (after);)
+    {
+      SCM i = ly_car (after);
+      after = ly_cdr (after);
+      if (gh_equal_p (i, s))
+       break;
+      before = gh_cons (i, before);
+    }
+  return gh_cons ( scm_reverse_x (before, SCM_EOL),  after);
+  
+}
+