annotate lisp/win32-native.el @ 583:391cf801cb8d

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