annotate lisp/winnt.el @ 367:a4f53d9b3154 r21-1-13

Import from CVS: tag r21-1-13
author cvs
date Mon, 13 Aug 2007 11:01:07 +0200
parents 972bbb6d6ca2
children cc15677e0335
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 ;; Use ";" instead of ":" as a path separator (from files.el).
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
43 (setq path-separator ";")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
44
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
45 ;; Set the null device (for compile.el).
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
46 ;; #### There should be such a global thingy as null-device - kkm
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
47 (setq grep-null-device "NUL")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
48
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
49 ;; Set the grep regexp to match entries with drive letters.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
50 (setq grep-regexp-alist
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
51 '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
52
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
53 ;;----------------------------------------------------------------------
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
54 ;; Autosave hack
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
55 ;;--------------------
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
56
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
57 ;; Avoid creating auto-save file names containing invalid characters
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
58 ;; (primarily "*", eg. for the *mail* buffer).
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
59 ;; Avoid "doc lost for function" warning
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
60 (defun original-make-auto-save-file-name (&optional junk)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
61 "You do not want to call this."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
62 )
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
63 (fset 'original-make-auto-save-file-name
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
64 (symbol-function 'make-auto-save-file-name))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
65
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
66 (defun make-auto-save-file-name ()
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
67 "Return file name to use for auto-saves of current buffer.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
68 Does not consider `auto-save-visited-file-name' as that variable is checked
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
69 before calling this function. You can redefine this for customization.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
70 See also `auto-save-file-name-p'."
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
71 (let ((name (original-make-auto-save-file-name))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
72 (start 0))
367
a4f53d9b3154 Import from CVS: tag r21-1-13
cvs
parents: 363
diff changeset
73 ;; destructively replace occurrences of * or ? with $
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
74 (while (string-match "[?*]" name start)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
75 (aset name (match-beginning 0) ?$)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
76 (setq start (1+ (match-end 0))))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
77 name))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
78
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
79 ;;----------------------------------------------------------------------
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
80 ;; Quoting process args
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
81 ;;--------------------
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
82
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
83 (defun nt-quote-args-verbatim (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
84 "Copy ARG list verbatim, separating each arg with space."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
85 (mapconcat 'identity args " "))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
86
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
87 (defun nt-quote-args-prefix-quote (prefix args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
88 (mapconcat (lambda (str)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
89 (concat "\""
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
90 (mapconcat (lambda (ch)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
91 (concat (if (eq ch ?\") prefix)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
92 (char-to-string ch)))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
93 str nil)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
94 "\""))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
95 args " "))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
96
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
97 (defun nt-quote-args-backslash-quote (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
98 "Place ARG list in quotes, prefixing quotes in args with backslashes."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
99 (nt-quote-args-prefix-quote "\\" args))
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 (defun nt-quote-args-double-quote (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
102 "Place ARG list in quotes, doubling quotes in args."
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
103 (nt-quote-args-prefix-quote "\"" args))
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
104
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
105 (defvar nt-quote-args-functions-alist
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
106 '(("^.?.?sh\\." . nt-quote-args-double-quote))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
107 "An alist for determining proper argument quoting given executable file name.
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
108 Car of each cons must be a string, a regexp against which a file name sans
363
972bbb6d6ca2 Import from CVS: tag r21-1-11
cvs
parents: 355
diff changeset
109 directory is matched. Cdr is a function symbol. The list is matched in
972bbb6d6ca2 Import from CVS: tag r21-1-11
cvs
parents: 355
diff changeset
110 forward order, and matching entry cdr's function is called with a list of
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
111 strings, process arguments. It must return a string which is passed to
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
112 the newly created process.
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
113
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
114 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
115
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
116 (defun nt-quote-process-args (args)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
117 ;;Properly quote process ARGS for executing (car ARGS).
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
118 (let ((fname (file-name-nondirectory (car args)))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
119 (alist nt-quote-args-functions-alist)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
120 (case-fold-search nil)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
121 (return-me nil)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
122 (assoc nil))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
123 (while (and alist
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
124 (null return-me))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
125 (setq assoc (pop alist))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
126 (if (string-match (car assoc) fname)
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
127 (setq return-me (funcall (cdr assoc) (cdr args)))))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 265
diff changeset
128 (or return-me
288
e11d67e05968 Import from CVS: tag r21-0b42
cvs
parents: 286
diff changeset
129 (nt-quote-args-verbatim (cdr args)))))
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
130
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
131 ;;; winnt.el ends here