From 86f99a392ce48c0cc52c803667eb25ec7428cb3b Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 21 Feb 2007 15:02:26 +0100 Subject: [PATCH] Fix #306. Inspect 'point-and-click in output-scm; don't redefine mark_URI. Conflicts: scm/output-ps.scm --- scm/framework-ps.scm | 3 --- scm/output-ps.scm | 62 ++++++++++++++++++++++---------------------- 2 files changed, 31 insertions(+), 34 deletions(-) diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 14631f7f5b..f7fd763dcc 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -441,9 +441,6 @@ (display (procset "music-drawing-routines.ps") port) (display (procset "lilyponddefs.ps") port) - (if (not (ly:get-option 'point-and-click)) - (display "/mark_URI { pop pop pop pop pop } bind def\n" port)) - (display "%%EndProlog\n" port) (display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port)) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index d3b1a326cf..e3e5661951 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -179,37 +179,36 @@ (define (grob-cause offset grob) - (let* ((cause (ly:grob-property grob 'cause)) - (music-origin (if (ly:stream-event? cause) - (ly:event-property cause 'origin)))) - (if (not (ly:input-location? music-origin)) - "" - (let* ((location (ly:input-file-line-char-column music-origin)) - (raw-file (car location)) - (file (if (is-absolute? raw-file) - raw-file - (string-append (ly-getcwd) "/" raw-file))) - (x-ext (ly:grob-extent grob grob X)) - (y-ext (ly:grob-extent grob grob Y))) - - (if (and (< 0 (interval-length x-ext)) - (< 0 (interval-length y-ext))) - (format #f "~a ~a ~a ~a (textedit://~a:~a:~a:~a) mark_URI\n" - (str4 (+ (car offset) (car x-ext))) - (str4 (+ (cdr offset) (car y-ext))) - (str4 (+ (car offset) (cdr x-ext))) - (str4 (+ (cdr offset) (cdr y-ext))) - - ;; TODO - ;;full escaping. - - ;; backslash is interpreted by GS. - (ly:string-substitute "\\" "/" - (ly:string-substitute " " "%20" file)) - (cadr location) - (caddr location) - (cadddr location)) - ""))))) + (if (ly:get-option 'point-and-click) + (let* ((cause (ly:grob-property grob 'cause)) + (music-origin (if (ly:stream-event? cause) + (ly:event-property cause 'origin)))) + (if (not (ly:input-location? music-origin)) + "" + (let* ((location (ly:input-file-line-char-column music-origin)) + (raw-file (car location)) + (file (if (is-absolute? raw-file) + raw-file + (string-append (ly-getcwd) "/" raw-file))) + (x-ext (ly:grob-extent grob grob X)) + (y-ext (ly:grob-extent grob grob Y))) + + (if (and (< 0 (interval-length x-ext)) + (< 0 (interval-length y-ext))) + (format #f "~a ~a ~a ~a (textedit://~a:~a:~a:~a) mark_URI\n" + (str4 (+ (car offset) (car x-ext))) + (str4 (+ (cdr offset) (car y-ext))) + (str4 (+ (car offset) (cdr x-ext))) + (str4 (+ (cdr offset) (cdr y-ext))) + + ;; backslash is interpreted by GS. + (ly:string-substitute "\\" "/" + (ly:string-substitute " " "%20" file)) + (cadr location) + (caddr location) + (cadddr location)) + "")))) + "")) (define (lily-def key val) (let ((prefix "lilypondlayout")) @@ -219,6 +218,7 @@ (format "/~a { ~a } bind def\n" key val) (format "/~a (~a) def\n" key val)))) + (define (named-glyph font glyph) (format #f "~a /~a glyphshow " ;;Why is there a space at the end? (ps-font-command font) -- 2.39.5