Mercurial > emacs
comparison lisp/dos-w32.el @ 46188:7864bcf48126
(file-name-buffer-file-type-alist): Add knowledge of .sx[dmicw] file
suffixes for Open office data files.
author | Francesco Potortì <pot@gnu.org> |
---|---|
date | Fri, 05 Jul 2002 23:15:06 +0000 |
parents | 183d350bb9d2 |
children | 7fb1d661f610 |
comparison
equal
deleted
inserted
replaced
46187:99d6a42ded52 | 46188:7864bcf48126 |
---|---|
1 ;;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms | 1 ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms |
2 | 2 |
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1996 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Maintainer: Geoff Voelker <voelker@cs.washington.edu> | 5 ;; Maintainer: Geoff Voelker <voelker@cs.washington.edu> |
6 ;; Keywords: internal | 6 ;; Keywords: internal |
50 ; known binary data files | 50 ; known binary data files |
51 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t) | 51 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t) |
52 ; Packers | 52 ; Packers |
53 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\|jar\\)$" . t) | 53 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\|jar\\)$" . t) |
54 ; Unix stuff | 54 ; Unix stuff |
55 ("\\.tp[ulpw]$" . t) | 55 ("\\.sx[dmicw]$" . t) ; Open office |
56 ; Borland Pascal stuff | 56 ("\\.tp[ulpw]$" . t) ; borland Pascal stuff |
57 ("[:/]tags$" . nil) | 57 ("[:/]tags$" . nil) ; emacs TAGS file |
58 ; Emacs TAGS file | |
59 ) | 58 ) |
60 "*Alist for distinguishing text files from binary files. | 59 "*Alist for distinguishing text files from binary files. |
61 Each element has the form (REGEXP . TYPE), where REGEXP is matched | 60 Each element has the form (REGEXP . TYPE), where REGEXP is matched |
62 against the file name, and TYPE is nil for text, t for binary.") | 61 against the file name, and TYPE is nil for text, t for binary.") |
63 | 62 |
122 | 121 |
123 (let ((op (nth 0 command)) | 122 (let ((op (nth 0 command)) |
124 (target) | 123 (target) |
125 (binary nil) (text nil) | 124 (binary nil) (text nil) |
126 (undecided nil) (undecided-unix nil)) | 125 (undecided nil) (undecided-unix nil)) |
127 (cond ((eq op 'insert-file-contents) | 126 (cond ((eq op 'insert-file-contents) |
128 (setq target (nth 1 command)) | 127 (setq target (nth 1 command)) |
129 ;; First check for a file name that indicates | 128 ;; First check for a file name that indicates |
130 ;; it is truly binary. | 129 ;; it is truly binary. |
131 (setq binary (find-buffer-file-type target)) | 130 (setq binary (find-buffer-file-type target)) |
132 (cond (binary) | 131 (cond (binary) |
156 '(no-conversion . no-conversion) | 155 '(no-conversion . no-conversion) |
157 '(undecided-dos . undecided-dos))))))) | 156 '(undecided-dos . undecided-dos))))))) |
158 | 157 |
159 (modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system) | 158 (modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system) |
160 | 159 |
161 (defun find-file-binary (filename) | 160 (defun find-file-binary (filename) |
162 "Visit file FILENAME and treat it as binary." | 161 "Visit file FILENAME and treat it as binary." |
163 (interactive "FFind file binary: ") | 162 (interactive "FFind file binary: ") |
164 (let ((file-name-buffer-file-type-alist '(("" . t)))) | 163 (let ((file-name-buffer-file-type-alist '(("" . t)))) |
165 (find-file filename))) | 164 (find-file filename))) |
166 | 165 |
167 (defun find-file-text (filename) | 166 (defun find-file-text (filename) |
168 "Visit file FILENAME and treat it as a text file." | 167 "Visit file FILENAME and treat it as a text file." |
169 (interactive "FFind file text: ") | 168 (interactive "FFind file text: ") |
170 (let ((file-name-buffer-file-type-alist '(("" . nil)))) | 169 (let ((file-name-buffer-file-type-alist '(("" . nil)))) |
171 (find-file filename))) | 170 (find-file filename))) |
172 | 171 |
184 (setq coding (coding-system-change-eol-conversion coding 0)) | 183 (setq coding (coding-system-change-eol-conversion coding 0)) |
185 (setq buffer-file-coding-system coding)) | 184 (setq buffer-file-coding-system coding)) |
186 (setq buffer-file-type (eq buffer-file-coding-system 'no-conversion))))) | 185 (setq buffer-file-type (eq buffer-file-coding-system 'no-conversion))))) |
187 | 186 |
188 ;;; To set the default coding system on new files. | 187 ;;; To set the default coding system on new files. |
189 (add-hook 'find-file-not-found-hooks | 188 (add-hook 'find-file-not-found-hooks |
190 'find-file-not-found-set-buffer-file-coding-system) | 189 'find-file-not-found-set-buffer-file-coding-system) |
191 | 190 |
192 ;;; To accomodate filesystems that do not require CR/LF translation. | 191 ;;; To accomodate filesystems that do not require CR/LF translation. |
193 (defvar untranslated-filesystem-list nil | 192 (defvar untranslated-filesystem-list nil |
194 "List of filesystems that require no CR/LF translation when reading | 193 "List of filesystems that require no CR/LF translation when reading |
195 and writing files. Each filesystem in the list is a string naming | 194 and writing files. Each filesystem in the list is a string naming |
196 the directory prefix corresponding to the filesystem.") | 195 the directory prefix corresponding to the filesystem.") |
197 | 196 |
198 (defun untranslated-canonical-name (filename) | 197 (defun untranslated-canonical-name (filename) |
199 "Return FILENAME in a canonicalized form for use with the functions | 198 "Return FILENAME in a canonicalized form for use with the functions |
200 dealing with untranslated filesystems." | 199 dealing with untranslated filesystems." |
201 (if (memq system-type '(ms-dos windows-nt)) | 200 (if (memq system-type '(ms-dos windows-nt)) |
202 ;; The canonical form for DOS/W32 is with A-Z downcased and all | 201 ;; The canonical form for DOS/W32 is with A-Z downcased and all |
203 ;; directory separators changed to directory-sep-char. | 202 ;; directory separators changed to directory-sep-char. |
204 (let ((name nil)) | 203 (let ((name nil)) |
205 (setq name (mapconcat | 204 (setq name (mapconcat |
206 '(lambda (char) | 205 '(lambda (char) |
207 (if (and (<= ?A char) (<= char ?Z)) | 206 (if (and (<= ?A char) (<= char ?Z)) |
208 (char-to-string (+ (- char ?A) ?a)) | 207 (char-to-string (+ (- char ?A) ?a)) |
209 (char-to-string char))) | 208 (char-to-string char))) |
210 filename nil)) | 209 filename nil)) |
211 ;; Use expand-file-name to canonicalize directory separators, except | 210 ;; Use expand-file-name to canonicalize directory separators, except |
217 name | 216 name |
218 (expand-file-name name))) | 217 (expand-file-name name))) |
219 filename)) | 218 filename)) |
220 | 219 |
221 (defun untranslated-file-p (filename) | 220 (defun untranslated-file-p (filename) |
222 "Return t if FILENAME is on a filesystem that does not require | 221 "Return t if FILENAME is on a filesystem that does not require |
223 CR/LF translation, and nil otherwise." | 222 CR/LF translation, and nil otherwise." |
224 (let ((fs (untranslated-canonical-name filename)) | 223 (let ((fs (untranslated-canonical-name filename)) |
225 (ufs-list untranslated-filesystem-list) | 224 (ufs-list untranslated-filesystem-list) |
226 (found nil)) | 225 (found nil)) |
227 (while (and (not found) ufs-list) | 226 (while (and (not found) ufs-list) |
231 found)) | 230 found)) |
232 | 231 |
233 (defun add-untranslated-filesystem (filesystem) | 232 (defun add-untranslated-filesystem (filesystem) |
234 "Add FILESYSTEM to the list of filesystems that do not require | 233 "Add FILESYSTEM to the list of filesystems that do not require |
235 CR/LF translation. FILESYSTEM is a string containing the directory | 234 CR/LF translation. FILESYSTEM is a string containing the directory |
236 prefix corresponding to the filesystem. For example, for a Unix | 235 prefix corresponding to the filesystem. For example, for a Unix |
237 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." | 236 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." |
238 ;; We use "D", not "f", to avoid confusing the user: "f" prompts | 237 ;; We use "D", not "f", to avoid confusing the user: "f" prompts |
239 ;; with a directory, but RET returns the current buffer's file, not | 238 ;; with a directory, but RET returns the current buffer's file, not |
240 ;; its directory. | 239 ;; its directory. |
241 (interactive "DUntranslated file system: ") | 240 (interactive "DUntranslated file system: ") |
244 untranslated-filesystem-list | 243 untranslated-filesystem-list |
245 (setq untranslated-filesystem-list | 244 (setq untranslated-filesystem-list |
246 (cons fs untranslated-filesystem-list))))) | 245 (cons fs untranslated-filesystem-list))))) |
247 | 246 |
248 (defun remove-untranslated-filesystem (filesystem) | 247 (defun remove-untranslated-filesystem (filesystem) |
249 "Remove FILESYSTEM from the list of filesystems that do not require | 248 "Remove FILESYSTEM from the list of filesystems that do not require |
250 CR/LF translation. FILESYSTEM is a string containing the directory | 249 CR/LF translation. FILESYSTEM is a string containing the directory |
251 prefix corresponding to the filesystem. For example, for a Unix | 250 prefix corresponding to the filesystem. For example, for a Unix |
252 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." | 251 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." |
253 (interactive "fUntranslated file system: ") | 252 (interactive "fUntranslated file system: ") |
254 (setq untranslated-filesystem-list | 253 (setq untranslated-filesystem-list |
255 (delete (untranslated-canonical-name filesystem) | 254 (delete (untranslated-canonical-name filesystem) |
256 untranslated-filesystem-list))) | 255 untranslated-filesystem-list))) |
257 | 256 |
258 ;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el. | 257 ;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el. |
259 | 258 |