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   Why there is no gh_quote () in GUILE  beats me.
  40 */
  41
  42 SCM
  43 ly_quote_scm (SCM s)
  44 {
  45   return scm_cons2 (scm_i_quote, s, SCM_EOL);
  46 }
  47
  48 /*
  49   See: libguile/symbols.c
  50
  51   SCM
  52   scm_string_to_symbol(s)
  53
  54 */
  55 SCM
  56 ly_symbol (String name)
  57 {
  58   return gh_car (scm_intern ((char*)name.ch_C(), name.length_i()));
  59 }
  60
  61 String
  62 symbol_to_string (SCM s)
  63 {
  64   return String((Byte*)SCM_CHARS (s), (int) SCM_LENGTH(s));
  65 }
  66
  67 SCM
  68 ly_set_scm (String name, SCM val)
  69 {
  70   return scm_sysintern ((char*)name.ch_C(), val);
  71
  72 }
  73
  74 /**
  75    Read a file, and shove it down GUILE.  GUILE also has file read
  76    functions, but you can't fiddle with the path of those.
  77  */
  78 void
  79 read_lily_scm_file (String fn)
  80 {
  81   String s = global_path.find (fn);
  82   if (s == "")
  83     {
  84       String e = _f ("Can not find file `%s\'", fn);
  85       e += " ";
  86       e += _f ("(Load path is `%s\'", global_path.str ());
  87       error (e);
  88     }
  89   else
  90     *mlog << '[' << s;
  91
  92
  93   Simple_file_storage f(s);
  94
  95   ly_ch_C_eval_scm ((char *) f.ch_C());
  96   *mlog << ']' << flush;
  97 }
  98
  99
 100 SCM
 101 ly_gulp_file (SCM name)
 102 {
 103   String fn (ly_scm2string (name));
 104  String s = global_path.find (fn);
 105   if (s == "")
 106     {
 107       String e = _f ("Can not find file `%s\'", fn);
 108       e += " ";
 109       e += _f ("(Load path is `%s\'", global_path.str ());
 110       error (e);
 111     }
 112   else
 113     *mlog << '[' << s;
 114
 115
 116   Simple_file_storage f(s);
 117   return ly_ch_C_to_scm (f.ch_C());
 118 }
 119
 120 void
 121 ly_display_scm (SCM s)
 122 {
 123   gh_display (s);
 124   gh_newline ();
 125 }
 126
 127 String
 128 ly_scm2string (SCM s)
 129 {
 130   int len;
 131   char * p = gh_scm2newstr (s , &len);
 132
 133   String r (p);
 134   //  delete p;
 135   free (p);
 136   return r;
 137 }
 138
 139 SCM
 140 index_cell (SCM s, Direction d)
 141 {
 142   assert (d);
 143   return (d == LEFT) ? SCM_CAR (s) : SCM_CDR (s);
 144 }
 145
 146
 147 SCM
 148 array_to_list (SCM *a , int l)
 149 {
 150   SCM list = SCM_EOL;
 151   for (int i= l; i--;  )
 152     {
 153       list =  gh_cons (a[i], list);
 154     }
 155   return list;
 156 }
 157
 158 SCM
 159 ly_warning (SCM str)
 160 {
 161   assert (gh_string_p (str));
 162   warning ("lily-guile: " + ly_scm2string (str));
 163   return SCM_BOOL_T;
 164 }
 165
 166 void
 167 init_functions ()
 168 {
 169   scm_make_gsubr ("ly-warn", 1, 0, 0, (SCM(*)(...))ly_warning);
 170   scm_make_gsubr ("ly-gulp-file", 1,0, 0, (SCM(*)(...))ly_gulp_file);
 171 }
 172
 173 extern void init_symbols ();
 174
 175 void
 176 init_lily_guile ()
 177 {
 178   init_symbols();
 179   init_functions ();
 180 }