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 (use-modules
  11  (ice-9 getopt-long)
  12  (ice-9 regex)
  13  (srfi srfi-13)
  14  (srfi srfi-14))
  15
  16 (define PROGRAM-NAME "lilypond-invoke-editor")
  17 (define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@")
  18 (define DATADIR "@DATADIR@")
  19 (define COMPILE-TIME-PREFIX
  20   (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
  21 (define LILYPONDPREFIX (or (getenv "LILYPONDPREFIX") COMPILE-TIME-PREFIX))
  22
  23 ;; gettext wrapper for guile < 1.7.2
  24 (if (defined? 'gettext)
  25     (define-public _ gettext)
  26     (define-public (_ x) x))
  27
  28 (define (show-version port)
  29   (format port "~a (GNU LilyPond) ~a \n" PROGRAM-NAME TOPLEVEL-VERSION))
  30
  31 (define (show-help port)
  32   (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:COLUMN
  33
  34 Visit a file and position the cursor
  35
  36 Options:
  37   -h,--help          show this help
  38   -v,--version       show version
  39 ")))
  40
  41 (define (parse-options args)
  42   (let* ((options (getopt-long args
  43                                '((help (single-char #\h))
  44                                  (version (single-char #\v)))))
  45          (files (cdr (assq '() options))))
  46     (if (assq 'help options)
  47         (begin
  48           (show-version (current-output-port))
  49           (show-help (current-output-port))
  50         (exit 0)))
  51     (if (assq 'version options)
  52         (begin (show-version (current-output-port)) (exit 0)))
  53     (show-version (current-error-port))
  54     files))
  55
  56 (define (re-sub re sub string)
  57   (regexp-substitute/global #f re string 'pre sub 'post))
  58
  59 (define (dissect-uri uri)
  60   (let* ((ri "textedit://")
  61          (file-name:line:column (re-sub ri "" uri))
  62          (match (string-match "(.*):([^:]+):(.*)$" file-name:line:column)))
  63     (if match
  64         (list (match:substring match 1)
  65               (match:substring match 2)
  66               (match:substring match 3))
  67         (begin
  68           ;; FIXME: why be so strict wrt :LINE:COLUMN,
  69           ;; esp. considering omitting textedit:// is explicitly
  70           ;; allowed.
  71           (format (current-error-port) (_ "invalid URI: ~a") uri)
  72           (newline (current-error-port))
  73           (format (current-error-port) (_ "expect: ~aFILE:LINE:COLUMN") ri)
  74           (newline (current-error-port))
  75           (exit 1)))))
  76
  77 (define PLATFORM
  78   (string->symbol
  79    (string-downcase
  80     (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
  81
  82 (define (running-from-gui?)
  83   (let ((have-tty? (isatty? (current-input-port))))
  84     ;; If no TTY and not using safe, assume running from GUI.
  85     ;; for mingw, the test must be inverted.
  86     (if (eq? PLATFORM 'windows)
  87         have-tty? (not have-tty?))))
  88
  89 (define (main args)
  90   (let ((files (parse-options args)))
  91     (if (running-from-gui?)
  92         (redirect-port (current-error-port)
  93                        (open-file (string-append
  94                                    (or (getenv "TMP")
  95                                        (getenv "TEMP")
  96                                        "/tmp")
  97                                    "/lilypond-invoke-editor.log") "a")))
  98     (if (not (= (length files) 1))
  99         (begin
 100           (show-help (current-error-port))
 101           (exit 1)))
 102     (set! %load-path (cons LILYPONDPREFIX %load-path))
 103     (primitive-eval '(use-modules (scm editor)))
 104     (let* ((uri (car files))
 105            (command (apply get-editor-command (dissect-uri uri)))
 106            (status (system command)))
 107       (if (not (= status 0))
 108           (begin
 109             (format (current-error-port)
 110                     (_ "failed to invoke editor: ~a") command)
 111             (exit 1))))))