summaryrefslogtreecommitdiff
path: root/lily/lily-parser-scheme.cc
blob: 2521f4e0391d634ccd658b4f396366be678354d0 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
/*
  lily-parser-scheme.cc -- implement Lily_parser bindings

  source file of the GNU LilyPond music typesetter

  (c) 2005--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
*/

#include <unistd.h>

#include "file-name-map.hh"
#include "file-name.hh"
#include "file-path.hh"
#include "input-smob.hh"
#include "international.hh"
#include "lily-lexer.hh"
#include "lily-parser.hh"
#include "ly-module.hh"
#include "main.hh"
#include "program-option.hh"
#include "source.hh"
#include "warn.hh"

/* Do not append `!' suffix, since 1st argument is not modified. */
LY_DEFINE (ly_set_point_and_click, "ly:set-point-and-click",
	   1, 0, 0, (SCM what),
	   "Deprecated.")
{
  (void) what;
  warning (_f ("deprecated function called: %s", "ly:set-point-and-click"));
  return SCM_UNSPECIFIED;
}

LY_DEFINE (ly_parse_file, "ly:parse-file",
	   1, 0, 0, (SCM name),
	   "Parse a single @code{.ly} file.  "
	   "Upon failure, throw @code{ly-file-failed} key.")
{
  SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
  char const *file = scm_i_string_chars (name);
  char const *extensions[] = {"ly", "", 0};

  string file_name = global_path.find (file, extensions);

  /* By default, use base name of input file for output file name,
     write output to cwd; do not use root and directory parts of input
     file name.  */
  File_name out_file_name (file_name);

  global_path.append (out_file_name.dir_);

  out_file_name.ext_ = "";
  out_file_name.root_ = "";
  out_file_name.dir_ = "";

  /* When running from gui, generate output in .ly source directory.  */
  if (output_name_global.empty ()
      && ly_get_option (ly_symbol2scm ("gui")) == SCM_BOOL_T)
    {
      File_name f (file);
      f.base_ = "";
      f.ext_ = "";
      output_name_global = f.to_string ();
    }

  if (!output_name_global.empty ())
    {
      /* Interpret --output=DIR to mean --output=DIR/BASE.  */
      string dir;
      if (is_dir (output_name_global))
	{
	  dir = output_name_global;
	  output_name_global = "";
	}
      else
	dir = dir_name (output_name_global);
      if (dir != "" && dir != "." && dir != get_working_directory ())
	{
	  global_path.prepend (get_working_directory ());
	  message (_f ("Changing working directory to `%s'",
		       dir.c_str ()));
	  chdir (dir.c_str ());
	}
      else
	out_file_name = File_name (output_name_global);
    }

  string init;
  if (!init_name_global.empty ())
    init = init_name_global;
  else
    init = "init.ly";

  string out_file = out_file_name.to_string ();

  if (init.length () && global_path.find (init).empty ())
    {
      warning (_f ("can't find init file: `%s'", init));
      warning (_f ("(search path: `%s')",
		   global_path.to_string ().c_str ()));
      exit (2);
    }

  if ((file_name != "-") && global_path.find (file_name).empty ())
    {
      warning (_f ("can't find file: `%s'", file_name));
      scm_throw (ly_symbol2scm ("ly-file-failed"),
		 scm_list_1 (scm_makfrom0str (file_name.c_str ())));
    }
  else
    {
      Sources sources;
      sources.set_path (&global_path);

      string mapped_fn = map_file_name (file_name);
      message (_f ("Processing `%s'", mapped_fn.c_str ()));
      progress_indication ("\n");

      Lily_parser *parser = new Lily_parser (&sources);

      parser->parse_file (init, file_name, out_file);

      bool error = parser->error_level_;
      parser->unprotect ();
      parser = 0;
      if (error)
	/* TODO: pass renamed input file too.  */
	scm_throw (ly_symbol2scm ("ly-file-failed"),
		   scm_list_1 (scm_makfrom0str (file_name.c_str ())));
    }
  return SCM_UNSPECIFIED;
}

