OLD | NEW |
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; Copyright (C) 2005--2015 Jan Nieuwenhuizen <janneke@gnu.org> | 3 ;;;; Copyright (C) 2005--2015 Jan Nieuwenhuizen <janneke@gnu.org> |
4 ;;;; | 4 ;;;; |
5 ;;;; LilyPond is free software: you can redistribute it and/or modify | 5 ;;;; LilyPond is free software: you can redistribute it and/or modify |
6 ;;;; it under the terms of the GNU General Public License as published by | 6 ;;;; it under the terms of the GNU General Public License as published by |
7 ;;;; the Free Software Foundation, either version 3 of the License, or | 7 ;;;; the Free Software Foundation, either version 3 of the License, or |
8 ;;;; (at your option) any later version. | 8 ;;;; (at your option) any later version. |
9 ;;;; | 9 ;;;; |
10 ;;;; LilyPond is distributed in the hope that it will be useful, | 10 ;;;; LilyPond is distributed in the hope that it will be useful, |
(...skipping 22 matching lines...) Expand all Loading... |
33 (getenv "XEDITOR") | 33 (getenv "XEDITOR") |
34 (getenv "EDITOR") | 34 (getenv "EDITOR") |
35 | 35 |
36 ;; FIXME: how are default/preferred editors specified on | 36 ;; FIXME: how are default/preferred editors specified on |
37 ;; different platforms? | 37 ;; different platforms? |
38 (case PLATFORM | 38 (case PLATFORM |
39 ((windows) "lilypad") | 39 ((windows) "lilypad") |
40 (else | 40 (else |
41 "emacs")))) | 41 "emacs")))) |
42 | 42 |
| 43 ;; A bunch of stuff stolen from Emacs |
| 44 |
| 45 (define (w32-using-nt) |
| 46 "Return non-nil if running on a Windows NT descendant. |
| 47 That includes all Windows systems except for 9X/Me." |
| 48 (getenv "SystemRoot")) |
| 49 |
| 50 (define (w32-shell-name) |
| 51 "Return the name of the shell being used." |
| 52 (or (getenv "SHELL") |
| 53 (and (w32-using-nt) "cmd.exe") |
| 54 "command.com")) |
| 55 |
| 56 (define w32-system-shells '("cmd" "cmd.exe" "command" "command.com" |
| 57 "4nt" "4nt.exe" "4dos" "4dos.exe" |
| 58 "tcc" "tcc.exe" "ndos" "ndos.exe")) |
| 59 |
| 60 (define (w32-system-shell-p shell-name) |
| 61 (and shell-name |
| 62 (member (string-downcase |
| 63 (basename shell-name)) |
| 64 w32-system-shells))) |
| 65 |
| 66 (define (w32-shell-dos-semantics) |
| 67 "Return non-nil if the interactive shell being used expects MS-DOS shell seman
tics." |
| 68 (or (w32-system-shell-p (w32-shell-name)) |
| 69 (and (member (string-downcase (basename (w32-shell-name))) |
| 70 '("cmdproxy" "cmdproxy.exe")) |
| 71 (w32-system-shell-p (getenv "COMSPEC"))))) |
| 72 |
| 73 (define-public (shell-quote-argument argument) |
| 74 "Quote ARGUMENT for passing as argument to an inferior shell. |
| 75 |
| 76 This function is designed to work with the syntax of your system's |
| 77 standard shell, and might produce incorrect results with unusual shells. |
| 78 See Info node `(elisp)Security Considerations'." |
| 79 (cond |
| 80 ((and (eq? PLATFORM 'windows) (w32-shell-dos-semantics)) |
| 81 |
| 82 ;; First, quote argument so that CommandLineToArgvW will |
| 83 ;; understand it. See |
| 84 ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx |
| 85 ;; After we perform that level of quoting, escape shell |
| 86 ;; metacharacters so that cmd won't mangle our argument. If the |
| 87 ;; argument contains no double quote characters, we can just |
| 88 ;; surround it with double quotes. Otherwise, we need to prefix |
| 89 ;; each shell metacharacter with a caret. |
| 90 |
| 91 (set! argument |
| 92 ;; escape backslashes at end of string |
| 93 (regexp-substitute/global |
| 94 #f |
| 95 "(\\\\+)$" |
| 96 ;; escape backslashes and quotes in string body |
| 97 (regexp-substitute/global |
| 98 #f |
| 99 "(\\\\*)\"" |
| 100 argument |
| 101 'pre 1 1 "\\\"" 'post) |
| 102 'pre 1 1 'post)) |
| 103 |
| 104 (if (string-match "[%!\"]" argument) |
| 105 (string-append |
| 106 "^\"" |
| 107 (regexp-substitute/global |
| 108 #f |
| 109 "[%!()\"<>&|^]" |
| 110 argument |
| 111 'pre "^" 0 'post) |
| 112 "^\"") |
| 113 (string-append "\"" argument "\""))) |
| 114 |
| 115 (else |
| 116 (if (string-null? argument) |
| 117 "''" |
| 118 ;; Quote everything except POSIX filename characters. |
| 119 ;; This should be safe enough even for really weird shells. |
| 120 (regexp-substitute/global |
| 121 #f |
| 122 "\n" |
| 123 (regexp-substitute/global |
| 124 #f |
| 125 ;;; "[^-0-9a-zA-Z_./\n]" Negative ranges are too dangerous since |
| 126 ;;; their UTF-8 implications aren't clear: we don't want |
| 127 ;;; characters outside the ASCII range quoted since it is not |
| 128 ;;; clear whether we need to quote bytes or characters. So we just |
| 129 ;;; invert the above regexp pattern for Posix characters manually. |
| 130 "[\x01-\x09\x0b-,:-@[-^{-\x7f]" |
| 131 argument |
| 132 'pre "\\" 0 'post) |
| 133 'pre "'\n'" 'post))) |
| 134 )) |
| 135 |
| 136 |
43 (define editor-command-template-alist | 137 (define editor-command-template-alist |
44 '(("emacs" . "emacsclient --no-wait +%(line)s:%(column)s %(file)s || (emacs +
%(line)s:%(column)s %(file)s&)") | 138 '(("emacs" . "emacsclient --no-wait +%(line)s:%(column)s %(file)s || (emacs +
%(line)s:%(column)s %(file)s&)") |
45 ("gvim" . "gvim --remote +:%(line)s:norm%(column)s %(file)s") | 139 ("gvim" . "gvim --remote +:%(line)s:norm%(column)s %(file)s") |
46 ("uedit32" . "uedit32 %(file)s -l%(line)s -c%(char)s") | 140 ("uedit32" . "uedit32 %(file)s -l%(line)s -c%(char)s") |
47 ("nedit" . "nc -noask +%(line)s %(file)s") | 141 ("nedit" . "nc -noask +%(line)s %(file)s") |
48 ("gedit" . "gedit +%(line)s %(file)s") | 142 ("gedit" . "gedit +%(line)s %(file)s") |
49 ("jedit" . "jedit -reuseview %(file)s +line:%(line)s") | 143 ("jedit" . "jedit -reuseview %(file)s +line:%(line)s") |
50 ("syn" . "syn -line %(line)s -col %(char)s %(file)s") | 144 ("syn" . "syn -line %(line)s -col %(char)s %(file)s") |
51 ("lilypad" . "lilypad +%(line)s:%(char)s %(file)s"))) | 145 ("lilypad" . "lilypad +%(line)s:%(char)s %(file)s"))) |
52 | 146 |
(...skipping 15 matching lines...) Expand all Loading... |
68 | 162 |
69 (define (slashify x) | 163 (define (slashify x) |
70 (if (string-index x #\/) | 164 (if (string-index x #\/) |
71 x | 165 x |
72 (re-sub "\\\\" "/" x))) | 166 (re-sub "\\\\" "/" x))) |
73 | 167 |
74 (define-public (get-editor-command file-name line char column) | 168 (define-public (get-editor-command file-name line char column) |
75 (let* ((editor (get-editor)) | 169 (let* ((editor (get-editor)) |
76 (template (get-command-template editor-command-template-alist editor)) | 170 (template (get-command-template editor-command-template-alist editor)) |
77 (command | 171 (command |
78 (re-sub "%\\(file\\)s" (format #f "~S" file-name) | 172 (re-sub "%\\(file\\)s" (shell-quote-argument file-name) |
79 (re-sub "%\\(line\\)s" (format #f "~a" line) | 173 (re-sub "%\\(line\\)s" (format #f "~a" line) |
80 (re-sub "%\\(char\\)s" (format #f "~a" char) | 174 (re-sub "%\\(char\\)s" (format #f "~a" char) |
81 (re-sub | 175 (re-sub |
82 "%\\(column\\)s" (format #f "~a" column) | 176 "%\\(column\\)s" (format #f "~a" column) |
83 (slashify template))))))) | 177 (slashify template))))))) |
84 command)) | 178 command)) |
OLD | NEW |