{book,score}-print functions.
* scm/ly-from-scheme.scm (ly:parse-string-result): use new setup:
pass results via parseStringResult, lookup via ly:parser-lookup.
* lily/lily-parser.cc (Lily_parser): only clone lexer in
constructors.
(parse_file): encapsulate do_yyparse() in scm_set_current_module()
(parse_string): idem.
* ly/spanners-init.ly (assertBeamQuant): don't use #{ #} in init.
2005-06-10 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ * lily/default-actions.cc (Module): new file. default
+ {book,score}-print functions.
+
+ * scm/ly-from-scheme.scm (ly:parse-string-result): use new setup:
+ pass results via parseStringResult, lookup via ly:parser-lookup.
+
+ * lily/lily-parser.cc (Lily_parser): only clone lexer in
+ constructors.
+ (parse_file): encapsulate do_yyparse() in scm_set_current_module()
+ (parse_string): idem.
+
+ * ly/spanners-init.ly (assertBeamQuant): don't use #{ #} in init.
+
* lily/main.cc (main_with_guile): copy be_verbose_global into
ly_set_option()
\filler
}
-{ \primes \seconds \primeSixteenths }
+\new Voice { \primes \seconds \primeSixteenths }
--- /dev/null
+/*
+ default-actions.cc -- implement default toplevel actions for .ly
+ file.
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+*/
+
+#include "lily-parser.hh"
+#include "lily-lexer.hh"
+#include "lilypond-key.hh"
+#include "book.hh"
+#include "paper-book.hh"
+#include "score.hh"
+#include "file-name.hh"
+#include "output-def.hh"
+
+
+
+
+/* TODO: move this to Scheme? Why take the parser arg, and all the back
+ & forth between scm and c++? */
+LY_DEFINE (ly_parser_print_score, "ly:parser-print-score",
+ 2, 0, 0,
+ (SCM parser_smob, SCM score_smob),
+ "Print score, i.e., the classic way.")
+{
+ Lily_parser *parser = unsmob_lily_parser (parser_smob);
+ Score *score = unsmob_score (score_smob);
+
+ Object_key *key = new Lilypond_general_key (0, score->user_key_, 0);
+
+ if (score->error_found_)
+ return SCM_UNSPECIFIED;
+
+ SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser");
+ SCM_ASSERT_TYPE (score, score_smob, SCM_ARG2, __FUNCTION__, "score");
+
+ SCM header = ly_c_module_p (score->header_)
+ ? score->header_
+ : parser->lexer_->lookup_identifier ("$globalheader");
+
+ File_name outname (parser->output_basename_);
+ int *c = &parser->book_count_;
+ if (*c)
+ outname.base_ += "-" + to_string (*c);
+ (*c)++;
+
+ SCM os = scm_makfrom0str (outname.to_string ().to_str0 ());
+ SCM paper = get_paper (parser)->self_scm ();
+ for (int i = 0; i < score->defs_.size (); i++)
+ default_rendering (score->get_music (), score->defs_[i]->self_scm (),
+ paper, header, os, key->self_scm ());
+
+ if (score->defs_.is_empty ())
+ {
+ Output_def *layout = get_layout (parser);
+ default_rendering (score->get_music (),
+ layout->self_scm (),
+ paper,
+ header, os, key->self_scm ());
+
+ scm_gc_unprotect_object (layout->self_scm ());
+ }
+
+ scm_gc_unprotect_object (paper);
+ scm_gc_unprotect_object (key->self_scm ());
+ return SCM_UNSPECIFIED;
+}
+
+
+LY_DEFINE (ly_parser_print_book, "ly:parser-print-book",
+ 2, 0, 0, (SCM parser_smob, SCM book_smob),
+ "Print book.")
+{
+ Lily_parser *parser = unsmob_lily_parser (parser_smob);
+ Book *book = unsmob_book (book_smob);
+ Output_def *bp = unsmob_output_def (parser->lexer_->lookup_identifier ("$defaultpaper"));
+
+ SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "Lilypond parser");
+ SCM_ASSERT_TYPE (book, book_smob, SCM_ARG2, __FUNCTION__, "Book");
+
+ /* ugh. changing argument.*/
+ book->paper_ = bp;
+
+ File_name outname (parser->output_basename_);
+ int *c = &parser->book_count_;
+ if (*c)
+ outname.base_ += "-" + to_string (*c);
+ (*c)++;
+
+ Output_def *layout = get_layout (parser);
+ Paper_book *pb = book->process (outname.to_string (), layout);
+
+ if (pb)
+ {
+ pb->output (outname.to_string ());
+ scm_gc_unprotect_object (pb->self_scm ());
+ }
+
+ scm_gc_unprotect_object (layout->self_scm ());
+ return SCM_UNSPECIFIED;
+}
+
Input here_input () const;
void add_scope (SCM);
- void set_current_scope ();
+ SCM set_current_scope ();
SCM remove_scope ();
void start_main_input ();
(c) 1997--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
*/
-#ifndef MY_LILY_PARSER_HH
-#define MY_LILY_PARSER_HH
+#ifndef LILY_PARSER_HH
+#define LILY_PARSER_HH
#include "duration.hh"
#include "input.hh"
void set_yydebug (bool);
};
-DECLARE_UNSMOB (Lily_parser, my_lily_parser);
+DECLARE_UNSMOB (Lily_parser, lily_parser);
SCM ly_parse_file (SCM);
SCM ly_parse_string (SCM);
Output_def *get_midi (Lily_parser *parser);
Output_def *get_paper (Lily_parser *parser);
-#endif /* MY_LILY_PARSER_HH */
+#endif /* LILY_PARSER_HH */
if (!scm_is_pair (scopes_))
start_module_ = scm_current_module ();
- scm_set_current_module (module);
for (SCM s = scopes_; scm_is_pair (s); s = scm_cdr (s))
{
ly_use_module (module, scm_car (s));
}
scopes_ = scm_cons (module, scopes_);
+
+ set_current_scope ();
}
return sc;
}
-void
+SCM
Lily_lexer::set_current_scope ()
{
+ SCM old = scm_current_module ();
+
if (scm_is_pair (scopes_))
scm_set_current_module (scm_car (scopes_));
else
scm_set_current_module (start_module_);
+
+ return old;
}
int
scm_gc_mark (lexer->chordmodifier_tab_);
scm_gc_mark (lexer->pitchname_tab_stack_);
+ scm_gc_mark (lexer->start_module_);
return lexer->scopes_;
}
int
-Lily_lexer::print_smob (SCM, SCM port, scm_print_state*)
+Lily_lexer::print_smob (SCM s, SCM port, scm_print_state*)
{
+ Lily_lexer *lexer = Lily_lexer::unsmob (s);
+
scm_puts ("#<Lily_lexer ", port);
+ scm_display (lexer->scopes_, port);
scm_puts (" >", port);
return 1;
}
#include "warn.hh"
#include "source.hh"
#include "lily-lexer.hh"
-#include "score.hh"
-#include "lilypond-key.hh"
#include "ly-module.hh"
-#include "output-def.hh"
-#include "book.hh"
-#include "paper-book.hh"
#include "file-name-map.hh"
/* Do not append `!' suffix, since 1st argument is not modified. */
1, 0, 0, (SCM parser_smob),
"Return a clone of PARSER_SMOB.")
{
- Lily_parser *parser = unsmob_my_lily_parser (parser_smob);
+ Lily_parser *parser = unsmob_lily_parser (parser_smob);
Lily_parser *clone = new Lily_parser (*parser);
- /* FIXME: should copy scopes too. */
return scm_gc_unprotect_object (clone->self_scm ());
}
3, 0, 0, (SCM parser_smob, SCM symbol, SCM val),
"Bind SYMBOL to VAL in PARSER_SMOB's module.")
{
- Lily_parser *parser = unsmob_my_lily_parser (parser_smob);
+ 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");
"Lookup @var{symbol} in @var{parser_smob}'s module. "
"Undefined is '().")
{
- Lily_parser *parser = unsmob_my_lily_parser (parser_smob);
+ 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");
"Parse the string LY_CODE with PARSER_SMOB."
"Upon failure, throw @code{ly-file-failed} key.")
{
- Lily_parser *parser = unsmob_my_lily_parser (parser_smob);
+ 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");
return SCM_UNSPECIFIED;
}
-/* TODO: move this to Scheme? Why take the parser arg, and all the back
- & forth between scm and c++? */
-LY_DEFINE (ly_parser_print_score, "ly:parser-print-score",
- 2, 0, 0,
- (SCM parser_smob, SCM score_smob),
- "Print score, i.e., the classic way.")
-{
- Lily_parser *parser = unsmob_my_lily_parser (parser_smob);
- Score *score = unsmob_score (score_smob);
-
- Object_key *key = new Lilypond_general_key (0, score->user_key_, 0);
-
- if (score->error_found_)
- return SCM_UNSPECIFIED;
-
- SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser");
- SCM_ASSERT_TYPE (score, score_smob, SCM_ARG2, __FUNCTION__, "score");
-
- SCM header = ly_c_module_p (score->header_)
- ? score->header_
- : parser->lexer_->lookup_identifier ("$globalheader");
-
- File_name outname (parser->output_basename_);
- int *c = &parser->book_count_;
- if (*c)
- outname.base_ += "-" + to_string (*c);
- (*c)++;
-
- SCM os = scm_makfrom0str (outname.to_string ().to_str0 ());
- SCM paper = get_paper (parser)->self_scm ();
- for (int i = 0; i < score->defs_.size (); i++)
- default_rendering (score->get_music (), score->defs_[i]->self_scm (),
- paper, header, os, key->self_scm ());
-
- if (score->defs_.is_empty ())
- {
- Output_def *layout = get_layout (parser);
- default_rendering (score->get_music (),
- layout->self_scm (),
- paper,
- header, os, key->self_scm ());
-
- scm_gc_unprotect_object (layout->self_scm ());
- }
-
- scm_gc_unprotect_object (paper);
- scm_gc_unprotect_object (key->self_scm ());
- 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_my_lily_parser (parser);
+ Lily_parser *p = unsmob_lily_parser (parser);
SCM_ASSERT_TYPE (p, parser, SCM_ARG1, __FUNCTION__, "Lilypond parser");
if (p->lexer_->is_note_state ())
return SCM_UNSPECIFIED;
}
-
-LY_DEFINE (ly_parser_print_book, "ly:parser-print-book",
- 2, 0, 0, (SCM parser_smob, SCM book_smob),
- "Print book.")
-{
- Lily_parser *parser = unsmob_my_lily_parser (parser_smob);
- Book *book = unsmob_book (book_smob);
- Output_def *bp = unsmob_output_def (parser->lexer_->lookup_identifier ("$defaultpaper"));
-
- SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "Lilypond parser");
- SCM_ASSERT_TYPE (book, book_smob, SCM_ARG2, __FUNCTION__, "Book");
-
- /* ugh. changing argument.*/
- book->paper_ = bp;
-
- File_name outname (parser->output_basename_);
- int *c = &parser->book_count_;
- if (*c)
- outname.base_ += "-" + to_string (*c);
- (*c)++;
-
- Output_def *layout = get_layout (parser);
- Paper_book *pb = book->process (outname.to_string (), layout);
-
- if (pb)
- {
- pb->output (outname.to_string ());
- scm_gc_unprotect_object (pb->self_scm ());
- }
-
- scm_gc_unprotect_object (layout->self_scm ());
- return SCM_UNSPECIFIED;
-}
-
error_level_ = 0;
smobify_self ();
+
+ lexer_ = new Lily_lexer (sources_);
+ scm_gc_unprotect_object (lexer_->self_scm ());
}
Lily_parser::Lily_parser (Lily_parser const &src)
int
Lily_parser::print_smob (SCM s, SCM port, scm_print_state*)
{
- scm_puts ("#<my_lily_parser ", port);
+ scm_puts ("#<Lily_parser ", port);
Lily_parser *parser = (Lily_parser *) SCM_CELL_WORD_1 (s);
- (void) parser;
+ scm_display (parser->lexer_->self_scm (), port);
scm_puts (" >", port);
return 1;
}
try_load_text_metrics (out_name);
}
- SCM oldmod = scm_current_module ();
-
- lexer_ = new Lily_lexer (sources_);
- scm_gc_unprotect_object (lexer_->self_scm ());
// TODO: use $parser
lexer_->set_identifier (ly_symbol2scm ("parser"),
self_scm ());
/* Read .ly IN_FILE, lex, parse, write \score blocks from IN_FILE to
OUT_FILE (unless IN_FILE redefines output file name). */
- do_yyparse ();
+ SCM mod = lexer_->set_current_scope ();
+ do_yyparse ();
+ scm_set_current_module (mod);
+
if (!define_spots_.is_empty ())
{
define_spots_.top ().warning (_ ("braces don't match"));
error_level_ = error_level_ | lexer_->error_level_;
lexer_ = 0;
-
- scm_set_current_module (oldmod);
}
void
Lily_parser::parse_string (String ly_code)
{
- Lily_lexer *parent = lexer_;
- lexer_ = (parent == 0 ? new Lily_lexer (sources_)
- : new Lily_lexer (*parent));
- scm_gc_unprotect_object (lexer_->self_scm ());
-
- SCM oldmod = scm_current_module ();
- // TODO: use $parser
+ // TODO: use $parser
lexer_->set_identifier (ly_symbol2scm ("parser"),
self_scm ());
set_yydebug (0);
lexer_->new_input (lexer_->main_input_name_, ly_code, sources_);
- do_yyparse ();
+ SCM mod = lexer_->set_current_scope ();
+ do_yyparse ();
+ scm_set_current_module (mod);
+
if (!define_spots_.is_empty ())
{
if (define_spots_.is_empty ()
}
error_level_ = error_level_ | lexer_->error_level_;
-
- scm_set_current_module (oldmod);
- lexer_ = 0;
}
char const *
% for regression testing purposes.
assertBeamQuant =
#(def-music-function (parser location l r) (pair? pair?)
- (let* ((f (check-quant-callbacks l r)))
-
- #{
- \once \override Beam #'position-callbacks = $f
- #}
-
-))
-
+ (make-grob-property-override 'Beam 'position-callbacks
+ (check-quant-callbacks l r)))
+
% for regression testing purposes.
assertBeamSlope =
#(def-music-function (parser location comp) (procedure?)
- (let* ((f (check-slope-callbacks comp)))
-
- #{
- \once \override Beam #'position-callbacks = $f
- #}
-
-))
+ (make-grob-property-override 'Beam 'position-callbacks
+ (check-slope-callbacks comp)))
+
(char->integer #\0)))))
(string->list (number->string var-idx)))))))))
-(define-public (ly:parse-string-result str parser module)
+(define-public (ly:parse-string-result str parser)
"Parse `str', which is supposed to contain a music expression."
(let ((music-sym (gen-lily-sym)))
(ly:parser-parse-string
parser
- (format #f "
-~a = { ~a }
-#(ly:export '~a)
-#(module-define! (resolve-module '~a) '~a ~a)
-"
- music-sym str music-sym (module-name module) music-sym music-sym))
- (eval `,music-sym module)))
+ (format #f "parseStringResult = { ~a }" str))
+
+ (ly:parser-lookup parser 'parseStringResult)))
(define-public (read-lily-expression chr port)
"Read a #{ lily music expression #} from port and return
scheme forms, typically symbols. $$ may be used to simply write a `$'
character."
(let ((bindings '()))
+
(define (create-binding! val)
"Create a new symbol, bind it to `val' and return it."
(let ((tmp-symbol (gen-lily-sym)))
+
(set! bindings (cons (cons tmp-symbol val) bindings))
tmp-symbol))
+
(define (remove-dollars! form)
"Generate a form where `$variable' and `$ value' mottos are replaced
by new symbols, which are binded to the adequate values."
(cons (create-binding! (cadr form)) (remove-dollars! (cddr form))))
(else ;; (something ...)
(cons (remove-dollars! (car form)) (remove-dollars! (cdr form))))))
- (let ((lily-string (call-with-output-string
+ (let*
+ ((lily-string (call-with-output-string
(lambda (out)
(do ((c (read-char port) (read-char port)))
((and (char=? c #\#)
(remove-dollars! expr)))))
;; other caracters
(else
- (display c out))))))))
- `(let ((parser-clone (ly:clone-parser parser)))
- ,@(map (lambda (binding)
- `(ly:parser-define parser-clone ',(car binding) ,(cdr binding)))
- (reverse bindings))
- (ly:parse-string-result ,lily-string parser-clone (current-module))))))
+ (display c out)))))))
+
+ (result
+ `(let ((parser-clone (ly:clone-parser parser)))
+ ,@(map (lambda (binding)
+ `(ly:parser-define parser-clone ',(car binding) ,(cdr binding)))
+ (reverse bindings))
+ (ly:parse-string-result ,lily-string parser-clone))
+ ))
+
+
+
+ result
+ )))
(read-hash-extend #\{ read-lily-expression)
projects / lilypond.git / commitdiff