release: 1.5.29

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

diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index 376a0a6928dc12ef2903dc583d6d36cdda933d25..3e1abf676547e905dbd259c7906cf275c5f3e2fa 100644 (file)
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -3,7 +3,7 @@
 
   source file of the GNU LilyPond music typesetter
 
-  (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
+  (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
 
   Han-Wen Nienhuys <hanwen@cs.uu.nl>
 */
@@ -11,8 +11,8 @@
 
 #include <stdio.h>
 #include <stdlib.h>
-#include <math.h>              // isinf
-
+#include <math.h>   /* isinf */
+#include <string.h> /* strdup, strchr */
 #include "libc-extension.hh"
 #include "lily-guile.hh"
 #include "main.hh"
@@ -22,6 +22,7 @@
 #include "direction.hh"
 #include "offset.hh"
 #include "interval.hh"
+#include "pitch.hh"
 
 SCM
 ly_last (SCM list)
@@ -111,16 +112,10 @@ ly_parse_scm (char const* s, int* n)
 SCM
 ly_quote_scm (SCM s)
 {
-  return scm_listify (ly_symbol2scm ("quote"), s, SCM_UNDEFINED);
+  return scm_list_n (ly_symbol2scm ("quote"), s, SCM_UNDEFINED);
 }
 
 
-SCM
-ly_symbol2scm (const char *s)
-{
-  return gh_symbol2scm ((char *)s);
-}
-
 
 String
 ly_symbol2string (SCM s)
@@ -166,7 +161,7 @@ ly_gulp_file (SCM fn)
 void
 read_lily_scm_file (String fn)
 {
-  scm_c_eval_string ((char *) gulp_file_to_string (fn).ch_C ());
+  gh_eval_str ((char *) gulp_file_to_string (fn).ch_C ());
 }
 
 extern "C" {
@@ -251,14 +246,39 @@ void add_scm_init_func (void (*f) ())
 
   scm_init_funcs_->push (f);
 }
+
 extern  void init_cxx_function_smobs ();
 
 void
-init_lily_guile ()
+prepend_load_path (String p )
+{
+  char s[1024];
+  sprintf (s, 
+          "(set! %%load-path (cons \"%s\" %%load-path))", p.ch_C());
+
+  scm_c_eval_string (s);
+}
+
+void
+init_lily_guile (String p )
 {
+  prepend_load_path (p);
+
+  // todo: junk this. We should make real modules iso. just loading files.
+  prepend_load_path (p + "/scm/");
+
+  SCM last_mod = scm_current_module ();
+  scm_set_current_module (scm_c_resolve_module ("guile"));
+  
   init_cxx_function_smobs ();
   for (int i=scm_init_funcs_->size () ; i--;)
- (scm_init_funcs_->elem (i)) ();
+    (scm_init_funcs_->elem (i)) ();
+
+  if (verbose_global_b)
+    progress_indication ("\n");
+  read_lily_scm_file ("lily.scm");
+
+  scm_set_current_module (last_mod);
 }
 
 unsigned int ly_scm_hash (SCM s)
@@ -397,7 +417,7 @@ ly_number2string (SCM s)
 
   char str[400];                       // ugh.
 
-  if (scm_integer_p (s) == SCM_BOOL_F)
+  if (scm_exact_p (s) == SCM_BOOL_F)
     {
       Real r (gh_scm2double (s));
 
@@ -446,7 +466,7 @@ ly_version ()
 {
   char const* vs =  "\' (" MAJOR_VERSION " " MINOR_VERSION " "  PATCH_LEVEL " " MY_PATCH_LEVEL ")" ;
   
-  return scm_c_eval_string ((char*)vs);
+  return gh_eval_str ((char*)vs);
 }
 
 static void
@@ -499,3 +519,90 @@ ly_assoc_chain (SCM key, SCM achain)
   else
     return SCM_BOOL_F;
 }
+
+/* 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.
+
+   alist = ((1 . 10)
+                   ((1 . 2) . 11)
+                   ((2 . 1) . 12)
+                   ((3 . 0) . 13)
+                   ((4 . 1) . 14) )
+
+I would like (ly_assoc_cdr 1) to return 12 - because it's the first
+element with the cdr of the key = 1.  In other words (alloc_cdr key)
+corresponds to call
+
+(alloc (anything . key))
+
+
+
+*/
+SCM
+ly_assoc_cdr (SCM key, SCM alist)
+{
+  if (gh_pair_p (alist)) {
+    SCM trykey = ly_caar(alist);
+    if(gh_pair_p(trykey) && to_boolean(scm_equal_p(key,ly_cdr(trykey))))
+      return ly_car(alist);
+    else
+      return ly_assoc_cdr (key, ly_cdr (alist));
+  }
+  else
+    return SCM_BOOL_F;
+}
+
+/*
+  LIST has the form "sym1 sym2 sym3" 
+ */
+SCM
+parse_symbol_list (const char * list)
+{
+  char * s = strdup (list);
+  char *orig = s;
+  SCM create_list = SCM_EOL;
+  if (!s[0] )
+    s = 0;
+
+  while (s)
+    {
+      char *next = strchr (s, ' ');
+      if (next)
+       *next++ = 0;
+
+      create_list = gh_cons (ly_symbol2scm (s), create_list);
+      s = next;
+    }
+
+  free (orig);
+  return create_list;
+}
+
+
+SCM
+ly_truncate_list (int k, SCM l )
+{
+  if (k == 0)
+    {
+      l = SCM_EOL;
+    }
+  else
+    {
+      SCM s = l;
+      k--;
+      for (; gh_pair_p (s) && k--; s = ly_cdr (s))
+       ;
+
+      if (gh_pair_p (s))
+       {
+         gh_set_cdr_x (s, SCM_EOL);
+       }
+    }
+  return l;
+}
+
+SCM my_gh_symbol2scm (const char* x)
+{
+  return gh_symbol2scm ((char*)x);
+}