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