X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-ps.scm;h=11e2190286434c18c0436048e8635eb9998a7ef7;hb=4a1ebae93cee86427a5b732a568af90062234d60;hp=b82c185e02caa7638dc0acd9a6628e4dc179cd65;hpb=f9214bac21e9926dc3248416f58190c98c4167a9;p=lilypond.git diff --git a/scm/output-ps.scm b/scm/output-ps.scm index b82c185e02..11e2190286 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -67,9 +67,6 @@ (define (number-pair->string4 numpair) (ly:format "~4l" numpair)) -(define (numbers->string4 numlist) - (string-join (map str4 numlist) " ")) - ;;; ;;; Lily output interface, PostScript implementation --- cleanup and docme ;;; @@ -150,38 +147,39 @@ (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))) - (ly:format "~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n" - (+ (car offset) (car x-ext)) - (+ (cdr offset) (car y-ext)) - (+ (car offset) (cdr x-ext)) - (+ (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 (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))) + (ly:format "~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n" + (+ (car offset) (car x-ext)) + (+ (cdr offset) (car y-ext)) + (+ (car offset) (cdr x-ext)) + (+ (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)) + "")) + "")) + "")) (define (named-glyph font glyph) (ly:format "~a /~a glyphshow " ;;Why is there a space at the end? @@ -267,7 +265,7 @@ "\n unknown\n") (define (url-link url x y) - (ly:format "~a ~a ~a ~a (~a) mark_URI" + (ly:format "~a ~a currentpoint vector_add ~a ~a currentpoint vector_add (~a) mark_URI" (car x) (car y) (cdr x)