X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scripts%2Flilypond-invoke-editor.scm;h=6658f50166dfe4d98f56d2d2aad068d4e291f864;hb=HEAD;hp=18dff212e652a8616097d3e47408eba1226630a5;hpb=c21383ab66c2abe8e42eda7694eb05e876e6be2c;p=lilypond.git diff --git a/scripts/lilypond-invoke-editor.scm b/scripts/lilypond-invoke-editor.scm old mode 100755 new mode 100644 index 18dff212e6..6658f50166 --- a/scripts/lilypond-invoke-editor.scm +++ b/scripts/lilypond-invoke-editor.scm @@ -1,11 +1,23 @@ -#!@GUILE@ \ --e main -s +#!@GUILE@ -s !# ;;;; lilypond-invoke-editor.scm -- Invoke an editor in file:line:column mode + +;;;; Copyright (C) 2005--2015 Jan Nieuwenhuizen + +;;;; This file is part of LilyPond, the GNU music typesetter. +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. ;;;; -;;;; source file of the GNU LilyPond music typesetter +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. ;;;; -;;;; (c) 2005 Jan Nieuwenhuizen +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . ;; gui debug helper ;; (define (exit x) (system "sleep 10")) @@ -13,6 +25,7 @@ (use-modules (ice-9 getopt-long) (ice-9 regex) + (srfi srfi-1) (srfi srfi-13) (srfi srfi-14)) @@ -23,26 +36,24 @@ (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))) - -;; gettext wrapper for guile < 1.7.2 -(if (defined? 'gettext) - (define-public _ gettext) - (define-public (_ x) x)) + +(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)))) + +(define-public _ gettext) (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. @@ -69,29 +80,29 @@ Options: (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))))) @@ -105,26 +116,60 @@ 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 #f "~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?) (redirect-port (current-error-port) (open-file (string-append - (or (getenv "TMP") - (getenv "TEMP") - "/tmp") + (if (string-match "^(Windows|CYGWIN)" + (utsname:sysname (uname))) + (or (getenv "TMP") + (getenv "TEMP")) + (or (getenv "TMPDIR") + "/tmp")) "/lilypond-invoke-editor.log") "a"))) (if (not (= (length files) 1)) (begin (show-help (current-error-port)) (exit 2))) - (set! %load-path (cons LILYPONDPREFIX %load-path)) + (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))