From 1ec0feb6ede8c5a35b4846cb6b8c22697a768f99 Mon Sep 17 00:00:00 2001
From: hanwen <hanwen>
Date: Thu, 18 Mar 2004 11:14:36 +0000
Subject: [PATCH] * scm/lily.scm (tex-output-expression): new function, eval
within drawing API. Guards against eval vulnerabilities.
* scm/output-tex.scm (tex-encoded-fontswitch): idem.
* scm/output-ps.scm (scm): export lily drawing API.
* lily/include/lily-guile.hh (ly_scheme_function): new macro. Use
throughout.
---
ChangeLog | 14 ++++-
Documentation/user/changing-defaults.itely | 50 +++++++++++++---
lily/break-substitution.cc | 6 +-
lily/font-select.cc | 6 +-
lily/include/lily-guile.hh | 11 ++++
lily/include/ly-module.hh | 1 +
lily/input-file-results.cc | 7 +--
lily/lexer.ll | 4 +-
lily/lily-guile.cc | 4 +-
lily/main.cc | 5 +-
lily/paper-outputter.cc | 6 +-
lily/parser.yy | 47 ++++-----------
lily/text-item.cc | 4 +-
scm/lily.scm | 26 +++++----
scm/output-ps.scm | 43 +++++++++++++-
scm/output-tex.scm | 67 +++++++++++++++-------
16 files changed, 193 insertions(+), 108 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 3b3207ecb7..2dc04719fc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2004-03-18 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * scm/lily.scm (tex-output-expression): new function, eval within
+ drawing API. Guards against eval vulnerabilities.
+
+ * scm/output-tex.scm (tex-encoded-fontswitch): idem.
+
+ * scm/output-ps.scm (scm): export lily drawing API.
+
+ * lily/include/lily-guile.hh (ly_scheme_function): new macro. Use
+ throughout.
+
2004-03-18 Jan Nieuwenhuizen <janneke@gnu.org>
* ly/declarations-init.ly (paper): Define page-breaking.
@@ -41,7 +53,7 @@
accidentals for harmonic notes.
* lily/note-collision.cc (check_meshing_chords): don't merge heads
- fo different style. (Thanks to Doug Linhardt).
+ of different style. (Thanks to Doug Linhardt).
* Documentation/user/changing-defaults.itely (Scheme tutorial):
new node.
diff --git a/Documentation/user/changing-defaults.itely b/Documentation/user/changing-defaults.itely
index d892ff97f5..235519ce30 100644
--- a/Documentation/user/changing-defaults.itely
+++ b/Documentation/user/changing-defaults.itely
@@ -262,8 +262,9 @@ are contained in a context.
@node Changing context properties on the fly
@subsection Changing context properties on the fly
-Such variables can be changed during the interpretation step.
-This is achieved by inserting the @code{\set} command in the music,
+Context variables, properties, can be changed during the
+interpretation step. This is achieved by inserting the @code{\set}
+command in the music,
@quotation
@code{\set }[@var{context}]@code{.}@var{prop}@code{ = #}@var{value}
@@ -294,7 +295,9 @@ In this example,
the @var{context} argument to @code{\set} is left out, and the current
@internalsref{Voice} is used. Contexts are hierarchical, so if a
bigger context was specified, for example @code{Staff}, then the
-change would apply to all Voices in the current stave.
+change would apply to all Voices in the current stave. The change is
+applied `on-the-fly', during the music, so that the setting only
+affects the second group of eighth notes.
There is also an @code{\unset} command,
@quotation
@@ -307,17 +310,50 @@ definitions set in
@var{context}. in
@example
- \set staff.autobeaming = ##f
- \unset voice.autobeaming
+ \set staff.autoBeaming = ##f
+ \unset voice.autoBeaming
@end example
@noindent
the current voice does not have the property, and the definition at
staff level remains intact.
-@node context property defaults
-@subsection context property defaults
+Settings that should only apply to a single time-step can be entered
+easily with @code{\once}, for example in
+@lilypond[verbatim,relative=2]
+ c4
+ \once \set fontSize = #4.7
+ c4
+ c4
+@end lilypond
+
+@code{fontSize} is unset after the third note.
+
+@node Modifying context plug-ins
+@subsection Modifying context plug-ins
+
+
+
+@node Defining context defaults
+@subsection Defining context defaults
+
+Context properties can be set as defaults, within the
+@code{\paper} block. For example,
+
+@verbatim
+\paper {
+ \context {
+ \ScoreContext
+ skipBars = ##t
+ }
+}
+@end verbatim
+
+@noindent
+will set skipBars default
+
+When This score-wide
@node which properties to change
diff --git a/lily/break-substitution.cc b/lily/break-substitution.cc
index bd524417f5..0645a1c6c0 100644
--- a/lily/break-substitution.cc
+++ b/lily/break-substitution.cc
@@ -447,8 +447,6 @@ Spanner::fast_fubstitute_grob_list (SCM sym,
}
-SCM grob_list_p;
-
/*
Although the substitution can be written as
@@ -465,8 +463,7 @@ SCM grob_list_p;
SCM
substitute_mutable_property_alist (SCM alist)
{
- if (!grob_list_p)
- grob_list_p = scm_c_eval_string ("grob-list?");
+ SCM grob_list_p = ly_scheme_function ("grob-list?");
SCM l = SCM_EOL;
SCM *tail = &l;
@@ -497,6 +494,7 @@ Spanner::substitute_one_mutable_property (SCM sym,
Spanner*s = this;
bool fast_done = false;
+ SCM grob_list_p = ly_scheme_function ("grob-list?");
if (type == grob_list_p)
fast_done = s->fast_fubstitute_grob_list (sym, val);
diff --git a/lily/font-select.cc b/lily/font-select.cc
index d4773c853c..ae78641b11 100644
--- a/lily/font-select.cc
+++ b/lily/font-select.cc
@@ -91,11 +91,7 @@ get_font_by_mag_step (Paper_def* paper, Real requested_step,
SCM
properties_to_font_size_family (SCM fonts, SCM alist_chain)
{
- static SCM proc;
- if (!proc )
- proc = scm_c_eval_string ("lookup-font");
-
- return scm_call_2 (proc, fonts, alist_chain);
+ return scm_call_2 (ly_scheme_function ("lookup-font"), fonts, alist_chain);
}
diff --git a/lily/include/lily-guile.hh b/lily/include/lily-guile.hh
index 768bb6735e..89fb6745e5 100644
--- a/lily/include/lily-guile.hh
+++ b/lily/include/lily-guile.hh
@@ -147,6 +147,17 @@ SCM ly_truncate_list (int k, SCM l );
inline SCM ly_symbol2scm(char const* x) { return gh_symbol2scm((x)); }
#endif
+extern SCM global_lily_module;
+
+#define ly_scheme_function(x) ({static SCM cached; \
+ SCM value = cached; /* We store this one locally, since G++ -O2 fucks up else */ \
+ if ( __builtin_constant_p ((x)))\
+ { if (!cached)\
+ value = cached = scm_gc_protect_object (scm_eval(gh_symbol2scm (x), global_lily_module));\
+ } else\
+ value = scm_eval(gh_symbol2scm (x), global_lily_module);\
+ value; })
+
String ly_scm2string (SCM s);
diff --git a/lily/include/ly-module.hh b/lily/include/ly-module.hh
index 463cea79ae..a270341f55 100644
--- a/lily/include/ly-module.hh
+++ b/lily/include/ly-module.hh
@@ -22,5 +22,6 @@ void ly_reexport_module (SCM mod);
inline bool ly_module_p (SCM x) { return SCM_MODULEP(x); }
void ly_clear_anonymous_modules ();
+
#endif /* LY_MODULE_HH */
diff --git a/lily/input-file-results.cc b/lily/input-file-results.cc
index 92fa4f329c..8c6cbab397 100644
--- a/lily/input-file-results.cc
+++ b/lily/input-file-results.cc
@@ -58,8 +58,7 @@ LY_DEFINE (ly_set_point_and_click, "ly:set-point-and-click", 1, 0, 0,
else if (what == ly_symbol2scm ("line"))
val = gh_eval_str ("line-location");
- extern SCM lily_module;
- scm_module_define (lily_module, ly_symbol2scm ("point-and-click"), val);
+ scm_module_define (global_lily_module, ly_symbol2scm ("point-and-click"), val);
store_locations_global_b =gh_procedure_p (val);
return SCM_UNSPECIFIED;
@@ -226,10 +225,6 @@ do_one_file (char const *file)
return;
}
- static SCM proc;
- if (!proc)
- proc = scm_c_eval_string ("dump-gc-protects");
-
paper_book = new Paper_book ();;
Input_file_results inp_file (init, in_file, out_file);
if (output_format_global == PAGE_LAYOUT)
diff --git a/lily/lexer.ll b/lily/lexer.ll
index 2a5a667c44..f75e6998bc 100644
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -823,9 +823,7 @@ avoid_silly_flex_induced_gcc_warnings ()
SCM
lookup_markup_command (String s)
{
- static SCM proc ;
- if (!proc)
- proc = scm_c_eval_string ("lookup-markup-command");
+ SCM proc = ly_scheme_function ("lookup-markup-command");
return scm_call_1 (proc, scm_makfrom0str (s.to_str0 ()));
}
diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index 4cb62c01ff..954ef38c58 100644
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -201,12 +201,12 @@ ly_init_ly_module (void *)
}
-SCM lily_module;
+SCM global_lily_module;
void
ly_init_guile ()
{
- lily_module = scm_c_define_module ("lily", ly_init_ly_module, 0);
+ global_lily_module = scm_c_define_module ("lily", ly_init_ly_module, 0);
scm_c_use_module ("lily");
}
diff --git a/lily/main.cc b/lily/main.cc
index 08b483c4de..ba7bddf161 100644
--- a/lily/main.cc
+++ b/lily/main.cc
@@ -289,11 +289,8 @@ main_with_guile (void *, int, char **)
#if 0
/* Code to debug memory leaks. Cannot call from within .ly
since then we get the protects from the parser state too. */
- static SCM proc;
- if (!proc)
- proc = scm_c_eval_string ("dump-gc-protects");
scm_gc ();
- scm_call_0 (proc);
+ scm_call_0 (ly_scheme_function ("dump-gc-protects"));
#endif
do_one_file (arg);
diff --git a/lily/paper-outputter.cc b/lily/paper-outputter.cc
index 5be3c89369..a5a4205530 100644
--- a/lily/paper-outputter.cc
+++ b/lily/paper-outputter.cc
@@ -96,12 +96,8 @@ Paper_outputter::Paper_outputter (String name)
}
else
{
- static SCM find_dumper;
- if (!find_dumper)
- find_dumper = scm_c_eval_string ("find-dumper");
-
output_func_
- = scm_call_1 (find_dumper,
+ = scm_call_1 (ly_scheme_function ("find-dumper"),
scm_makfrom0str (output_format_global.to_str0 ()));
output_module_ = SCM_EOL;
}
diff --git a/lily/parser.yy b/lily/parser.yy
index 2760ec2ae6..f5eed1ba3b 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -140,9 +140,7 @@ is_regular_identifier (SCM id)
SCM
make_simple_markup (SCM a)
{
- static SCM simple;
- if (!simple)
- simple = scm_c_eval_string ("simple-markup");
+ SCM simple = scm_c_eval_string ("simple-markup");
return scm_list_2 (simple, a);
}
@@ -179,9 +177,7 @@ make_chord_step (int step, int alter)
SCM
make_chord (SCM pitch, SCM dur, SCM modification_list)
{
- static SCM chord_ctor;
- if (!chord_ctor)
- chord_ctor= scm_c_eval_string ("construct-chord");
+ SCM chord_ctor = ly_scheme_function ("construct-chord");
SCM ch= scm_call_3 (chord_ctor, pitch, dur, modification_list);
scm_gc_protect_object (ch);
return ch;
@@ -622,7 +618,7 @@ score_body:
/*
guh.
*/
- SCM check_funcs = scm_c_eval_string ("toplevel-music-functions");
+ SCM check_funcs = ly_scheme_function ("toplevel-music-functions");
for (; gh_pair_p (check_funcs); check_funcs = gh_cdr (check_funcs))
m = gh_call1 (gh_car (check_funcs), m);
$$->music_ = m;
@@ -782,9 +778,7 @@ Repeated_music:
}
- static SCM proc;
- if (!proc)
- proc = scm_c_eval_string ("make-repeated-music");
+ SCM proc = ly_scheme_function ("make-repeated-music");
SCM mus = scm_call_1 (proc, $2);
scm_gc_protect_object (mus); // UGH.
@@ -899,9 +893,7 @@ context_mod_list:
Composite_music:
AUTOCHANGE Music {
- static SCM proc ;
- if (!proc)
- proc = scm_c_eval_string ("make-autochange-music");
+ SCM proc = ly_scheme_function ("make-autochange-music");
SCM res = scm_call_1 (proc, $2->self_scm ());
scm_gc_unprotect_object ($2->self_scm ());
@@ -910,9 +902,7 @@ Composite_music:
$$->set_spot (THIS->here_input ());
}
| PARTCOMBINE Music Music {
- static SCM proc;
- if (!proc)
- proc = scm_c_eval_string ("make-part-combine-music");
+ SCM proc = ly_scheme_function ("make-part-combine-music");
SCM res = scm_call_1 (proc, gh_list ($2->self_scm (),
$3->self_scm (), SCM_UNDEFINED));
@@ -1346,9 +1336,7 @@ chord_body_element:
add_quote:
ADDQUOTE string Music {
- static SCM adder;
- if (!adder)
- adder = scm_c_eval_string ("add-quotable");
+ SCM adder = ly_scheme_function ("add-quotable");
scm_call_2 (adder, $2, $3->self_scm ());
scm_gc_unprotect_object ($3->self_scm ());
@@ -1454,27 +1442,21 @@ command_element:
$$ =p ;
}
| CLEF STRING {
- static SCM proc ;
- if (!proc)
- proc = scm_c_eval_string ("make-clef-set");
+ SCM proc = ly_scheme_function ("make-clef-set");
SCM result = scm_call_1 (proc, $2);
scm_gc_protect_object (result);
$$ = unsmob_music (result);
}
| TIME_T fraction {
- static SCM proc;
- if (!proc)
- proc = scm_c_eval_string ("make-time-signature-set");
+ SCM proc= ly_scheme_function ("make-time-signature-set");
SCM result = scm_apply_2 (proc, gh_car ($2), gh_cdr ($2), SCM_EOL);
scm_gc_protect_object (result);
$$ = unsmob_music (result);
}
| MARK scalar {
- static SCM proc;
- if (!proc)
- proc = scm_c_eval_string ("make-mark-set");
+ SCM proc = ly_scheme_function ("make-mark-set");
SCM result = scm_call_1 (proc, $2);
scm_gc_protect_object (result);
@@ -2074,10 +2056,7 @@ simple_element:
| MULTI_MEASURE_REST optional_notemode_duration {
THIS->pop_spot ();
- static SCM proc ;
- if (!proc)
- proc = scm_c_eval_string ("make-multi-measure-rest");
-
+ SCM proc = ly_scheme_function ("make-multi-measure-rest");
SCM mus = scm_call_2 (proc, $2,
make_input (THIS->here_input ()));
scm_gc_protect_object (mus);
@@ -2348,9 +2327,7 @@ markup_list:
markup_line:
'{' markup_list_body '}' {
- static SCM line ;
- if (!line)
- line = scm_c_eval_string ("line-markup");
+ SCM line = ly_scheme_function ("line-markup");
$$ = scm_list_2 (line, scm_reverse_x ($2, SCM_EOL));
}
diff --git a/lily/text-item.cc b/lily/text-item.cc
index e8e9dcabf7..b327e78865 100644
--- a/lily/text-item.cc
+++ b/lily/text-item.cc
@@ -25,9 +25,7 @@ Text_item::interpret_markup (SCM paper, SCM props, SCM markup)
if (str.index_any (" \t\n\r") != -1)
{
/* Multi word string to line markup. */
- static SCM proc;
- if (!proc)
- proc = scm_c_eval_string ("make-simple-markup");
+ SCM proc= ly_scheme_function ("make-simple-markup");
return interpret_markup (paper, props, scm_call_1 (proc, markup));
}
diff --git a/scm/lily.scm b/scm/lily.scm
index 08daa909f7..639a215091 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -367,26 +367,30 @@ L1 is copied, L2 not.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; output
-(use-modules (scm output-tex)
- (scm output-sketch)
- (scm output-sodipodi)
- (scm output-pdftex))
+(use-modules
+ ;(scm output-sketch)
+ ;(scm output-sodipodi)
+ ;(scm output-pdftex)
+ )
-;;(define output-tex-module
-;; (make-module 1021 (list (resolve-interface '(scm new-output-tex)))))
-(define (new-tex-output-expression expr port)
+(define output-tex-module
+ (make-module 1021 (list (resolve-interface '(scm output-tex)))))
+(define output-ps-module
+ (make-module 1021 (list (resolve-interface '(scm output-ps)))))
+(define-public (tex-output-expression expr port)
(display (eval expr output-tex-module) port))
+(define-public (ps-output-expression expr port)
+ (display (eval expr output-ps-module) port))
(define output-alist
`(
("tex" . ("TeX output. The default output form." ,tex-output-expression))
-;; ("safetex" . ("TeX output. The default output form." ,new-tex-output-expression))
("scm" . ("Scheme dump: debug scheme stencil expressions" ,write))
- ("sketch" . ("Bare bones Sketch output." ,sketch-output-expression))
- ("sodipodi" . ("Bare bones Sodipodi output." ,sodipodi-output-expression))
- ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
+; ("sketch" . ("Bare bones Sketch output." ,sketch-output-expression))
+; ("sodipodi" . ("Bare bones Sodipodi output." ,sodipodi-output-expression))
+; ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
))
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index d538cf0747..1ae99fb675 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -18,7 +18,48 @@
(debug-enable 'backtrace)
-(define-module (scm output-ps))
+(define-module (scm output-ps)
+ #:re-export (quote)
+ #:export (define-fonts
+ unknown
+ output-paper-def
+ output-scopes
+ select-font
+ blank
+ dot
+ beam
+ bracket
+ dashed-slur
+ char
+ dashed-line
+ zigzag-line
+ symmetric-x-triangle
+ ez-ball
+ comment
+ end-output
+ experimental-on
+ repeat-slash
+ header-end
+ header
+ placebox
+ bezier-sandwich
+ start-system
+ stop-system
+ stop-last-system
+ horizontal-line
+ filledbox
+ round-filled-box
+ text
+ tuplet
+ polygon
+ draw-line
+ between-system-string
+ define-origin
+ no-origin
+ start-page
+ stop-page
+ )
+)
(use-modules (guile)
(ice-9 regex)
(srfi srfi-13)
diff --git a/scm/output-tex.scm b/scm/output-tex.scm
index afaa04021b..32aa45778e 100644
--- a/scm/output-tex.scm
+++ b/scm/output-tex.scm
@@ -7,7 +7,49 @@
;; (debug-enable 'backtrace)
-(define-module (scm output-tex))
+(define-module (scm output-tex)
+ #:re-export (quote)
+ #:export (define-fonts
+ unknown
+ output-paper-def
+ output-scopes
+ select-font
+ blank
+ dot
+ beam
+ bracket
+ dashed-slur
+ char
+ dashed-line
+ zigzag-line
+ symmetric-x-triangle
+ ez-ball
+ comment
+ end-output
+ experimental-on
+ repeat-slash
+ header-end
+ header
+ placebox
+ bezier-sandwich
+ start-system
+ stop-system
+ stop-last-system
+ horizontal-line
+ filledbox
+ round-filled-box
+ text
+ tuplet
+ polygon
+ draw-line
+ between-system-string
+ define-origin
+ no-origin
+ start-page
+ stop-page
+ )
+)
+
(use-modules (ice-9 regex)
(ice-9 string-fun)
(ice-9 format)
@@ -15,23 +57,6 @@
(srfi srfi-13)
(lily))
-(define this-module (current-module))
-
-;; dumper-compatibility
-(define output-ps #f)
-(define (ps-output-expression expr port)
- (if (not output-ps)
- (let ((ps-module (resolve-module '(scm output-ps))))
- (eval '(use-modules (guile) (ice-9 regex) (srfi srfi-13) (lily))
- ps-module)
- (set! output-ps ps-module)))
- (display (eval expr output-ps) port))
-
-;;; Output interface entry
-
-(define-public (tex-output-expression expr port)
- (display (eval expr this-module) port ))
-
;;;;;;;;
;;;;;;;; DOCUMENT ME!
;;;;;;;;
@@ -51,7 +76,7 @@
(string-encode-integer
(inexact->exact (round (* 1000 (cdr ename-mag))))))))))
-(define (define-fonts internal-external-name-mag-pairs)
+(define-public (define-fonts internal-external-name-mag-pairs)
(set! font-name-alist (map tex-encoded-fontswitch
internal-external-name-mag-pairs))
(apply string-append
@@ -64,12 +89,12 @@
;;
;; set! returns #<unspecified> --hwn
;;
-(define (fontify name-mag-pair exp)
+(define-public (fontify name-mag-pair exp)
(string-append (select-font name-mag-pair)
exp))
-(define (unknown)
+(define-public (unknown)
"%\n\\unknown\n")
(define (symbol->tex-key sym)
--
2.39.5