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