Mercurial > hg > xemacs-beta

comparison lisp/winnt.el @ 217:d44af0c54775 r20-4b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b7
author cvs
date Mon, 13 Aug 2007 10:08:34 +0200
parents
children 8efd647ea9ca
comparison
equal deleted inserted replaced
216:43306a74e31c 217:d44af0c54775
1 ;;; winnt.el --- Lisp routines for Windows NT.
2
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
4
5 ;; Author: Geoff Voelker (voelker@cs.washington.edu)
6
7 ;; This file is part of GNU Emacs.
8
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Commentary:
25
26 ;; (August 12, 1993)
27 ;; Created.
28
29 ;; (November 21, 1994)
30 ;; [C-M-backspace] defined.
31 ;; mode-line-format defined to show buffer file type.
32 ;; audio bell initialized.
33 ;;
34 ;; (March 18, 1997)
35 ;; Ported to XEmacs by Marc Paquette <marcpa@cam.org>
36 ;;
37
38 ;;; Code:
39
40 ;; Map delete and backspace
41 ;; Not sure this is really needed in XEmacs... --marcpa
42 (define-key global-map [(backspace)] 'backward-delete-char)
43 (define-key global-map [(delete)] 'delete-char)
44 (define-key global-map [(meta backspace)] 'backward-kill-word)
45 (define-key global-map [(control meta backspace)] 'backward-kill-sexp)
46
47 (defconst nt-modeline-buffer-type '("%t")
48 "Modeline control for showing buffer type (binary or text).")
49
50 (setq-default modeline-format
51 (cons (purecopy "")
52 (cons 'nt-modeline-buffer-type
53 (cdr modeline-format))))
54
55 ;; Ignore case on file-name completion
56 (setq completion-ignore-case t)
57
58 ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
59 ;; for executing its command line argument (from simple.el).
60 (setq shell-command-switch "/c")
61
62 ;; For appending suffixes to directories and files in shell completions.
63 (add-hook 'shell-mode-hook
64 '(lambda () (setq comint-completion-addsuffix '("\\" . " "))))
65
66 ;; Use ";" instead of ":" as a path separator (from files.el).
67 (setq path-separator ";")
68
69 ;; Set the null device (for compile.el).
70 (setq grep-null-device "NUL")
71
72 ;; Set the grep regexp to match entries with drive letters.
73 (setq grep-regexp-alist
74 '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
75
76 ;; Taken from dos-fn.el ... don't want all that's in the file, maybe
77 ;; separate it out someday.
78
79 (defvar file-name-buffer-file-type-alist
80 '(
81 ("[:/].*config.sys$" . nil) ; config.sys text
82 ("\\.elc$" . t) ; emacs stuff
83 ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
84 ; MS-Dos stuff
85 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
86 ; Packers
87 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
88 ; Unix stuff
89 ("\\.tp[ulpw]$" . t)
90 ; Borland Pascal stuff
91 )
92 "*Alist for distinguishing text files from binary files.
93 Each element has the form (REGEXP . TYPE), where REGEXP is matched
94 against the file name, and TYPE is nil for text, t for binary.")
95
96 (defun find-buffer-file-type (filename)
97 (let ((alist file-name-buffer-file-type-alist)
98 (found nil)
99 (code nil))
100 (let ((case-fold-search t))
101 (setq filename (file-name-sans-versions filename))
102 (while (and (not found) alist)
103 (if (string-match (car (car alist)) filename)
104 (setq code (cdr (car alist))
105 found t))
106 (setq alist (cdr alist))))
107 (if found
108 (cond((memq code '(nil t)) code)
109 ((and (symbolp code) (fboundp code))
110 (funcall code filename)))
111 default-buffer-file-type)))
112
113 (defun find-file-binary (filename)
114 "Visit file FILENAME and treat it as binary."
115 (interactive "FFind file binary: ")
116 (let ((file-name-buffer-file-type-alist '(("" . t))))
117 (find-file filename)))
118
119 (defun find-file-text (filename)
120 "Visit file FILENAME and treat it as a text file."
121 (interactive "FFind file text: ")
122 (let ((file-name-buffer-file-type-alist '(("" . nil))))
123 (find-file filename)))
124
125 (defun find-file-not-found-set-buffer-file-type ()
126 (save-excursion
127 (set-buffer (current-buffer))
128 (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
129 nil)
130
131 ;;; To set the default file type on new files.
132 (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
133
134 ;;; For using attached Unix filesystems.
135 (defun save-to-unix-hook ()
136 (save-excursion
137 (setq buffer-file-type t))
138 nil)
139
140 (defun revert-from-unix-hook ()
141 (save-excursion
142 (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
143 nil)
144
145 ;; Really should provide this capability at the drive letter granularity.
146 (defun using-unix-filesystems (flag)
147 "Read and write files without CR/LF translation, if FLAG is non-nil.
148 This is in effect assuming the files are on a remote Unix file system.
149 If FLAG is nil, resume using CR/LF translation as usual."
150 (if flag
151 (progn
152 (add-hook 'write-file-hooks 'save-to-unix-hook)
153 (add-hook 'after-save-hook 'revert-from-unix-hook))
154 (progn
155 (remove-hook 'write-file-hooks 'save-to-unix-hook)
156 (remove-hook 'after-save-hook 'revert-from-unix-hook))))
157
158 ;;; Avoid creating auto-save file names containing invalid characters
159 ;;; (primarily "*", eg. for the *mail* buffer).
160 (fset 'original-make-auto-save-file-name
161 (symbol-function 'make-auto-save-file-name))
162
163 (defun make-auto-save-file-name ()
164 "Return file name to use for auto-saves of current buffer.
165 Does not consider `auto-save-visited-file-name' as that variable is checked
166 before calling this function. You can redefine this for customization.
167 See also `auto-save-file-name-p'."
168 (let ((name (original-make-auto-save-file-name))
169 (start 0))
170 ;; destructively replace occurences of * or ? with $
171 (while (string-match "[?*]" name start)
172 (aset name (match-beginning 0) ?$)
173 (setq start (1+ (match-end 0))))
174 name))
175
176 ;; ### FIX ME: need to look at XEmacs xmouse.el versus FSF mouse.el
177 ;; and adjust accordingly: I think 'x-selections is an FSFism.
178 ;; --marcpa
179 ;;; Fix interface to (X-specific) mouse.el
180 (defun x-set-selection (type data)
181 (or type (setq type 'PRIMARY))
182 (put 'x-selections type data))
183
184 (defun x-get-selection (&optional type data-type)
185 (or type (setq type 'PRIMARY))
186 (get 'x-selections type))
187
188 ;; FSFisms
189 ;(fmakunbound 'font-menu-add-default)
190 ;(global-unset-key [C-down-mouse-1])
191 ;(global-unset-key [C-down-mouse-2])
192 ;(global-unset-key [C-down-mouse-3])
193
194 ;;; Set to a system sound if you want a fancy bell.
195 ;(set-message-beep nil)
196
197 ;;; winnt.el ends here