scripts/lilypond-invoke-editor.scm

   1 #!@GUILE@ -s
   2 !#
   3 ;;;; lilypond-invoke-editor.scm -- Invoke an editor in file:line:column mode
   4
   5 ;;;; Copyright (C) 2005--2010 Jan Nieuwenhuizen <janneke@gnu.org>
   6
   7 ;;;; This file is part of LilyPond, the GNU music typesetter.
   8 ;;;;
   9 ;;;; LilyPond is free software: you can redistribute it and/or modify
  10 ;;;; it under the terms of the GNU General Public License as published by
  11 ;;;; the Free Software Foundation, either version 3 of the License, or
  12 ;;;; (at your option) any later version.
  13 ;;;;
  14 ;;;; LilyPond is distributed in the hope that it will be useful,
  15 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;;; GNU General Public License for more details.
  18 ;;;;
  19 ;;;; You should have received a copy of the GNU General Public License
  20 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;; gui debug helper
  23 ;; (define (exit x) (system "sleep 10"))
  24
  25 (use-modules
  26  (ice-9 getopt-long)
  27  (ice-9 regex)
  28  (srfi srfi-1)
  29  (srfi srfi-13)
  30  (srfi srfi-14))
  31
  32 (define PROGRAM-NAME "lilypond-invoke-editor")
  33 (define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@")
  34 (define DATADIR "@datadir@")
  35 (define COMPILE-TIME-PREFIX
  36   (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
  37
  38 ;; argv0 relocation -- do in wrapper?
  39
  40 (define LILYPOND_DATADIR
  41   (let* ((prefix
  42           (or (getenv "LILYPOND_DATADIR")
  43               (dirname  (dirname (car (command-line)))))))
  44
  45
  46     (if (eq? prefix (dirname DATADIR)) COMPILE-TIME-PREFIX
  47         (format #f "~a/share/lilypond/~a"
  48                 prefix TOPLEVEL-VERSION))))
  49
  50
  51
  52 ;; gettext wrapper for guile < 1.7.2
  53 (if (defined? 'gettext)
  54     (define-public _ gettext)
  55     (define-public (_ x) x))
  56
  57 (define (show-version port)
  58   (format port "~a (GNU LilyPond) ~a\n" PROGRAM-NAME TOPLEVEL-VERSION))
  59
  60 (define (show-help port)
  61   (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:CHAR:COLUMN
  62
  63 Visit a file and position the cursor.
  64
  65 Options:
  66   -h, --help          show this help
  67   -v, --version       show version
  68 ")))
  69
  70 (define (parse-options args)
  71   (let* ((options (getopt-long args
  72                                '((help (single-char #\h))
  73                                  (version (single-char #\v)))))
  74          (files (cdr (assq '() options))))
  75     (if (assq 'help options)
  76         (begin
  77           (show-version (current-output-port))
  78           (show-help (current-output-port))
  79         (exit 0)))
  80     (if (assq 'version options)
  81         (begin (show-version (current-output-port)) (exit 0)))
  82     (show-version (current-error-port))
  83     files))
  84
  85 (define (re-sub re sub string)
  86   (regexp-substitute/global #f re string 'pre sub 'post))
  87
  88 ;; FIXME: I'm going slowly but certainly mad; I really cannot find the
  89 ;; scm library function for this.
  90 (define (unquote-uri uri)
  91   (re-sub "%([A-Fa-f0-9]{2})"
  92           (lambda (m)
  93             (string (integer->char (string->number (match:substring m 1) 16))))
  94           uri))
  95
  96 (define (is-textedit-uri? uri)
  97   (string-match "^textedit://" uri))
  98
  99
 100 (define (dissect-uri uri)
 101   (let* ((match (string-match "textedit://(.*):([^:]+):([^:]+):(.*)$" uri)))
 102     (if match
 103         (list (unquote-uri (match:substring match 1))
 104               (match:substring match 2)
 105               (match:substring match 3)
 106               (match:substring match 4))
 107         (begin
 108           (format (current-error-port) (_ "invalid textedit URI: ~a") uri)
 109           (newline (current-error-port))
 110           (format (current-error-port) (_ "expect: textedit://FILE:LINE:CHAR:COLUMN"))
 111           (newline (current-error-port))
 112           (exit 1)))))
 113
 114 (define PLATFORM
 115   (string->symbol
 116    (string-downcase
 117     (car (string-tokenize (vector-ref (uname) 0) char-set:letter)))))
 118
 119 (define (running-from-gui?)
 120   (let ((have-tty? (isatty? (current-input-port))))
 121     ;; If no TTY and not using safe, assume running from GUI.
 122     (not have-tty?)))
 123
 124 (define (run-editor uri)
 125   (let*
 126       ((command (apply get-editor-command (dissect-uri uri)))
 127        (status (system command)))
 128     (if (not (= status 0))
 129         (begin
 130           (format (current-error-port)
 131                   (_ "failed to invoke editor: ~a") command)
 132           (exit 1)))))
 133
 134 (define (run-browser uri)
 135   (system
 136    (if (getenv "BROWSER")
 137        (format "~a ~a" (getenv "BROWSER") uri)
 138        (format #f "firefox -remote 'OpenURL(~a,new-tab)'" uri))))
 139
 140
 141 (define (strip-framework-path var)
 142   (define pat "lilypond/usr")
 143   (if (getenv var)
 144       (let*
 145           ((val (getenv var))
 146            (paths (string-split val #\:))
 147            (without (remove (lambda (s) (string-contains s pat))
 148                             paths)))
 149
 150         (if (not (= (length without)
 151                     (length paths)))
 152             (setenv var (string-join without ":"))))))
 153
 154 (define (main args)
 155   (let ((files (parse-options args)))
 156     (if (running-from-gui?)
 157         (redirect-port (current-error-port)
 158                        (open-file (string-append
 159                                    (or (getenv "TMP")
 160                                        (getenv "TEMP")
 161                                        "/tmp")
 162                                    "/lilypond-invoke-editor.log") "a")))
 163     (if (not (= (length files) 1))
 164         (begin
 165           (show-help (current-error-port))
 166           (exit 2)))
 167     (set! %load-path (cons LILYPOND_DATADIR %load-path))
 168
 169     (primitive-eval '(use-modules (scm editor)))
 170
 171     (strip-framework-path "LD_LIBRARY_PATH")
 172     (let* ((uri (car files)))
 173       (if (is-textedit-uri? uri)
 174           (run-editor uri)
 175           (run-browser uri)))))
 176
 177 (main (command-line))