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--2008 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-1)
  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 (define LILYPOND_DATADIR
  28   (let* ((prefix
  29           (or (getenv "LILYPOND_DATADIR")
  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
 128 (define (strip-framework-path var)
 129   (define pat "lilypond/usr")
 130   (if (getenv var)
 131       (let*
 132           ((val (getenv var))
 133            (paths (string-split val #\:))
 134            (without (remove (lambda (s) (string-contains s pat))
 135                             paths)))
 136
 137         (if (not (= (length without)
 138                     (length paths)))
 139             (setenv var (string-join without ":"))))))
 140
 141 (define (main args)
 142   (let ((files (parse-options args)))
 143     (if (running-from-gui?)
 144         (redirect-port (current-error-port)
 145                        (open-file (string-append
 146                                    (or (getenv "TMP")
 147                                        (getenv "TEMP")
 148                                        "/tmp")
 149                                    "/lilypond-invoke-editor.log") "a")))
 150     (if (not (= (length files) 1))
 151         (begin
 152           (show-help (current-error-port))
 153           (exit 2)))
 154     (set! %load-path (cons LILYPOND_DATADIR %load-path))
 155
 156     (primitive-eval '(use-modules (scm editor)))
 157
 158     (strip-framework-path "LD_LIBRARY_PATH")
 159     (let* ((uri (car files)))
 160       (if (is-textedit-uri? uri)
 161           (run-editor uri)
 162           (run-browser uri)))))
 163
 164 (main (command-line))