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 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 (define LILYPONDPREFIX
  27   (or (getenv "LILYPONDPREFIX")
  28       (let* ((bindir (dirname (car (command-line))))
  29              (prefix (dirname bindir))
  30              (lilypond-prefix
  31               (if (eq? prefix (dirname DATADIR)) COMPILE-TIME-PREFIX
  32                   (format #f "~a/share/lilypond/~a"
  33                           prefix TOPLEVEL-VERSION))))
  34         lilypond-prefix)))
  35
  36 ;; gettext wrapper for guile < 1.7.2
  37 (if (defined? 'gettext)
  38     (define-public _ gettext)
  39     (define-public (_ x) x))
  40
  41 (define (show-version port)
  42   (format port "~a (GNU LilyPond) ~a \n" PROGRAM-NAME TOPLEVEL-VERSION))
  43
  44 (define (show-help port)
  45   (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:CHAR:COLUMN
  46
  47 Visit a file and position the cursor.
  48
  49 Options:
  50   -h, --help          show this help
  51   -v, --version       show version
  52 ")))
  53
  54 (define (parse-options args)
  55   (let* ((options (getopt-long args
  56                                '((help (single-char #\h))
  57                                  (version (single-char #\v)))))
  58          (files (cdr (assq '() options))))
  59     (if (assq 'help options)
  60         (begin
  61           (show-version (current-output-port))
  62           (show-help (current-output-port))
  63         (exit 0)))
  64     (if (assq 'version options)
  65         (begin (show-version (current-output-port)) (exit 0)))
  66     (show-version (current-error-port))
  67     files))
  68
  69 (define (re-sub re sub string)
  70   (regexp-substitute/global #f re string 'pre sub 'post))
  71
  72 ;; FIXME: I'm going slowly but certainly mad, I really cannot find the
  73 ;; scm library function for this.
  74 (define (unquote-uri uri)
  75   (re-sub "%([A-Fa-f0-9]{2})"
  76           (lambda (m)
  77             (string (integer->char (string->number (match:substring m 1) 16))))
  78           uri))
  79
  80 (define (dissect-uri uri)
  81   (let* ((ri "textedit://")
  82          (file-name:line:char:column (re-sub ri "" uri))
  83          (match (string-match "(.*):([^:]+):([^:]+):(.*)$" file-name:line:char:column)))
  84     (if match
  85         (list (unquote-uri (match:substring match 1))
  86               (match:substring match 2)
  87               (match:substring match 3)
  88               (match:substring match 4))
  89         (begin
  90           ;; FIXME: why be so strict wrt :LINE:COLUMN,
  91           ;; esp. considering omitting textedit:// is explicitly
  92           ;; allowed.
  93           (format (current-error-port) (_ "invalid URI: ~a") uri)
  94           (newline (current-error-port))
  95           (format (current-error-port) (_ "expect: ~aFILE:LINE:CHAR:COLUMN") ri)
  96           (newline (current-error-port))
  97           (exit 1)))))
  98
  99 (define PLATFORM
 100   (string->symbol
 101    (string-downcase
 102     (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
 103
 104 (define (running-from-gui?)
 105   (let ((have-tty? (isatty? (current-input-port))))
 106     ;; If no TTY and not using safe, assume running from GUI.
 107     (not have-tty?)))
 108
 109 (define (main args)
 110   (let ((files (parse-options args)))
 111     (if (running-from-gui?)
 112         (redirect-port (current-error-port)
 113                        (open-file (string-append
 114                                    (or (getenv "TMP")
 115                                        (getenv "TEMP")
 116                                        "/tmp")
 117                                    "/lilypond-invoke-editor.log") "a")))
 118     (if (not (= (length files) 1))
 119         (begin
 120           (show-help (current-error-port))
 121           (exit 2)))
 122     (set! %load-path (cons LILYPONDPREFIX %load-path))
 123     (primitive-eval '(use-modules (scm editor)))
 124     (let* ((uri (car files))
 125            (command (apply get-editor-command (dissect-uri uri)))
 126            (status (system command)))
 127       (if (not (= status 0))
 128           (begin
 129             (format (current-error-port)
 130                     (_ "failed to invoke editor: ~a") command)
 131             (exit 1))))))