X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scripts%2Flilypond-invoke-editor.scm;h=2f4f3e84e54c9cfc5af90edc3675172093f634f4;hb=de94141c98300335d2675fff9e5a4cb9b42fccac;hp=a9cf32c2497c28543d69acef4879ff10f529fb95;hpb=6a90fc4934c0c7ce8f2ac1bef7de3ec447ede3e2;p=lilypond.git

diff --git a/scripts/lilypond-invoke-editor.scm b/scripts/lilypond-invoke-editor.scm
old mode 100755
new mode 100644
index a9cf32c249..2f4f3e84e5
--- a/scripts/lilypond-invoke-editor.scm
+++ b/scripts/lilypond-invoke-editor.scm
@@ -1,11 +1,10 @@
-#!@GUILE@ \
--e main -s
+#!@GUILE@ -s
 !#
 ;;;; lilypond-invoke-editor.scm -- Invoke an editor in file:line:column mode
 ;;;;
 ;;;; source file of the GNU LilyPond music typesetter
 ;;;;
-;;;; (c)  2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2005--2009 Jan Nieuwenhuizen <janneke@gnu.org>
 
 ;; gui debug helper
 ;; (define (exit x) (system "sleep 10"))
@@ -13,6 +12,7 @@
 (use-modules
  (ice-9 getopt-long)
  (ice-9 regex)
+ (srfi srfi-1)
  (srfi srfi-13)
  (srfi srfi-14))
 
@@ -23,15 +23,18 @@
   (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
 
 ;; argv0 relocation -- do in wrapper?
-(define LILYPONDPREFIX
-  (or (getenv "LILYPONDPREFIX")
-      (let* ((bindir (dirname (car (command-line))))
-	     (prefix (dirname bindir))
-	     (lilypond-prefix
-	      (if (eq? prefix (dirname DATADIR)) COMPILE-TIME-PREFIX
-		  (format #f "~a/share/lilypond/~a"
-			  prefix TOPLEVEL-VERSION))))
-	lilypond-prefix)))
+
+(define LILYPOND_DATADIR
+  (let* ((prefix
+	  (or (getenv "LILYPOND_DATADIR")
+	      (dirname  (dirname (car (command-line)))))))
+    
+
+    (if (eq? prefix (dirname DATADIR)) COMPILE-TIME-PREFIX
+	(format #f "~a/share/lilypond/~a"
+		prefix TOPLEVEL-VERSION))))
+
+
 
 ;; gettext wrapper for guile < 1.7.2
 (if (defined? 'gettext)
@@ -39,16 +42,16 @@
     (define-public (_ x) x))
 
 (define (show-version port)
-  (format port "~a (GNU LilyPond) ~a \n" PROGRAM-NAME TOPLEVEL-VERSION))
+  (format port "~a (GNU LilyPond) ~a\n" PROGRAM-NAME TOPLEVEL-VERSION))
 
 (define (show-help port)
-  (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:COLUMN
+  (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:CHAR:COLUMN
 
-Visit a file and position the cursor
+Visit a file and position the cursor.
 
 Options:
-  -h,--help          show this help
-  -v,--version       show version
+  -h, --help          show this help
+  -v, --version       show version
 ")))
 
 (define (parse-options args)
@@ -66,35 +69,32 @@ Options:
     (show-version (current-error-port))
     files))
 
-;;(define (re-sub re sub string)
-;;  (let ((sub-string (if (string? sub) sub (sub re))))
-;;    (regexp-substitute/global #f re string 'pre sub-string 'post)))
 (define (re-sub re sub string)
   (regexp-substitute/global #f re string 'pre sub 'post))
 
-;; FIXME: I'm going slowly but certainly mad, I really cannot find the
+;; FIXME: I'm going slowly but certainly mad; I really cannot find the
 ;; scm library function for this.
 (define (unquote-uri uri)
   (re-sub "%([A-Fa-f0-9]{2})"
 	  (lambda (m)
 	    (string (integer->char (string->number (match:substring m 1) 16))))
 	  uri))
+
+(define (is-textedit-uri? uri)
+  (string-match "^textedit://" uri))
+  
   
 (define (dissect-uri uri)
-  (let* ((ri "textedit://")
-	 (file-name:line:column (re-sub ri "" uri))
-	 (match (string-match "(.*):([^:]+):(.*)$" file-name:line:column)))
+  (let* ((match (string-match "textedit://(.*):([^:]+):([^:]+):(.*)$" uri)))
     (if match
 	(list (unquote-uri (match:substring match 1))
 	      (match:substring match 2)
-	      (match:substring match 3))
+	      (match:substring match 3)
+	      (match:substring match 4))
 	(begin
-	  ;; FIXME: why be so strict wrt :LINE:COLUMN,
-	  ;; esp. considering omitting textedit:// is explicitly
-	  ;; allowed.
-	  (format (current-error-port) (_ "invalid URI: ~a") uri)
+	  (format (current-error-port) (_ "invalid textedit URI: ~a") uri)
 	  (newline (current-error-port))
-	  (format (current-error-port) (_ "expect: ~aFILE:LINE:COLUMN") ri)
+	  (format (current-error-port) (_ "expect: textedit://FILE:LINE:CHAR:COLUMN"))
 	  (newline (current-error-port))
 	  (exit 1)))))
 
@@ -108,6 +108,36 @@ Options:
     ;; If no TTY and not using safe, assume running from GUI.
     (not have-tty?)))
 
+(define (run-editor uri)
+  (let*
+      ((command (apply get-editor-command (dissect-uri uri)))
+       (status (system command)))
+    (if (not (= status 0))
+	(begin
+	  (format (current-error-port)
+		  (_ "failed to invoke editor: ~a") command)
+	  (exit 1)))))
+
+(define (run-browser uri)
+  (system
+   (if (getenv "BROWSER")
+       (format "~a ~a" (getenv "BROWSER") uri)
+       (format #f "firefox -remote 'OpenURL(~a,new-tab)'" uri))))
+
+
+(define (strip-framework-path var)
+  (define pat "lilypond/usr")
+  (if (getenv var)
+      (let*
+	  ((val (getenv var))
+	   (paths (string-split val #\:))
+	   (without (remove (lambda (s) (string-contains s pat))
+			    paths)))
+	
+	(if (not (= (length without)
+		    (length paths)))
+	    (setenv var (string-join without ":"))))))
+
 (define (main args)
   (let ((files (parse-options args)))
     (if (running-from-gui?)
@@ -120,14 +150,15 @@ Options:
     (if (not (= (length files) 1))
 	(begin
 	  (show-help (current-error-port))
-	  (exit 1)))
-    (set! %load-path (cons LILYPONDPREFIX %load-path))
+	  (exit 2)))
+    (set! %load-path (cons LILYPOND_DATADIR %load-path))
+
     (primitive-eval '(use-modules (scm editor)))
-    (let* ((uri (car files))
-	   (command (apply get-editor-command (dissect-uri uri)))
-	   (status (system command)))
-      (if (not (= status 0))
-	  (begin
-	    (format (current-error-port)
-		    (_ "failed to invoke editor: ~a") command)
-	    (exit 1))))))
+
+    (strip-framework-path "LD_LIBRARY_PATH")
+    (let* ((uri (car files)))
+      (if (is-textedit-uri? uri)
+	  (run-editor uri)
+	  (run-browser uri)))))
+
+(main (command-line))