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 /*
  38   Pass string to scm parser, evaluate one expression.
  39   Return result value and #chars read.
  40
  41   Thanks to Gary Houston <ghouston@freewire.co.uk>
  42
  43   Need guile-1.3.4 (>1.3 anyway) for ftell on str ports -- jcn
  44 */
  45 SCM
  46 ly_parse_scm (char const* s, int* n)
  47 {
  48   SCM str = gh_str02scm ((char*)s);
  49   SCM port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_RDNG,
  50                             "scm_eval_0str");
  51   SCM from = scm_ftell (port);
  52
  53   SCM form;
  54   SCM answer = SCM_UNSPECIFIED;
  55
  56   /* Read expression from port */
  57   if (!SCM_EOF_OBJECT_P (form = scm_read (port)))
  58     answer = scm_eval_x (form);
  59
  60   SCM to = scm_ftell (port);
  61   *n = gh_scm2int (to) - gh_scm2int (from);
  62
  63   /* Don't close the port here; if we re-enter this function via a
  64      continuation, then the next time we enter it, we'll get an error.
  65      It's a string port anyway, so there's no advantage to closing it
  66      early.  */
  67
  68   return answer;
  69 }
  70
  71 /*
  72   scm_m_quote doesn't use any env, but needs one for a good signature in GUILE.
  73 */
  74
  75 SCM
  76 ly_quote_scm (SCM s)
  77 {
  78   return scm_m_quote (scm_cons2 (SCM_EOL, s, SCM_EOL) ,SCM_EOL); // apparently env arg is ignored.
  79 }
  80
  81 /*
  82   See: libguile/symbols.c
  83
  84   SCM
  85   scm_string_to_symbol(s)
  86
  87 */
  88 SCM
  89 ly_symbol (String name)
  90 {
  91   return gh_car (scm_intern ((char*)name.ch_C(), name.length_i()));
  92 }
  93
  94 String
  95 symbol_to_string (SCM s)
  96 {
  97   return String((Byte*)SCM_CHARS (s), (int) SCM_LENGTH(s));
  98 }
  99
 100 SCM
 101 ly_set_scm (String name, SCM val)
 102 {
 103   return scm_sysintern ((char*)name.ch_C(), val);
 104
 105 }
 106
 107 /**
 108    Read a file, and shove it down GUILE.  GUILE also has file read
 109    functions, but you can't fiddle with the path of those.
 110  */
 111 void
 112 read_lily_scm_file (String fn)
 113 {
 114   String s = global_path.find (fn);
 115   if (s == "")
 116     {
 117       String e = _f ("Can't find file: `%s'", fn);
 118       e += " ";
 119       e += _f ("(load path: `%s')", global_path.str ());
 120       error (e);
 121     }
 122   else
 123     *mlog << '[' << s;
 124
 125
 126   Simple_file_storage f(s);
 127
 128   ly_ch_C_eval_scm ((char *) f.ch_C());
 129   *mlog << "]" << flush;
 130 }
 131
 132
 133 SCM
 134 ly_gulp_file (SCM name)
 135 {
 136   String fn (ly_scm2string (name));
 137  String s = global_path.find (fn);
 138   if (s == "")
 139     {
 140       String e = _f ("Can't find file: `%s'", fn);
 141       e += " ";
 142       e += _f ("(load path: `%s')", global_path.str ());
 143       error (e);
 144     }
 145   else
 146     *mlog << '[' << s;
 147
 148
 149   Simple_file_storage f(s);
 150   return ly_ch_C_to_scm (f.ch_C());
 151 }
 152
 153 void
 154 ly_display_scm (SCM s)
 155 {
 156   gh_display (s);
 157   gh_newline ();
 158 }
 159
 160 String
 161 ly_scm2string (SCM s)
 162 {
 163   int len;
 164   char * p = gh_scm2newstr (s , &len);
 165
 166   String r (p);
 167   //  delete p;
 168   free (p);
 169   return r;
 170 }
 171
 172 SCM
 173 index_cell (SCM s, Direction d)
 174 {
 175   assert (d);
 176   return (d == LEFT) ? SCM_CAR (s) : SCM_CDR (s);
 177 }
 178
 179
 180 SCM
 181 array_to_list (SCM *a , int l)
 182 {
 183   SCM list = SCM_EOL;
 184   for (int i= l; i--;  )
 185     {
 186       list =  gh_cons (a[i], list);
 187     }
 188   return list;
 189 }
 190
 191 SCM
 192 ly_warning (SCM str)
 193 {
 194   assert (gh_string_p (str));
 195   warning ("lily-guile: " + ly_scm2string (str));
 196   return SCM_BOOL_T;
 197 }
 198
 199 void
 200 init_functions ()
 201 {
 202   scm_make_gsubr ("ly-warn", 1, 0, 0, (SCM(*)(...))ly_warning);
 203   scm_make_gsubr ("ly-gulp-file", 1,0, 0, (SCM(*)(...))ly_gulp_file);
 204 }
 205
 206 extern void init_symbols ();
 207 extern void init_smobs ();      // guh -> .hh
 208
 209
 210 void
 211 init_lily_guile ()
 212 {
 213   init_symbols();
 214   init_functions ();
 215   init_smobs ();
 216 }