annotate lisp/winnt.el @ 290:c9fe270a4101 r21-0b43

Import from CVS: tag r21-0b43
author cvs
date Mon, 13 Aug 2007 10:36:47 +0200
parents e11d67e05968
children 182f72e8cd0d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
1 ;;; winnt.el --- Lisp routines for Windows NT.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
2
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
4
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
5 ;; Maintainer: XEmacs Development Team
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
6 ;; Keywords: mouse, dumped
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
7
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
8 ;; This file is part of XEmacs.
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
9
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
11 ;; under the terms of the GNU General Public License as published by
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
13 ;; any later version.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
14
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
18 ;; General Public License for more details.
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
19
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
24
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
25 ;;; Synched up with: Not synched with FSF. Almost completely divergent.
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
26
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
27 ;;; Commentary:
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
28
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
29 ;; This file is dumped with XEmacs for MS Windows (without cygwin).
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
30
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
31 ;; Based on NT Emacs version by Geoff Voelker (voelker@cs.washington.edu)
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
32 ;; Ported to XEmacs by Marc Paquette <marcpa@cam.org>
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
33 ;; Largely modified by Kirill M. Katsnelson <kkm@kis.ru>
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
34
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
35 ;;; Code:
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
36
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
37 ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
38 ;; for executing its command line argument (from simple.el).
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
39 ;; #### Oh if we had an alist of shells and their command switches.
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
40 (setq shell-command-switch "/c")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
41
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
42 ;; For appending suffixes to directories and files in shell completions.
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
43 (defun nt-shell-mode-hook ()
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
44 (setq comint-completion-addsuffix '("\\" . " ")
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
45 comint-process-echoes t))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
46 (add-hook 'shell-mode-hook 'nt-shell-mode-hook)
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
47
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
48 ;; Use ";" instead of ":" as a path separator (from files.el).
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
49 (setq path-separator ";")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
50
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
51 ;; Set the null device (for compile.el).
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
52 ;; #### There should be such a global thingy as null-device - kkm
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
53 (setq grep-null-device "NUL")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
54
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
55 ;; Set the grep regexp to match entries with drive letters.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
56 (setq grep-regexp-alist
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
57 '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
58
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
59 ;;----------------------------------------------------------------------
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
60 ;; Autosave hack
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
61 ;;--------------------
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
62
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
63 ;; Avoid creating auto-save file names containing invalid characters
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
64 ;; (primarily "*", eg. for the *mail* buffer).
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
65 ;; Avoid "doc lost for function" warning
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
66 (defun original-make-auto-save-file-name (&optional junk)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
67 "You do not want to call this."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
68 )
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
69 (fset 'original-make-auto-save-file-name
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
70 (symbol-function 'make-auto-save-file-name))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
71
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
72 (defun make-auto-save-file-name ()
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
73 "Return file name to use for auto-saves of current buffer.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
74 Does not consider `auto-save-visited-file-name' as that variable is checked
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
75 before calling this function. You can redefine this for customization.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
76 See also `auto-save-file-name-p'."
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
77 (let ((name (original-make-auto-save-file-name))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
78 (start 0))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
79 ;; destructively replace occurences of * or ? with $
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
80 (while (string-match "[?*]" name start)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
81 (aset name (match-beginning 0) ?$)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
82 (setq start (1+ (match-end 0))))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
83 name))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
84
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
85 ;;----------------------------------------------------------------------
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
86 ;; Quoting process args
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
87 ;;--------------------
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
88
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
89 (defun nt-quote-args-verbatim (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
90 "Copy ARG list verbatim, separating each arg with space."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
91 (mapconcat 'identity args " "))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
92
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
93 (defun nt-quote-args-prefix-quote (prefix args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
94 (mapconcat (lambda (str)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
95 (concat "\""
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
96 (mapconcat (lambda (ch)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
97 (concat (if (eq ch ?\") prefix)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
98 (char-to-string ch)))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
99 str nil)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
100 "\""))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
101 args " "))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
102
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
103 (defun nt-quote-args-backslash-quote (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
104 "Place ARG list in quotes, prefixing quotes in args with backslashes."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
105 (nt-quote-args-prefix-quote "\\" args))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
106
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
107 (defun nt-quote-args-double-quote (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
108 "Place ARG list in quotes, doubling quotes in args."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
109 (nt-quote-args-prefix-quote "\"" args))
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
110
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
111 (defvar nt-quote-args-functions-alist
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
112 '(("^.?.?sh\\." . nt-quote-args-double-quote))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
113 "An alist for determining proper argument quoting given executable file name.
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
114 Car of each cons must be a string, a regexp against which a file name sans
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
115 directory is matched. Cdr is a function symbol. The list is mathced in
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
116 forward order, and mathcing entry cdr's funcrion is called with a list of
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
117 strings, process arguments. It must return a string which is passed to
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
118 the newly created process.
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
119
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
120 If not found, then `nt-quote-args-verbatim' is called on the argument list.")
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
121
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
122 (defun nt-quote-process-args (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
123 ;;Properly quote process ARGS for executing (car ARGS).
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
124 (let ((fname (file-name-nondirectory (car args)))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
125 (alist nt-quote-args-functions-alist)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
126 (case-fold-search nil)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
127 (return-me nil)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
128 (assoc nil))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
129 (while (and alist
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
130 (null return-me))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
131 (setq assoc (pop alist))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
132 (if (string-match (car assoc) fname)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
133 (setq return-me (funcall (cdr assoc) (cdr args)))))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
134 (or return-me
288
e11d67e05968 Import from CVS: tag r21-0b42
cvs
parents: 286
diff changeset
135 (nt-quote-args-verbatim (cdr args)))))
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
136
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
137 ;;; winnt.el ends here