(U-000208DE): Apply new glyph-image conventions; unify S-8114.
[chise/xemacs-chise.git.1] / lisp / win32-native.el
1 ;;; win32-native.el --- Lisp routines when running on native MS Windows.
2
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
4 ;; Copyright (C) 2000 Ben Wing.
5
6 ;; Maintainer: XEmacs Development Team
7 ;; Keywords: mouse, dumped
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING.  If not, write to the
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Synched up with: Not in FSF.
27 ;;; (FSF has stuff in w32-fns.el and term/w32-win.el.)
28
29 ;;; Commentary:
30
31 ;; This file is dumped with XEmacs for MS Windows (without cygwin).
32 ;; It is for stuff that is used specifically when `system-type' eq
33 ;; `windows-nt' (i.e. also applies to MinGW), and has nothing to do
34 ;; with the `mswindows' device type.  Thus, it probably applies in
35 ;; non-interactive mode as well, and it DOES NOT APPLY to Cygwin.
36
37 ;; Based (originally) on NT Emacs version by Geoff Voelker
38 ;; (voelker@cs.washington.edu)
39 ;; Ported to XEmacs by Marc Paquette <marcpa@cam.org>
40 ;; Largely modified by Kirill M. Katsnelson <kkm@kis.ru>
41 ;; Rewritten from scratch by Ben Wing <ben@xemacs.org>.  No code in common
42 ;; with FSF.
43
44 ;;; Code:
45
46 ;; For appending suffixes to directories and files in shell
47 ;; completions.  This screws up cygwin users so we leave it out for
48 ;; now. Uncomment this if you only ever want to use cmd.
49
50 ;(defun nt-shell-mode-hook ()
51 ;  (setq comint-completion-addsuffix '("\\" . " ")
52 ;       comint-process-echoes t))
53 ;(add-hook 'shell-mode-hook 'nt-shell-mode-hook)
54
55 ;; Use ";" instead of ":" as a path separator (from files.el).
56 (setq path-separator ";")
57
58 ;; Set the null device (for compile.el).
59 ;; Backward-compatibility; recent compile.el uses null-device if available.
60 (setq grep-null-device null-device)
61
62 ;; Set the grep regexp to match entries with drive letters.
63 (setq grep-regexp-alist
64   '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
65
66 (defvar mswindows-system-shells '("cmd" "cmd.exe" "command" "command.com"
67                                   "4nt" "4nt.exe" "4dos" "4dos.exe"
68                                   "ndos" "ndos.exe")
69   "List of strings recognized as Windows NT/9X system shells.
70 These are shells with native semantics, e.g. they use `/c', not '-c',
71 to pass a command in.")
72
73 (defun mswindows-system-shell-p (shell-name)
74   (member (downcase (file-name-nondirectory shell-name)) 
75           mswindows-system-shells))
76
77 (defun init-mswindows-at-startup ()
78   ;; shell-file-name is initialized in the C code (callproc.c) from
79   ;; SHELL or COMSPEC.
80   ;; #### If only shell-command-switch could be a function.  But there
81   ;; is code littered around that uses it.
82   ;; #### Maybe we should set a symbol-value handler on `shell-file-name'
83   ;; that automatically sets shell-command-switch?
84   (if (mswindows-system-shell-p shell-file-name)
85       (setq shell-command-switch "/c")))
86
87 ;;----------------------------------------------------------------------
88 ;; Quoting process args
89 ;;--------------------
90
91 (defvar debug-mswindows-process-command-lines nil
92   "If non-nil, output debug information about the command lines constructed.
93 This can be useful if you are getting process errors where the arguments
94 to the process appear to be getting passed incorrectly.")
95
96 ;; properly quotify one arg for the vc runtime argv constructor.
97 (defun mswindows-quote-one-vc-runtime-arg (arg &optional quote-shell)
98   ;; we mess with any arg with whitespace, quotes, or globbing chars in it.
99   ;; we also include shell metachars if asked.
100   ;; note that \ is NOT included!  it's perfectly OK to include an
101   ;; arg like c:\ or c:\foo.
102   (cond ((equal arg "") "\"\"")
103         ((string-match
104           (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?\"]")
105           arg)
106          ;; handle nested quotes, possibly preceded by backslashes
107          (setq arg (replace-in-string arg "\\([\\]*\\)\"" "\\1\\1\\\\\""))
108          ;; handle trailing backslashes
109          (setq arg (replace-in-string arg "\\([\\]+\\)$" "\\1\\1"))
110          (concat "\"" arg "\""))
111         (t arg)))
112
113 (defun mswindows-quote-one-simple-arg (arg &optional quote-shell)
114   ;; just put double quotes around args with spaces (and maybe shell
115   ;; metachars).
116   (cond ((equal arg "") "\"\"")
117         ((string-match
118           (if quote-shell "[ \t\n\r\f*?\"<>|&^%]" "[ \t\n\r\f*?]")
119           arg)
120          (concat "\"" arg "\""))
121         (t arg)))
122
123 (defun mswindows-quote-one-command-arg (arg)
124   ;; quote an arg to get it past COMMAND.COM/CMD.EXE: need to quote shell
125   ;; metachars with ^.
126   (cond ((equal arg "") "\"\"")
127         (t (replace-in-string "[<>|&^%]" "^\\1" arg))))
128
129 (defun mswindows-construct-verbatim-command-line (program args)
130   (mapconcat #'identity args " "))
131
132 ;; for use with either standard VC++ compiled programs or Cygwin programs,
133 ;; which emulate the same behavior.
134 (defun mswindows-construct-vc-runtime-command-line (program args)
135   (mapconcat #'mswindows-quote-one-vc-runtime-arg args " "))
136
137 ;; note: for pulling apart an arg:
138 ;; each arg consists of either
139
140 ;; something surrounded by single quotes
141
142 ;; or
143
144 ;; one or more of
145
146 ;; 1. a non-ws, non-" char
147 ;; 2. a section of double-quoted text
148 ;; 3. a section of double-quoted text with end-of-string instead of the final
149 ;; quote.
150
151 ;; 2 and 3 get handled together.
152
153 ;; quoted text is one of
154 ;;
155 ;; 1. quote + even number of backslashes + quote, or
156 ;; 2. quote + non-greedy anything + non-backslash + even number of
157 ;;    backslashes + quote.
158
159 ;; we need to separate the two because we unfortunately have no non-greedy
160 ;; ? operator. (urk! we actually do, but it wasn't documented.) --ben
161
162 ;; if you want to mess around, keep this test case in mind:
163
164 ;; this string
165
166 ;; " as'f 'FOO BAR' '' \"\" \"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\" foo\" "
167
168 ;; should tokenize into this:
169
170 ;; (" " "as'f" " " "'FOO BAR' " "'' " "\"\"" " " "\"asdf \\ \\\" \\\\\\\" asdfasdf\\\\\"" " " "foo" "\" ")
171
172 ;; this regexp actually separates the arg into individual args, like a
173 ;; shell (such as sh) does, but using vc-runtime rules.  it's easy to
174 ;; derive the tokenizing regexp from it, and that's exactly what i did.
175 ;; but oh was it hard to get this first regexp right. --ben
176 ;(defvar mswindows-match-one-cmd-exe-arg-regexp
177 ;  (concat
178 ;   "^\\("
179 ;   "'\\([\\]*\\)\\2'" "\\|"
180 ;   "'.*?[^\\]\\(\\([\\]*\\)\\4'\\)" "\\|"
181 ;   "\\("
182 ;   "[^ \t\n\r\f\v\"]" "\\|"
183 ;   "\"\\([\\]*\\)\\6\"" "\\|"
184 ;   "\".*?[^\\]\\(\\([\\]*\\)\\8\"\\|$\\)"
185 ;   "\\)+"
186 ;   "\\)"
187 ;   "\\([ \t\n\r\f\v]+\\|$\\)"))
188
189 (defvar mswindows-match-one-cmd-exe-token-regexp
190   (concat
191    "^\\("
192    "[ \t\n\r\f\v]+" "\\|"
193    "'\\([\\]*\\)\\2'" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|"
194    "'.*?[^\\]\\(\\([\\]*\\)\\5'\\)" "\\([ \t\n\r\f\v]+\\|$\\)" "\\|"
195    "[^ \t\n\r\f\v\"]+" "\\|"
196    "\"\\([\\]*\\)\\7\"" "\\|"
197    "\".*?[^\\]\\(\\([\\]*\\)\\9\"\\|$\\)"
198    "\\)"))
199
200 (defun mswindows-construct-command-command-line (program args)
201   ;; for use with COMMAND.COM and CMD.EXE:
202   ;; for each arg, tokenize it into quoted and non-quoted sections;
203   ;; then quote all the shell meta-chars with ^; then put everything
204   ;; back together.  the truly hard part is the tokenizing -- typically
205   ;; we get a single argument (the command to execute) and we have to
206   ;; worry about quotes that are backslash-quoted and such.
207   (mapconcat
208    #'(lambda (arg)
209        (mapconcat
210         #'(lambda (part)
211             (if (string-match "^'" part)
212                 (replace-in-string part "\\([<>|^&%]\\)" "^\\1")
213               part))
214         (let (parts)
215           (while (and (> (length arg) 0)
216                       (string-match
217                        mswindows-match-one-cmd-exe-token-regexp
218                        arg))
219             (push (match-string 0 arg) parts)
220             (setq arg (substring arg (match-end 0))))
221           (if (> (length arg) 0)
222               (push arg parts))
223           (nreverse parts))
224         ""))
225    args " "))
226
227 (defvar mswindows-construct-process-command-line-alist
228   '(
229     ;; at one point (pre-1.0), this was required for Cygwin bash.
230     ;; evidently, Cygwin changed its arg handling to work just like
231     ;; any standard VC program, so we no longer need it.
232     ;;("[\\/].?.?sh\\." . mswindows-construct-verbatim-command-line)
233     ("[\\/]command\\.com$" . mswindows-construct-command-command-line)
234     ("[\\/]cmd\\.exe$" . mswindows-construct-command-command-line)
235     ("" . mswindows-construct-vc-runtime-command-line))
236   "An alist for determining proper argument quoting given executable
237 file name.  Car of each cons should be a string, a regexp against
238 which the file name is matched.  Matching is case-insensitive but does
239 include the directory, so you should begin your regexp with [\\\\/] if
240 you don't want the directory to matter.  Alternatively, the car can be
241 a function of one arg, which is called with the executable's name and
242 should return t if this entry should be processed.  Cdr is a function
243 symbol, which is called with two args, the executable name and a list
244 of the args passed to it.  It should return a string, which includes
245 the executable's args (but not the executable name itself) properly
246 quoted and pasted together.  The list is matched in order, and the
247 first matching entry specifies how the processing will happen.")
248
249 (defun mswindows-construct-process-command-line (args)
250   ;;Properly quote process ARGS for executing (car ARGS).
251   ;;Called from the C code.
252   (let ((fname (car args))
253         (alist mswindows-construct-process-command-line-alist)
254         (case-fold-search t)
255         (return-me nil)
256         (assoc nil))
257     (while (and alist
258                 (null return-me))
259       (setq assoc (pop alist))
260       (if (if (stringp (car assoc))
261               (string-match (car assoc) fname)
262             (funcall (car assoc) fname))
263           (setq return-me (cdr assoc))))
264     (let* ((called-fun (or return-me
265                             #'mswindows-construct-vc-runtime-command-line))
266            (retval
267             (let ((str (funcall called-fun fname (cdr args)))
268                   (quoted-fname (mswindows-quote-one-simple-arg fname)))
269               (if (and str (> (length str) 0))
270                   (concat quoted-fname " " str)
271                 quoted-fname))))
272       (when debug-mswindows-process-command-lines
273         (debug-print "mswindows-construct-process-command-line called:\n")
274         (debug-print "received args: \n%s"
275                      (let ((n -1))
276                        (mapconcat #'(lambda (arg)
277                                       (incf n)
278                                       (format "  %d %s\n" n arg))
279                                   args
280                                   "")))
281         (debug-print "called fun %s\n" called-fun)
282         (debug-print "resulting command line: %s\n" retval))
283       retval)))
284
285 ;;; win32-native.el ends here