X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scripts%2Flilypond-invoke-editor.scm;h=6658f50166dfe4d98f56d2d2aad068d4e291f864;hb=HEAD;hp=a21630053b076546a914ffae8636539cd1e451b6;hpb=86f3c1703dcf3280b5968b3c45c657d12661c87a;p=lilypond.git diff --git a/scripts/lilypond-invoke-editor.scm b/scripts/lilypond-invoke-editor.scm old mode 100755 new mode 100644 index a21630053b..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,32 +25,41 @@ (use-modules (ice-9 getopt-long) (ice-9 regex) + (srfi srfi-1) (srfi srfi-13) (srfi srfi-14)) (define PROGRAM-NAME "lilypond-invoke-editor") -(define TOPLEVEL-VERSION "2.5.25") -(define DATADIR "@DATADIR@") +(define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@") +(define DATADIR "@datadir@") (define COMPILE-TIME-PREFIX (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION)) -(define LILYPONDPREFIX (or (getenv "LILYPONDPREFIX") COMPILE-TIME-PREFIX)) -;; gettext wrapper for guile < 1.7.2 -(if (defined? 'gettext) - (define-public _ gettext) - (define-public (_ x) x)) +;; argv0 relocation -- do in wrapper? + +(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 +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) @@ -56,35 +77,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))))) @@ -96,30 +114,62 @@ Options: (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?)))) + (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 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))