1 |
;;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms |
;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms |
2 |
|
|
3 |
;; Copyright (C) 1996 Free Software Foundation, Inc. |
;; Copyright (C) 1996 Free Software Foundation, Inc. |
4 |
|
|
52 |
; Packers |
; Packers |
53 |
("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\|jar\\)$" . t) |
("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\|jar\\)$" . t) |
54 |
; Unix stuff |
; Unix stuff |
55 |
("\\.tp[ulpw]$" . t) |
("\\.sx[dmicw]$" . t) ; OpenOffice.org |
56 |
; Borland Pascal stuff |
("\\.tp[ulpw]$" . t) ; borland Pascal stuff |
57 |
("[:/]tags$" . nil) |
("[:/]tags$" . nil) ; emacs TAGS file |
|
; Emacs TAGS file |
|
58 |
) |
) |
59 |
"*Alist for distinguishing text files from binary files. |
"*Alist for distinguishing text files from binary files. |
60 |
Each element has the form (REGEXP . TYPE), where REGEXP is matched |
Each element has the form (REGEXP . TYPE), where REGEXP is matched |
123 |
(target) |
(target) |
124 |
(binary nil) (text nil) |
(binary nil) (text nil) |
125 |
(undecided nil) (undecided-unix nil)) |
(undecided nil) (undecided-unix nil)) |
126 |
(cond ((eq op 'insert-file-contents) |
(cond ((eq op 'insert-file-contents) |
127 |
(setq target (nth 1 command)) |
(setq target (nth 1 command)) |
128 |
;; First check for a file name that indicates |
;; First check for a file name that indicates |
129 |
;; it is truly binary. |
;; it is truly binary. |
157 |
|
|
158 |
(modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system) |
(modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system) |
159 |
|
|
160 |
(defun find-file-binary (filename) |
(defun find-file-binary (filename) |
161 |
"Visit file FILENAME and treat it as binary." |
"Visit file FILENAME and treat it as binary." |
162 |
(interactive "FFind file binary: ") |
(interactive "FFind file binary: ") |
163 |
(let ((file-name-buffer-file-type-alist '(("" . t)))) |
(let ((file-name-buffer-file-type-alist '(("" . t)))) |
164 |
(find-file filename))) |
(find-file filename))) |
165 |
|
|
166 |
(defun find-file-text (filename) |
(defun find-file-text (filename) |
167 |
"Visit file FILENAME and treat it as a text file." |
"Visit file FILENAME and treat it as a text file." |
168 |
(interactive "FFind file text: ") |
(interactive "FFind file text: ") |
169 |
(let ((file-name-buffer-file-type-alist '(("" . nil)))) |
(let ((file-name-buffer-file-type-alist '(("" . nil)))) |
185 |
(setq buffer-file-type (eq buffer-file-coding-system 'no-conversion))))) |
(setq buffer-file-type (eq buffer-file-coding-system 'no-conversion))))) |
186 |
|
|
187 |
;;; To set the default coding system on new files. |
;;; To set the default coding system on new files. |
188 |
(add-hook 'find-file-not-found-hooks |
(add-hook 'find-file-not-found-hooks |
189 |
'find-file-not-found-set-buffer-file-coding-system) |
'find-file-not-found-set-buffer-file-coding-system) |
190 |
|
|
191 |
;;; To accomodate filesystems that do not require CR/LF translation. |
;;; To accomodate filesystems that do not require CR/LF translation. |
192 |
(defvar untranslated-filesystem-list nil |
(defvar untranslated-filesystem-list nil |
193 |
"List of filesystems that require no CR/LF translation when reading |
"List of filesystems that require no CR/LF translation when reading |
194 |
and writing files. Each filesystem in the list is a string naming |
and writing files. Each filesystem in the list is a string naming |
195 |
the directory prefix corresponding to the filesystem.") |
the directory prefix corresponding to the filesystem.") |
196 |
|
|
197 |
(defun untranslated-canonical-name (filename) |
(defun untranslated-canonical-name (filename) |
198 |
"Return FILENAME in a canonicalized form for use with the functions |
"Return FILENAME in a canonicalized form for use with the functions |
199 |
dealing with untranslated filesystems." |
dealing with untranslated filesystems." |
200 |
(if (memq system-type '(ms-dos windows-nt)) |
(if (memq system-type '(ms-dos windows-nt cygwin)) |
201 |
;; The canonical form for DOS/W32 is with A-Z downcased and all |
;; The canonical form for DOS/W32 is with A-Z downcased and all |
202 |
;; directory separators changed to directory-sep-char. |
;; directory separators changed to directory-sep-char. |
203 |
(let ((name nil)) |
(let ((name nil)) |
204 |
(setq name (mapconcat |
(setq name (mapconcat |
205 |
'(lambda (char) |
'(lambda (char) |
206 |
(if (and (<= ?A char) (<= char ?Z)) |
(if (and (<= ?A char) (<= char ?Z)) |
207 |
(char-to-string (+ (- char ?A) ?a)) |
(char-to-string (+ (- char ?A) ?a)) |
208 |
(char-to-string char))) |
(char-to-string char))) |
218 |
filename)) |
filename)) |
219 |
|
|
220 |
(defun untranslated-file-p (filename) |
(defun untranslated-file-p (filename) |
221 |
"Return t if FILENAME is on a filesystem that does not require |
"Return t if FILENAME is on a filesystem that does not require |
222 |
CR/LF translation, and nil otherwise." |
CR/LF translation, and nil otherwise." |
223 |
(let ((fs (untranslated-canonical-name filename)) |
(let ((fs (untranslated-canonical-name filename)) |
224 |
(ufs-list untranslated-filesystem-list) |
(ufs-list untranslated-filesystem-list) |
232 |
(defun add-untranslated-filesystem (filesystem) |
(defun add-untranslated-filesystem (filesystem) |
233 |
"Add FILESYSTEM to the list of filesystems that do not require |
"Add FILESYSTEM to the list of filesystems that do not require |
234 |
CR/LF translation. FILESYSTEM is a string containing the directory |
CR/LF translation. FILESYSTEM is a string containing the directory |
235 |
prefix corresponding to the filesystem. For example, for a Unix |
prefix corresponding to the filesystem. For example, for a Unix |
236 |
filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." |
filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." |
237 |
;; We use "D", not "f", to avoid confusing the user: "f" prompts |
;; We use "D", not "f", to avoid confusing the user: "f" prompts |
238 |
;; with a directory, but RET returns the current buffer's file, not |
;; with a directory, but RET returns the current buffer's file, not |
245 |
(cons fs untranslated-filesystem-list))))) |
(cons fs untranslated-filesystem-list))))) |
246 |
|
|
247 |
(defun remove-untranslated-filesystem (filesystem) |
(defun remove-untranslated-filesystem (filesystem) |
248 |
"Remove FILESYSTEM from the list of filesystems that do not require |
"Remove FILESYSTEM from the list of filesystems that do not require |
249 |
CR/LF translation. FILESYSTEM is a string containing the directory |
CR/LF translation. FILESYSTEM is a string containing the directory |
250 |
prefix corresponding to the filesystem. For example, for a Unix |
prefix corresponding to the filesystem. For example, for a Unix |
251 |
filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." |
filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." |
252 |
(interactive "fUntranslated file system: ") |
(interactive "fUntranslated file system: ") |
253 |
(setq untranslated-filesystem-list |
(setq untranslated-filesystem-list |
254 |
(delete (untranslated-canonical-name filesystem) |
(delete (untranslated-canonical-name filesystem) |
255 |
untranslated-filesystem-list))) |
untranslated-filesystem-list))) |
256 |
|
|