-#!@GUILE@ \
--e main -s
+#!@GUILE@ -s
!#
;;;; lilypond-invoke-editor.scm -- Invoke an editor in file:line:column mode
+
+;;;; Copyright (C) 2005--2015 Jan Nieuwenhuizen <janneke@gnu.org>
+
+;;;; 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 <janneke@gnu.org>
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
;; gui debug helper
;; (define (exit x) (system "sleep 10"))
(use-modules
(ice-9 getopt-long)
(ice-9 regex)
+ (srfi srfi-1)
(srfi srfi-13)
(srfi srfi-14))
(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
+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)
(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)))))
;; 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 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))
projects / lilypond.git / blobdiff