From f94f6c172d1311d4216d605e1e72161915505c1c Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 25 Apr 2005 19:35:00 +0000 Subject: [PATCH] (grob-cause): Yet another fix, hope it's alright this time round. --- ChangeLog | 5 +++++ cygwin/mknetrel | 1 + scm/output-ps.scm | 55 +++++++++++++++++++++-------------------------- 3 files changed, 30 insertions(+), 31 deletions(-) diff --git a/ChangeLog b/ChangeLog index c4ac334add..f80f0d3763 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2005-04-25 Jan Nieuwenhuizen + + * scm/output-ps.scm (grob-cause): Yet another fix, hope it's + alright this time round. + 2005-04-25 Han-Wen Nienhuys * Documentation/topdocs/INSTALL.texi (Top): idem. diff --git a/cygwin/mknetrel b/cygwin/mknetrel index 919d1f446a..5de8c13443 100644 --- a/cygwin/mknetrel +++ b/cygwin/mknetrel @@ -109,6 +109,7 @@ EOF --define-variable prefix=$cygwin_root \ --define-variable includedir=$cygwin_root/usr/include" fi + export CFLAGS="-DKPSE_DLL" } postconfig () { diff --git a/scm/output-ps.scm b/scm/output-ps.scm index a02a20ce09..b31ac807a4 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -193,41 +193,34 @@ (format #f " /~a glyphshow\n" g) (format #f " ~a ~a rmoveto /~a glyphshow\n" x y g)))) - x-y-named-glyphs)) - )) + x-y-named-glyphs)))) (define (grob-cause offset grob) (let* ((cause (ly:grob-property grob 'cause)) (music-origin (if (ly:music? cause) - (ly:music-property cause 'origin))) - (location (if (ly:input-location? music-origin) - (ly:input-file-line-column music-origin) - #f - )) - (file (if (string? location) - (if (and - (> (string-length location) 0) - (eq? (string-ref (car location) 0 ) #\/)) - - location - (string-append (getcwd) "/" (car location))) - #f)) - (x-ext (ly:grob-extent grob grob X)) - (y-ext (ly:grob-extent grob grob Y))) - - (if (and location - (< 0 (interval-length x-ext)) - (< 0 (interval-length y-ext))) - - (format "~a ~a ~a ~a (textedit://~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)) - file - (cadr location) - (caddr location)) - ""))) + (ly:music-property cause 'origin)))) + (if (not (ly:input-location? music-origin)) + "" + (let* ((location (ly:input-file-line-column music-origin)) + (raw-file (car location)) + (file (if (and (> (string-length raw-file) 0) + (eq? (string-ref raw-file 0) #\/)) + raw-file + (string-append (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 "~a ~a ~a ~a (textedit://~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)) + file + (cadr location) + (caddr location)) + ""))))) ;; WTF is this in every backend? (define (horizontal-line x1 x2 th) -- 2.39.2