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