Mercurial > hg > xemacs-beta

comparison lisp/prim/winnt.el @ 118:7d55a9ba150c r20-1b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents
children 41ff10fd062f
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
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 ;; Show file type (text or binary) on modeline
48 (setq-default mode-line-format
49 (list (purecopy "")
50 'mode-line-modified
51 'mode-line-buffer-identification
52 (purecopy " ")
53 'global-mode-string
54 (purecopy " %[(")
55 (purecopy "%t:")
56 'mode-name 'mode-line-process 'minor-mode-alist
57 (purecopy "%n")
58 (purecopy ")%]--")
59 (purecopy '(line-number-mode "L%l--"))
60 (purecopy '(column-number-mode "C%c--"))
61 (purecopy '(-3 . "%p"))
62 (purecopy "-%-")))
63
64 ;; Ignore case on file-name completion
65 (setq completion-ignore-case t)
66
67 ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
68 ;; for executing its command line argument (from simple.el).
69 (setq shell-command-switch "/c")
70
71 ;; For appending suffixes to directories and files in shell completions.
72 (add-hook 'shell-mode-hook
73 '(lambda () (setq comint-completion-addsuffix '("\\" . " "))))
74
75 ;; Use ";" instead of ":" as a path separator (from files.el).
76 (setq path-separator ";")
77
78 ;; Set the null device (for compile.el).
79 (setq grep-null-device "NUL")
80
81 ;; Set the grep regexp to match entries with drive letters.
82 (setq grep-regexp-alist
83 '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
84
85 ;; Taken from dos-fn.el ... don't want all that's in the file, maybe
86 ;; separate it out someday.
87
88 (defvar file-name-buffer-file-type-alist
89 '(
90 ("[:/].*config.sys$" . nil) ; config.sys text
91 ("\\.elc$" . t) ; emacs stuff
92 ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
93 ; MS-Dos stuff
94 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
95 ; Packers
96 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
97 ; Unix stuff
98 ("\\.tp[ulpw]$" . t)
99 ; Borland Pascal stuff
100 )
101 "*Alist for distinguishing text files from binary files.
102 Each element has the form (REGEXP . TYPE), where REGEXP is matched
103 against the file name, and TYPE is nil for text, t for binary.")
104
105 (defun find-buffer-file-type (filename)
106 (let ((alist file-name-buffer-file-type-alist)
107 (found nil)
108 (code nil))
109 (let ((case-fold-search t))
110 (setq filename (file-name-sans-versions filename))
111 (while (and (not found) alist)
112 (if (string-match (car (car alist)) filename)
113 (setq code (cdr (car alist))
114 found t))
115 (setq alist (cdr alist))))
116 (if found
117 (cond((memq code '(nil t)) code)
118 ((and (symbolp code) (fboundp code))
119 (funcall code filename)))
120 default-buffer-file-type)))
121
122 (defun find-file-binary (filename)
123 "Visit file FILENAME and treat it as binary."
124 (interactive "FFind file binary: ")
125 (let ((file-name-buffer-file-type-alist '(("" . t))))
126 (find-file filename)))
127
128 (defun find-file-text (filename)
129 "Visit file FILENAME and treat it as a text file."
130 (interactive "FFind file text: ")
131 (let ((file-name-buffer-file-type-alist '(("" . nil))))
132 (find-file filename)))
133
134 (defun find-file-not-found-set-buffer-file-type ()
135 (save-excursion
136 (set-buffer (current-buffer))
137 (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
138 nil)
139
140 ;;; To set the default file type on new files.
141 (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
142
143 ;;; For using attached Unix filesystems.
144 (defun save-to-unix-hook ()
145 (save-excursion
146 (setq buffer-file-type t))
147 nil)
148
149 (defun revert-from-unix-hook ()
150 (save-excursion
151 (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
152 nil)
153
154 ;; Really should provide this capability at the drive letter granularity.
155 (defun using-unix-filesystems (flag)
156 "Read and write files without CR/LF translation, if FLAG is non-nil.
157 This is in effect assuming the files are on a remote Unix file system.
158 If FLAG is nil, resume using CR/LF translation as usual."
159 (if flag
160 (progn
161 (add-hook 'write-file-hooks 'save-to-unix-hook)
162 (add-hook 'after-save-hook 'revert-from-unix-hook))
163 (progn
164 (remove-hook 'write-file-hooks 'save-to-unix-hook)
165 (remove-hook 'after-save-hook 'revert-from-unix-hook))))
166
167 ;;; Avoid creating auto-save file names containing invalid characters
168 ;;; (primarily "*", eg. for the *mail* buffer).
169 (fset 'original-make-auto-save-file-name
170 (symbol-function 'make-auto-save-file-name))
171
172 (defun make-auto-save-file-name ()
173 "Return file name to use for auto-saves of current buffer.
174 Does not consider `auto-save-visited-file-name' as that variable is checked
175 before calling this function. You can redefine this for customization.
176 See also `auto-save-file-name-p'."
177 (let ((name (original-make-auto-save-file-name))
178 (start 0))
179 ;; destructively replace occurences of * or ? with $
180 (while (string-match "[?*]" name start)
181 (aset name (match-beginning 0) ?$)
182 (setq start (1+ (match-end 0))))
183 name))
184
185 ;; ### FIX ME: need to look at XEmacs xmouse.el versus FSF mouse.el
186 ;; and adjust accordingly: I think 'x-selections is an FSFism.
187 ;; --marcpa
188 ;;; Fix interface to (X-specific) mouse.el
189 (defun x-set-selection (type data)
190 (or type (setq type 'PRIMARY))
191 (put 'x-selections type data))
192
193 (defun x-get-selection (&optional type data-type)
194 (or type (setq type 'PRIMARY))
195 (get 'x-selections type))
196
197 ;; FSFisms
198 ;(fmakunbound 'font-menu-add-default)
199 ;(global-unset-key [C-down-mouse-1])
200 ;(global-unset-key [C-down-mouse-2])
201 ;(global-unset-key [C-down-mouse-3])
202
203 ;;; Set to a system sound if you want a fancy bell.
204 ;(set-message-beep nil)
205
206 ;;; winnt.el ends here