LY_DEFINE (ly_parse_string, "ly:parse-string",
	   1, 0, 0, (SCM ly_code),
	   "Parse the string LY_CODE.  "
	   "Upon failure, throw @code{ly-file-failed} key.")
{
  SCM_ASSERT_TYPE (scm_is_string (ly_code), ly_code, SCM_ARG1, __FUNCTION__, "string");

  Sources sources;
  sources.set_path (&global_path);
  Lily_parser *parser = new Lily_parser (&sources);
  parser->parse_string (ly_scm2string (ly_code));
  parser->unprotect ();
  parser = 0;

  return SCM_UNSPECIFIED;
}

LY_DEFINE (ly_clone_parser, "ly:clone-parser",
	   1, 0, 0, (SCM parser_smob),
	   "Return a clone of PARSER_SMOB.")
{
  Lily_parser *parser = unsmob_lily_parser (parser_smob);
  Lily_parser *clone = new Lily_parser (*parser);

  return clone->unprotect ();
}

LY_DEFINE (ly_parser_define, "ly:parser-define!",
	   3, 0, 0, (SCM parser_smob, SCM symbol, SCM val),
	   "Bind SYMBOL to VAL in PARSER_SMOB's module.")
{
  Lily_parser *parser = unsmob_lily_parser (parser_smob);
  SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, SCM_ARG2, __FUNCTION__, "symbol");
  SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG2, __FUNCTION__, "parser");

  parser->lexer_->set_identifier (scm_symbol_to_string (symbol), val);
  return SCM_UNSPECIFIED;
}

LY_DEFINE (ly_parser_lookup, "ly:parser-lookup",
	   2, 0, 0, (SCM parser_smob, SCM symbol),
	   "Lookup @var{symbol} in @var{parser_smob}'s module.  "
	   "Undefined is '().")
{
  Lily_parser *parser = unsmob_lily_parser (parser_smob);

  SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, SCM_ARG2, __FUNCTION__, "symbol");
  SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG2, __FUNCTION__, "parser");

  SCM val = parser->lexer_->lookup_identifier (ly_scm2string (scm_symbol_to_string (symbol)));
  if (val != SCM_UNDEFINED)
    return val;
  else
    return SCM_EOL;
}

LY_DEFINE (ly_parser_parse_string, "ly:parser-parse-string",
	   2, 0, 0, (SCM parser_smob, SCM ly_code),
	   "Parse the string LY_CODE with PARSER_SMOB."
	   "Upon failure, throw @code{ly-file-failed} key.")
{
  Lily_parser *parser = unsmob_lily_parser (parser_smob);

  SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser");
  SCM_ASSERT_TYPE (scm_is_string (ly_code), ly_code, SCM_ARG2, __FUNCTION__, "string");

  parser->parse_string (ly_scm2string (ly_code));

  return SCM_UNSPECIFIED;
}

LY_DEFINE (ly_parser_set_note_names, "ly:parser-set-note-names",
	   2, 0, 0, (SCM parser, SCM names),
	   "Replace current note names in @var{parser}. "
	   "@var{names} is an alist of symbols.  "
	   "This only has effect if the current mode is notes.")
{
  Lily_parser *p = unsmob_lily_parser (parser);
  SCM_ASSERT_TYPE (p, parser, SCM_ARG1, __FUNCTION__, "Lilypond parser");

  if (p->lexer_->is_note_state ())
    {
      p->lexer_->pop_state ();
      p->lexer_->push_note_state (alist_to_hashq (names));
    }

  return SCM_UNSPECIFIED;
}

LY_DEFINE (ly_parser_output_name, "ly:parser-output-name",
	   1, 0, 0, (SCM parser),
	   "Return the base name of the output file.")
{
  Lily_parser *p = unsmob_lily_parser (parser);
  SCM_ASSERT_TYPE (p, parser, SCM_ARG1, __FUNCTION__, "Lilypond parser");

  return scm_makfrom0str (p->output_basename_.c_str ());
}

LY_DEFINE (ly_parser_error, "ly:parser-error",
	   2, 1, 0, (SCM parser, SCM msg, SCM input),
	   "Display an error message, and make the parser fail")
{
  Lily_parser *p = unsmob_lily_parser (parser);
  SCM_ASSERT_TYPE (p, parser, SCM_ARG1, __FUNCTION__, "Lilypond parser");
  SCM_ASSERT_TYPE (scm_is_string (msg), msg, SCM_ARG2, __FUNCTION__, "string");
  string s = ly_scm2string (msg);
  
  Input *i = unsmob_input (input);
  if (i)
    p->parser_error (*i, s);
  else
    p->parser_error (s);

  return parser;
}