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
  14 (define PROGRAM-NAME "lilypond-invoke-editor")
  15 (define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@")
  16 (define DATADIR "@DATADIR@")
  17 (define COMPILE-TIME-PREFIX
  18   (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
  19 (define LILYPONDPREFIX (or (getenv "LILYPONDPREFIX") COMPILE-TIME-PREFIX))
  20
  21 ;; gettext wrapper for guile < 1.7.2
  22 (if (defined? 'gettext)
  23     (define-public _ gettext)
  24     (define-public (_ x) x))
  25
  26 (define (show-version port)
  27   (format port "~a (GNU LilyPond) ~a \n" PROGRAM-NAME TOPLEVEL-VERSION))
  28
  29 (define (show-help port)
  30   (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:COLUMN
  31
  32 Visit a file and position the cursor
  33
  34 Options:
  35   -h,--help          show this help
  36   -v,--version       show version
  37 ")))
  38
  39 (define (parse-options args)
  40   (let* ((options (getopt-long args
  41                                '((help (single-char #\h))
  42                                  (version (single-char #\v)))))
  43          (files (cdr (assq '() options))))
  44     (if (assq 'help options)
  45         (begin
  46           (show-version (current-output-port))
  47           (show-help (current-output-port))
  48         (exit 0)))
  49     (if (assq 'version options)
  50         (begin (show-version (current-output-port)) (exit 0)))
  51     (show-version (current-error-port))
  52     files))
  53
  54 (define (re-sub re sub string)
  55   (regexp-substitute/global #f re string 'pre sub 'post))
  56
  57 (define (dissect-uri uri)
  58   (let* ((ri "textedit://")
  59          (file-name:line:column (re-sub ri "" uri))
  60          (match (string-match "([^:]+):([^:]+):(.*)" file-name:line:column)))
  61     (if match
  62         (list (match:substring match 1)
  63               (match:substring match 2)
  64               (match:substring match 3))
  65         (begin
  66           (format (current-error-port) (_ "invalid URI: ~a") uri)
  67           (newline (current-error-port))
  68           (format (current-error-port) (_ "expect: ~aFILE:LINE:COLUMN") ri)
  69           (newline (current-error-port))
  70           (exit 1)))))
  71
  72 (define (main args)
  73   (let ((files (parse-options args)))
  74     (if (not (= (length files) 1))
  75         (begin
  76           (show-help (current-error-port))
  77           (exit 1)))
  78     (set! %load-path (cons LILYPONDPREFIX %load-path))
  79     (primitive-eval '(use-modules (scm editor)))
  80     (let* ((uri (car files))
  81            (command (apply get-editor-command (dissect-uri uri)))
  82            (status (system command)))
  83       (if (not (= status 0))
  84           (begin
  85             (format (current-error-port)
  86                     (_ "failed to invoke editor: ~a") command)
  87             (exit 1))))))