From 5db3ac120f98d252d71f5e4380417fd45ed71086 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Thu, 26 Feb 2004 23:06:20 +0000 Subject: [PATCH] (stencil->string): Rewrite. * lily/input-smob.cc (ly_input_location: New function. --- ChangeLog | 6 +++++ lily/input-smob.cc | 65 +++++++++++++++++++++++++--------------------- scm/output-ps.scm | 63 ++++++++++++++++++-------------------------- 3 files changed, 66 insertions(+), 68 deletions(-) diff --git a/ChangeLog b/ChangeLog index 86893d993f..80e2795582 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2004-02-27 Jan Nieuwenhuizen + + * scm/output-ps.scm (stencil->string): Rewrite. + 2004-02-27 Heikki Junes * input/test/[+c-i]*.ly: refresh descriptions -- maintain @@ -5,6 +9,8 @@ 2004-02-26 Jan Nieuwenhuizen + * lily/input-smob.cc (ly_input_location: New function. + * scm/define-markup-commands.scm (upright): New markup command. * lily/parser.yy (markup): Add STRING_IDENTIFIER. diff --git a/lily/input-smob.cc b/lily/input-smob.cc index 658b3067f8..6eb47a7dd0 100644 --- a/lily/input-smob.cc +++ b/lily/input-smob.cc @@ -12,6 +12,9 @@ #include "string.hh" #include "ly-smobs.icc" +/* Dummy input location for use if real one is missing. */ +Input dummy_input_global; + static long input_tag; static @@ -35,33 +38,6 @@ free_smob (SCM s) return 0; } -/* - We don't use IMPLEMENT_TYPE_P, since the smobification part is - implemented separately from the class. - */ -LY_DEFINE(ly_input, "ly:input-location?", 1, 0, 0, - (SCM x), - "Return whether @var{x} is an input location") -{ - return unsmob_input (x) ? SCM_BOOL_T : SCM_BOOL_F ; -} - -LY_DEFINE(ly_input_message, "ly:input-message", 2, 0, 0, (SCM sip, SCM msg), - "Print @var{msg} as a GNU compliant error message, pointing to the\n" - "location in @var{sip}.\n" - ) -{ - Input *ip = unsmob_input(sip); - - SCM_ASSERT_TYPE(ip, sip, SCM_ARG1, __FUNCTION__, "input location"); - SCM_ASSERT_TYPE(gh_string_p (msg), msg, SCM_ARG2, __FUNCTION__, "string"); - - String m = ly_scm2string (msg); - - ip->message (m); - return SCM_UNDEFINED; -} - static void start_input_smobs () @@ -76,7 +52,7 @@ start_input_smobs () SCM make_input (Input ip) { - Input * nip = new Input (ip); + Input *nip = new Input (ip); SCM z; SCM_NEWSMOB (z, input_tag, nip); @@ -94,9 +70,38 @@ unsmob_input (SCM s) return 0; } +/* We don't use IMPLEMENT_TYPE_P, since the smobification part is + implemented separately from the class. */ +LY_DEFINE (ly_input, "ly:input-location?", 1, 0, 0, + (SCM x), + "Return #t if @var{x} is an input location.") +{ + return unsmob_input (x) ? SCM_BOOL_T : SCM_BOOL_F; +} -ADD_SCM_INIT_FUNC (input, start_input_smobs); +LY_DEFINE (ly_input_message, "ly:input-message", 2, 0, 0, (SCM sip, SCM msg), + "Print @var{msg} as a GNU compliant error message, pointing to the" + "location in @var{sip}.\n") +{ + Input *ip = unsmob_input(sip); + SCM_ASSERT_TYPE (ip, sip, SCM_ARG1, __FUNCTION__, "input location"); + SCM_ASSERT_TYPE (gh_string_p (msg), msg, SCM_ARG2, __FUNCTION__, "string"); + String m = ly_scm2string (msg); + ip->message (m); -Input dummy_input_global; + return SCM_UNDEFINED; +} + +LY_DEFINE (ly_input_location, "ly:input-location", 1, 0, 0, (SCM sip), + "Return input location in @var{sip} as (filename line column).") +{ + Input *ip = unsmob_input (sip); + SCM_ASSERT_TYPE (ip, sip, SCM_ARG1, __FUNCTION__, "input location"); + return scm_list3 (scm_makfrom0str (ip->file_string ().to_str0 ()), + scm_int2num (ip->line_number ()), + scm_int2num (ip->column_number ())); +} + +ADD_SCM_INIT_FUNC (input, start_input_smobs); diff --git a/scm/output-ps.scm b/scm/output-ps.scm index ba477c0055..8317225190 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -391,7 +391,7 @@ ;; define strings, for /make-lilypond-title to pick up ((string? val) (ps-string-def "lilypond" sym val)) - ;; output markups ourselves + ;; generate stencil from markup ((markup? val) (set! header-stencils (append header-stencils (list @@ -410,46 +410,33 @@ (string-append (apply string-append (map output-scope scopes))))) -(define (add-offsets a b) +(define (offset-add a b) (cons (+ (car a) (car b)) (+ (cdr a) (cdr b)))) -(define (input? foe) - #f) - (define header-stencils '()) (define (output-stencils lst) - (apply string-append (map (lambda (x) (output-stencil x '(10 . -10))) lst))) - -;; TODO: -;; de-urg me -;; implement ly:input stuff -;; replace C++ variant -;; stencil->string? -(define (output-stencil expr o) - (let ((s "")) - (while - (pair? expr) - (let ((head (car expr))) - (cond ((input? head) - (set! s (string-append - s (define-origin (ly:input-file-string head)))) - (set! expr (cadr expr))) - ((eq? head 'no-origin) - (set! s (string-append s (expression->string head))) - (set! expr (cadr expr))) - ((eq? head 'translate-stencil) - (set! o (add-offsets o (cadr expr))) - (set! expr (caddr expr))) - ((eq? head 'combine-stencil) - (set! s (string-append s (output-stencil (cadr expr) o))) - (set! expr (caddr expr))) - (else - (set! - s (string-append - s - (placebox (car o) (cdr o) - (expression->string expr)))) - (set! expr #f))))) - s)) + (apply string-append + (map (lambda (x) (stencil->string x '(10 . -10))) lst))) + +;; hmm, looks like recursing call is always last statement, does guile +;; think so too? +(define (stencil->string expr o) + (if (pair? expr) + (let ((head (car expr))) + (cond + ((ly:input-location? head) + (string-append (apply define-origin (ly:input-location head)) + (stencil->string (cadr expr) o))) + ((eq? head 'no-origin) + (string-append (expression->string head) + (stencil->string (cadr expr) o))) + ((eq? head 'translate-stencil) + (stencil->string (caddr expr) (offset-add o (cadr expr)))) + ((eq? head 'combine-stencil) + (string-append (stencil->string (cadr expr) o) + (stencil->string (caddr expr) o))) + (else + (placebox (car o) (cdr o) (expression->string expr))))) + "")) -- 2.39.5