(output-alist): Remove ,ps-output-expression.
* scm/output-tex.scm (ps-output-expression): New function.
* scm/output-ps.scm (ps-output-expression): Remove.
(header, start-page): Output page metadata.
* lily/paper-outputter.cc (Paper_outputter)[PAGE_LAYOUT]:
initialise output_module_. Do not write part of header.
(output_scheme)[PAGE_LAYOUT]: Output through output_module_.
(output_header): Output full header.
* scm/define-markup-commands.scm (bigger, smaller): Avoid crash.
FIXME.
+2004-03-13 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * scm/lily.scm (get-output-module): New function.
+ (output-alist): Remove ,ps-output-expression.
+
+ * scm/output-tex.scm (ps-output-expression): New function.
+
+ * scm/output-ps.scm (ps-output-expression): Remove.
+ (header, start-page): Output page metadata.
+
+ * lily/paper-outputter.cc (Paper_outputter)[PAGE_LAYOUT]:
+ initialise output_module_. Do not write part of header.
+ (output_scheme)[PAGE_LAYOUT]: Output through output_module_.
+ (output_header): Output full header.
+
+ * scm/define-markup-commands.scm (bigger, smaller): Avoid crash.
+ FIXME.
+
2004-03-13 Han-Wen Nienhuys <hanwen@xs4all.nl>
* scm/new-font.scm: new file. Tree based font lookup.
bool verbatim_scheme_b_;
public:
- SCM output_func_ ;
+ SCM output_func_;
+ SCM output_module_;
Protected_scm file_;
String basename_;
void dump_scheme (SCM);
- void output_metadata (SCM, Paper_def*);
+ void output_metadata (Paper_def*, SCM);
void output_music_output_def (Music_output_def* odef);
void output_scheme (SCM scm);
void output_expr (SCM expr, Offset o);
- void output_header (Paper_def*);
+ void output_header (Paper_def*, SCM, int);
void output_line (SCM, Offset*, bool);
};
My_lily_lexer::start_main_input ()
{
new_input (main_input_name_, &global_input_file->sources_);
+ /* Do not allow \include in --safe-mode */
allow_includes_b_ = allow_includes_b_ && ! safe_global_b;
scm_module_define (gh_car (scopes_),
Paper_def *paper = papers_[0];
Paper_outputter *out = paper->get_paper_outputter (outname);
- out->output_metadata (get_scopes (0), paper);
- out->output_header (paper);
+ out->output_header (paper, get_scopes (0), pages->size ());
int page_count = pages->size ();
for (int i = 0; i < page_count; i++)
void
Paper_book::classic_output (String outname)
{
- Paper_outputter *out = papers_.top ()->get_paper_outputter (outname);
int count = scores_.size ();
-
- out->output_metadata (get_scopes (count - 1), papers_.top ());
- out->output_header (papers_.top ());
+ Paper_outputter *out = papers_.top ()->get_paper_outputter (outname);
+ out->output_header (papers_.top (), get_scopes (count - 1), 0);
int line_count = SCM_VECTOR_LENGTH ((SCM) scores_.top ());
for (int i = 0; i < line_count; i++)
file_ = scm_open_file (scm_makfrom0str (name.to_str0 ()),
scm_makfrom0str ("w"));
- static SCM find_dumper;
- if (!find_dumper)
- find_dumper = scm_c_eval_string ("find-dumper");
-
- output_func_
- = scm_call_1 (find_dumper,
- scm_makfrom0str (output_format_global.to_str0 ()));
-
- String creator = gnu_lilypond_version_string ();
- creator += " (http://lilypond.org)";
- time_t t (time (0));
- String time_stamp = ctime (&t);
- time_stamp = time_stamp.left_string (time_stamp.length () - 1)
- + " " + *tzname;
- output_scheme (scm_list_3 (ly_symbol2scm ("header"),
- scm_makfrom0str (creator.to_str0 ()),
- scm_makfrom0str (time_stamp.to_str0 ())));
+ if (output_format_global == PAGE_LAYOUT)
+ {
+ output_func_ = SCM_UNDEFINED;
+ output_module_
+ = scm_call_1 (scm_primitive_eval (ly_symbol2scm ("get-output-module")),
+ scm_makfrom0str (output_format_global.to_str0 ()));
+ if (safe_global_b)
+ {
+ SCM safe_module = scm_primitive_eval (ly_symbol2scm ("safe-module"));
+ SCM m = scm_set_current_module (safe_module);
+ scm_c_use_module (("output-" + output_format_global).to_str0 ());
+ output_module_ = scm_set_current_module (m);
+ }
+ }
+ else
+ {
+ static SCM find_dumper;
+ if (!find_dumper)
+ find_dumper = scm_c_eval_string ("find-dumper");
+
+ output_func_
+ = scm_call_1 (find_dumper,
+ scm_makfrom0str (output_format_global.to_str0 ()));
+ output_module_ = SCM_UNDEFINED;
+ }
}
Paper_outputter::~Paper_outputter ()
void
Paper_outputter::output_scheme (SCM scm)
{
- gh_call2 (output_func_, scm, file_);
+ if (output_format_global == PAGE_LAYOUT)
+ scm_display (scm_eval (scm, output_module_), file_);
+ else
+ gh_call2 (output_func_, scm, file_);
}
void
-Paper_outputter::output_metadata (SCM scopes, Paper_def *paper)
+Paper_outputter::output_metadata (Paper_def *paper, SCM scopes)
{
SCM fields = SCM_EOL;
for (int i = dump_header_fieldnames_global.size (); i--; )
}
void
-Paper_outputter::output_header (Paper_def *paper)
+Paper_outputter::output_header (Paper_def *paper, SCM scopes, int page_count)
{
+ String creator = gnu_lilypond_version_string ();
+ creator += " (http://lilypond.org)";
+ time_t t (time (0));
+ String time_stamp = ctime (&t);
+ time_stamp = time_stamp.left_string (time_stamp.length () - 1)
+ + " " + *tzname;
+ output_scheme (scm_list_4 (ly_symbol2scm ("header"),
+ scm_makfrom0str (creator.to_str0 ()),
+ scm_makfrom0str (time_stamp.to_str0 ()),
+ scm_int2num (page_count)));
+
+ output_metadata (paper, scopes);
output_music_output_def (paper);
+
output_scheme (scm_list_1 (ly_symbol2scm ("header-end")));
output_scheme (scm_list_2 (ly_symbol2scm ("define-fonts"),
ly_quote_scm (paper->font_descriptions ())));
#include "string.hh"
#include "source-file.hh"
-/*
- Pass string to scm parser, evaluate one expression.
- Return result value and #chars read.
-
- Thanks to Gary Houston <ghouston@freewire.co.uk>
-
- Need guile-1.3.4 (>1.3 anyway) for ftell on str ports -- jcn
-*/
+/* Pass string to scm parser, evaluate one expression.
+ Return result value and #chars read.
+
+ Thanks to Gary Houston <ghouston@freewire.co.uk> */
SCM
internal_ly_parse_scm (Parse_start * ps, bool safe)
{
static SCM safe_module;
if (!safe_module)
safe_module = scm_primitive_eval (ly_symbol2scm ("safe-module"));
-
-
answer = scm_eval (form, safe_module);
}
else
(def-markup-command (smaller paper props arg) (markup?)
"Decrease the font size relative to current setting"
(let* ((fs (chain-assoc-get 'font-size props 0))
- (entry (cons 'font-size (- fs 1))))
+ ;; FIXME: crasher fix
+ ;; (entry (cons 'font-size (- fs 1))))
+ (entry (cons 'font-size (if (number? fs) (- fs 1) 0))))
(interpret-markup paper (cons (list entry) props) arg)))
(def-markup-command (bigger paper props arg) (markup?)
"Increase the font size relative to current setting"
(let* ((fs (chain-assoc-get 'font-size props 0))
- (entry (cons 'font-size (+ fs 1))))
+ ;; FIXME: crasher fix
+ ;; (entry (cons 'font-size (+ fs 1))))
+ (entry (cons 'font-size (if (number? fs) (+ fs 1) 0))))
(interpret-markup paper (cons (list entry) props) arg)))
(def-markup-command larger (markup?)
(define output-alist
`(
("tex" . ("TeX output. The default output form." ,tex-output-expression))
- ("ps" . ("Direct postscript. Requires setting GS_LIB and GS_FONTPATH" ,ps-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))
output-alist)
))
-(define-public (find-dumper format )
- (let* ((d (assoc format output-alist)))
-
+(define-public (find-dumper format)
+ (let ((d (assoc format output-alist)))
(if (pair? d)
(caddr d)
(scm-error "Could not find dumper for format ~s" format))))
+(define-public (get-output-module output-format)
+ (resolve-module `(scm ,(string->symbol
+ (string-append "output-" output-format)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; other files.
;;;; * text setting, kerning.
;;;; * document output-interface
+;;(if (not safe-mode?)
+;; (debug-enable 'backtrace))
(debug-enable 'backtrace)
(define-module (scm output-ps))
(srfi srfi-13)
(lily))
-
-
-
-;;; Lily output interface, PostScript implementation --- cleanup and docme
+(define (expression->string expr)
+ (eval expr this-module))
;;; Output interface entry
-(define-public (ps-output-expression expr port)
+(define (output-expression expr port)
(display (expression->string expr) port))
+
;;; Global vars
;; alist containing fontname -> fontcommand assoc (both strings)
+(define page-count 0)
+(define page-number 0)
(define font-name-alist '())
;; /lilypondpaperoutputscale 1.75729901757299 def
(define (tex-font? fontname)
(equal? (substring fontname 0 2) "cm"))
+
+;;;
+;;; Lily output interface, PostScript implementation --- cleanup and docme
+;;;
+
;;; Output-interface functions
(define (beam width slope thick blot)
(string-append
(define (end-output)
"\nend-lilypond-output\n")
-(define (expression->string expr)
- (eval expr this-module))
-
(define (ez-ball ch letter-col ball-col)
(string-append
" (" ch ") "
(string-append (select-font name-mag-pair) exp))
-(define (header creator time-stamp)
+(define (header creator time-stamp page-count-)
+ (set! page-count page-count-)
+ (set! page-number 0)
(string-append
"%!PS-Adobe-3.0\n"
"%%Creator: " creator " " time-stamp "\n"
+ "%%Pages: " (number->string page-count) "\n"
+ "%%PageOrder: Ascend\n"
;;(string-append "GNU LilyPond (" (lilypond-version) "), ")
;; (strftime "%c" (localtime (current-time))))
;; FIXME: duplicated in every backend
" draw_zigzag_line "))
(define (start-page)
- "\nstart-page\n")
+ (set! page-number (+ page-number 1))
+ (string-append
+ "%%Page: " (number->string page-number) " " (number->string page-count) "\n"
+ "start-page\n"))
(define (stop-page last?)
(if last?
(define this-module (current-module))
+;; dumper-compatibility
+
+(define (ps-output-expression expr port)
+ (let ((output-ps (resolve-module '(scm output-ps))))
+ (display (eval expr output-ps) port)))
+
;;; Output interface entry
(define-public (tex-output-expression expr port)
(display (eval expr this-module) port ))
(define (end-output)
(begin
- ; uncomment for some stats about lily memory
- ; (display (gc-stats))
+ ;; uncomment for some stats about lily memory
+ ;; (display (gc-stats))
(string-append
"\\lilypondend\n"
- ; Put GC stats here.
- )))
+ ;; Put GC stats here.
+ )))
(define (experimental-on)
"")
"\\lilypondspecial\n"
"\\lilypondpostscript\n"))
-(define (header creator time-stamp)
+(define (header creator time-stamp page-count)
(string-append
"% Generated by " creator "\n"
"% at " time-stamp "\n"
projects / lilypond.git / commitdiff