From: Han-Wen Nienhuys Date: Thu, 18 Mar 2004 11:14:36 +0000 (+0000) Subject: * scm/lily.scm (tex-output-expression): new function, eval within X-Git-Tag: release/2.1.32~27 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=6eef288ea512e1d437aab40736ea056743e4ea02;p=lilypond.git * 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. --- diff --git a/ChangeLog b/ChangeLog index 3b3207ecb7..2dc04719fc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2004-03-18 Han-Wen Nienhuys + + * 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 * 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 # --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)