lily/lily-guile.cc

   1 /*
   2   lily-guile.cc -- implement assorted guile functions
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1998--1999 Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8   Han-Wen Nienhuys <hanwen@cs.uu.nl>
   9 */
  10
  11
  12 #include <stdio.h>
  13 #include <stdlib.h>
  14
  15 #include "libc-extension.hh"
  16 #include "lily-guile.hh"
  17 #include "main.hh"
  18 #include "simple-file-storage.hh"
  19 #include "file-path.hh"
  20 #include "debug.hh"
  21
  22 SCM
  23 ly_ch_C_to_scm (char const*c)
  24 {
  25   // this all really sucks, guile should take char const* arguments!
  26   return gh_str02scm ((char*)c);
  27 }
  28
  29 SCM
  30 ly_ch_C_eval_scm (char const*c)
  31 {
  32   // this all really sucks, guile should take char const* arguments!
  33   return gh_eval_str ((char*)c);
  34 }
  35
  36 /*
  37   scm_m_quote doesn't use any env, but needs one for a good signature in GUILE.
  38 */
  39
  40 SCM
  41 ly_quote_scm (SCM s)
  42 {
  43   return scm_m_quote (scm_cons2 (SCM_EOL, s, SCM_EOL) ,SCM_EOL); // apparently env arg is ignored.
  44 }
  45
  46 /*
  47   See: libguile/symbols.c
  48
  49   SCM
  50   scm_string_to_symbol(s)
  51
  52 */
  53 SCM
  54 ly_symbol (String name)
  55 {
  56   return gh_car (scm_intern ((char*)name.ch_C(), name.length_i()));
  57 }
  58
  59 String
  60 symbol_to_string (SCM s)
  61 {
  62   return String((Byte*)SCM_CHARS (s), (int) SCM_LENGTH(s));
  63 }
  64
  65 SCM
  66 ly_set_scm (String name, SCM val)
  67 {
  68   return scm_sysintern ((char*)name.ch_C(), val);
  69
  70 }
  71
  72 /**
  73    Read a file, and shove it down GUILE.  GUILE also has file read
  74    functions, but you can't fiddle with the path of those.
  75  */
  76 void
  77 read_lily_scm_file (String fn)
  78 {
  79   String s = global_path.find (fn);
  80   if (s == "")
  81     {
  82       String e = _f ("Can't find file: `%s'", fn);
  83       e += " ";
  84       e += _f ("(load path: `%s')", global_path.str ());
  85       error (e);
  86     }
  87   else
  88     *mlog << '[' << s;
  89
  90
  91   Simple_file_storage f(s);
  92
  93   ly_ch_C_eval_scm ((char *) f.ch_C());
  94   *mlog << "]" << flush;
  95 }
  96
  97
  98 SCM
  99 ly_gulp_file (SCM name)
 100 {
 101   String fn (ly_scm2string (name));
 102  String s = global_path.find (fn);
 103   if (s == "")
 104     {
 105       String e = _f ("Can't find file: `%s'", fn);
 106       e += " ";
 107       e += _f ("(load path: `%s')", global_path.str ());
 108       error (e);
 109     }
 110   else
 111     *mlog << '[' << s;
 112
 113
 114   Simple_file_storage f(s);
 115   return ly_ch_C_to_scm (f.ch_C());
 116 }
 117
 118 void
 119 ly_display_scm (SCM s)
 120 {
 121   gh_display (s);
 122   gh_newline ();
 123 }
 124
 125 String
 126 ly_scm2string (SCM s)
 127 {
 128   int len;
 129   char * p = gh_scm2newstr (s , &len);
 130
 131   String r (p);
 132   //  delete p;
 133   free (p);
 134   return r;
 135 }
 136
 137 SCM
 138 index_cell (SCM s, Direction d)
 139 {
 140   assert (d);
 141   return (d == LEFT) ? SCM_CAR (s) : SCM_CDR (s);
 142 }
 143
 144
 145 SCM
 146 array_to_list (SCM *a , int l)
 147 {
 148   SCM list = SCM_EOL;
 149   for (int i= l; i--;  )
 150     {
 151       list =  gh_cons (a[i], list);
 152     }
 153   return list;
 154 }
 155
 156 SCM
 157 ly_warning (SCM str)
 158 {
 159   assert (gh_string_p (str));
 160   warning ("lily-guile: " + ly_scm2string (str));
 161   return SCM_BOOL_T;
 162 }
 163
 164 void
 165 init_functions ()
 166 {
 167   scm_make_gsubr ("ly-warn", 1, 0, 0, (SCM(*)(...))ly_warning);
 168   scm_make_gsubr ("ly-gulp-file", 1,0, 0, (SCM(*)(...))ly_gulp_file);
 169 }
 170
 171 extern void init_symbols ();
 172
 173 void
 174 init_lily_guile ()
 175 {
 176   init_symbols();
 177   init_functions ();
 178 }