* scm/editor.scm (slashify): New function.

[lilypond.git] / scripts / lilypond-invoke-editor.scm

diff --git a/scripts/lilypond-invoke-editor.scm b/scripts/lilypond-invoke-editor.scm
index 81cf6f0a4ebe0059094b86cea3acce2944bcdd96..a21630053b076546a914ffae8636539cd1e451b6 100755 (executable)
--- a/scripts/lilypond-invoke-editor.scm
+++ b/scripts/lilypond-invoke-editor.scm
@@ -1,4 +1,4 @@
-#!@GUILE@ \
+-#!@GUILE@ \
 -e main -s
 !#
 ;;;; lilypond-invoke-editor.scm -- Invoke an editor in file:line:column mode
@@ -7,12 +7,17 @@
 ;;;;
 ;;;; (c)  2005 Jan Nieuwenhuizen <janneke@gnu.org>
 
+;; gui debug helper
+;; (define (exit x) (system "sleep 10"))
+
 (use-modules
  (ice-9 getopt-long)
- (ice-9 regex))
+ (ice-9 regex)
+ (srfi srfi-13)
+ (srfi srfi-14))
 
 (define PROGRAM-NAME "lilypond-invoke-editor")
-(define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@")
+(define TOPLEVEL-VERSION "2.5.25")
 (define DATADIR "@DATADIR@")
 (define COMPILE-TIME-PREFIX
   (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
@@ -51,26 +56,59 @@ 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
+;; 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 (dissect-uri uri)
   (let* ((ri "textedit://")
         (file-name:line:column (re-sub ri "" uri))
-        (match (string-match "([^:]+):([^:]+):(.*)" file-name:line:column)))
+        (match (string-match "(.*):([^:]+):(.*)$" file-name:line:column)))
     (if match
-       (list (match:substring match 1)
+       (list (unquote-uri (match:substring match 1))
              (match:substring match 2)
              (match:substring match 3))
        (begin
+         ;; FIXME: why be so strict wrt :LINE:COLUMN,
+         ;; esp. considering omitting textedit:// is explicitly
+         ;; allowed.
          (format (current-error-port) (_ "invalid URI: ~a") uri)
          (newline (current-error-port))
          (format (current-error-port) (_ "expect: ~aFILE:LINE:COLUMN") ri)
          (newline (current-error-port))
          (exit 1)))))
-        
+
+(define PLATFORM
+  (string->symbol
+   (string-downcase
+    (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
+
+(define (running-from-gui?)
+  (let ((have-tty? (isatty? (current-input-port))))
+    ;; If no TTY and not using safe, assume running from GUI.
+    ;; for mingw, the test must be inverted.
+    (if (eq? PLATFORM 'windows)
+       have-tty? (not have-tty?))))
+
 (define (main args)
   (let ((files (parse-options args)))
+    (if (running-from-gui?)
+       (redirect-port (current-error-port)
+                      (open-file (string-append
+                                  (or (getenv "TMP")
+                                      (getenv "TEMP")
+                                      "/tmp")
+                                  "/lilypond-invoke-editor.log") "a")))
     (if (not (= (length files) 1))
        (begin
          (show-help (current-error-port))