]> git.donarmstrong.com Git - lilypond.git/blob - scripts/lilypond-invoke-editor.scm
remove $(release-dir)/ ; must contain actions within build or srcdir
[lilypond.git] / scripts / lilypond-invoke-editor.scm
1 #!@GUILE@ -s
2 !#
3 ;;;; lilypond-invoke-editor.scm -- Invoke an editor in file:line:column mode
4 ;;;;
5 ;;;; source file of the GNU LilyPond music typesetter
6 ;;;;
7 ;;;; (c) 2005--2006 Jan Nieuwenhuizen <janneke@gnu.org>
8
9 ;; gui debug helper
10 ;; (define (exit x) (system "sleep 10"))
11
12 (use-modules
13  (ice-9 getopt-long)
14  (ice-9 regex)
15  (srfi srfi-13)
16  (srfi srfi-14))
17
18 (define PROGRAM-NAME "lilypond-invoke-editor")
19 (define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@")
20 (define DATADIR "@datadir@")
21 (define COMPILE-TIME-PREFIX
22   (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
23
24 ;; argv0 relocation -- do in wrapper?
25
26
27 (define LILYPONDPREFIX
28   (let* ((prefix
29           (or (getenv "LILYPONDPREFIX")
30               (dirname  (dirname (car (command-line)))))))
31     
32
33     (if (eq? prefix (dirname DATADIR)) COMPILE-TIME-PREFIX
34         (format #f "~a/share/lilypond/~a"
35                 prefix TOPLEVEL-VERSION))))
36
37
38
39 ;; gettext wrapper for guile < 1.7.2
40 (if (defined? 'gettext)
41     (define-public _ gettext)
42     (define-public (_ x) x))
43
44 (define (show-version port)
45   (format port "~a (GNU LilyPond) ~a \n" PROGRAM-NAME TOPLEVEL-VERSION))
46
47 (define (show-help port)
48   (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:CHAR:COLUMN
49
50 Visit a file and position the cursor.
51
52 Options:
53   -h, --help          show this help
54   -v, --version       show version
55 ")))
56
57 (define (parse-options args)
58   (let* ((options (getopt-long args
59                                '((help (single-char #\h))
60                                  (version (single-char #\v)))))
61          (files (cdr (assq '() options))))
62     (if (assq 'help options)
63         (begin
64           (show-version (current-output-port))
65           (show-help (current-output-port))
66         (exit 0)))
67     (if (assq 'version options)
68         (begin (show-version (current-output-port)) (exit 0)))
69     (show-version (current-error-port))
70     files))
71
72 (define (re-sub re sub string)
73   (regexp-substitute/global #f re string 'pre sub 'post))
74
75 ;; FIXME: I'm going slowly but certainly mad; I really cannot find the
76 ;; scm library function for this.
77 (define (unquote-uri uri)
78   (re-sub "%([A-Fa-f0-9]{2})"
79           (lambda (m)
80             (string (integer->char (string->number (match:substring m 1) 16))))
81           uri))
82
83 (define (is-textedit-uri? uri)
84   (string-match "^textedit://" uri))
85   
86   
87 (define (dissect-uri uri)
88   (let* ((match (string-match "textedit://(.*):([^:]+):([^:]+):(.*)$" uri)))
89     (if match
90         (list (unquote-uri (match:substring match 1))
91               (match:substring match 2)
92               (match:substring match 3)
93               (match:substring match 4))
94         (begin
95           (format (current-error-port) (_ "invalid textedit URI: ~a") uri)
96           (newline (current-error-port))
97           (format (current-error-port) (_ "expect: textedit://FILE:LINE:CHAR:COLUMN"))
98           (newline (current-error-port))
99           (exit 1)))))
100
101 (define PLATFORM
102   (string->symbol
103    (string-downcase
104     (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
105
106 (define (running-from-gui?)
107   (let ((have-tty? (isatty? (current-input-port))))
108     ;; If no TTY and not using safe, assume running from GUI.
109     (not have-tty?)))
110
111 (define (run-editor uri)
112   (let*
113       ((command (apply get-editor-command (dissect-uri uri)))
114        (status (system command)))
115     (if (not (= status 0))
116         (begin
117           (format (current-error-port)
118                   (_ "failed to invoke editor: ~a") command)
119           (exit 1)))))
120
121 (define (run-browser uri)
122   (system
123    (if (getenv "BROWSER")
124        (format "~a ~a" (getenv "BROWSER") uri)
125        (format #f "firefox -remote 'OpenURL(~a,new-tab)'" uri))))
126
127 (define (main args)
128   (let ((files (parse-options args)))
129     (if (running-from-gui?)
130         (redirect-port (current-error-port)
131                        (open-file (string-append
132                                    (or (getenv "TMP")
133                                        (getenv "TEMP")
134                                        "/tmp")
135                                    "/lilypond-invoke-editor.log") "a")))
136     (if (not (= (length files) 1))
137         (begin
138           (show-help (current-error-port))
139           (exit 2)))
140     (set! %load-path (cons LILYPONDPREFIX %load-path))
141     (primitive-eval '(use-modules (scm editor)))
142
143     (let* ((uri (car files)))
144       (if (is-textedit-uri? uri)
145           (run-editor uri)
146           (run-browser uri)))))
147
148 (main (command-line))