|
15254
|
1 ;;; dos-win32.el --- Functions shared among MS-DOS and Win32 (NT/95) platforms
|
|
|
2
|
|
|
3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Maintainer: Geoff Voelker (voelker@cs.washington.edu)
|
|
|
6 ;; Keywords: internal
|
|
|
7
|
|
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;; GNU General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
|
27 ;; Parts of this code are duplicated functions taken from dos-fns.el
|
|
|
28 ;; and winnt.el.
|
|
|
29
|
|
|
30 ;;; Code:
|
|
|
31
|
|
|
32 ;;; Add %t: into the mode line format just after the open-paren.
|
|
|
33 (let ((tail (member " %[(" mode-line-format)))
|
|
|
34 (setcdr tail (cons (purecopy "%t:")
|
|
|
35 (cdr tail))))
|
|
|
36
|
|
|
37 ;; Use ";" instead of ":" as a path separator (from files.el).
|
|
|
38 (setq path-separator ";")
|
|
|
39
|
|
|
40 ;; Set the null device (for compile.el).
|
|
|
41 (setq grep-null-device "NUL")
|
|
|
42
|
|
|
43 ;; Set the grep regexp to match entries with drive letters.
|
|
|
44 (setq grep-regexp-alist
|
|
|
45 '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
|
|
|
46
|
|
|
47 ;; For distinguishing file types based upon suffixes.
|
|
|
48 (defvar file-name-buffer-file-type-alist
|
|
|
49 '(
|
|
|
50 ("[:/].*config.sys$" . nil) ; config.sys text
|
|
|
51 ("\\.elc$" . t) ; emacs stuff
|
|
|
52 ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
|
|
|
53 ; MS-Dos stuff
|
|
|
54 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
|
|
|
55 ; Packers
|
|
|
56 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
|
|
|
57 ; Unix stuff
|
|
|
58 ("\\.tp[ulpw]$" . t)
|
|
|
59 ; Borland Pascal stuff
|
|
|
60 ("[:/]tags$" . t)
|
|
|
61 ; Emacs TAGS file
|
|
|
62 )
|
|
|
63 "*Alist for distinguishing text files from binary files.
|
|
|
64 Each element has the form (REGEXP . TYPE), where REGEXP is matched
|
|
|
65 against the file name, and TYPE is nil for text, t for binary.")
|
|
|
66
|
|
|
67 (defun find-buffer-file-type (filename)
|
|
|
68 ;; First check if file is on an untranslated filesystem, then on the alist.
|
|
|
69 (if (untranslated-file-p filename)
|
|
|
70 t ; for binary
|
|
|
71 (let ((alist file-name-buffer-file-type-alist)
|
|
|
72 (found nil)
|
|
|
73 (code nil))
|
|
|
74 (let ((case-fold-search t))
|
|
|
75 (setq filename (file-name-sans-versions filename))
|
|
|
76 (while (and (not found) alist)
|
|
|
77 (if (string-match (car (car alist)) filename)
|
|
|
78 (setq code (cdr (car alist))
|
|
|
79 found t))
|
|
|
80 (setq alist (cdr alist))))
|
|
|
81 (if found
|
|
|
82 (cond ((memq code '(nil t)) code)
|
|
|
83 ((and (symbolp code) (fboundp code))
|
|
|
84 (funcall code filename)))
|
|
|
85 default-buffer-file-type))))
|
|
|
86
|
|
|
87 (defun find-file-binary (filename)
|
|
|
88 "Visit file FILENAME and treat it as binary."
|
|
|
89 (interactive "FFind file binary: ")
|
|
|
90 (let ((file-name-buffer-file-type-alist '(("" . t))))
|
|
|
91 (find-file filename)))
|
|
|
92
|
|
|
93 (defun find-file-text (filename)
|
|
|
94 "Visit file FILENAME and treat it as a text file."
|
|
|
95 (interactive "FFind file text: ")
|
|
|
96 (let ((file-name-buffer-file-type-alist '(("" . nil))))
|
|
|
97 (find-file filename)))
|
|
|
98
|
|
|
99 (defun find-file-not-found-set-buffer-file-type ()
|
|
|
100 (save-excursion
|
|
|
101 (set-buffer (current-buffer))
|
|
|
102 (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
|
|
|
103 nil)
|
|
|
104
|
|
|
105 ;;; To set the default file type on new files.
|
|
|
106 (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
|
|
|
107
|
|
|
108
|
|
|
109 ;;; To accomodate filesystems that do not require CR/LF translation.
|
|
|
110 (defvar untranslated-filesystem-list nil
|
|
|
111 "List of filesystems that require no CR/LF translation during file I/O.
|
|
|
112 Each element in the list is a string naming the directory prefix
|
|
|
113 corresponding to the filesystem.")
|
|
|
114
|
|
|
115 (defun untranslated-canonical-name (filename)
|
|
|
116 "Return FILENAME in a canonicalized form.
|
|
|
117 This is for use with the functions dealing with untranslated filesystems."
|
|
|
118 (if (memq system-type '(ms-dos windows-nt))
|
|
|
119 ;; The canonical form for DOS/NT/Win95 is with A-Z downcased and all
|
|
|
120 ;; directory separators changed to directory-sep-char.
|
|
|
121 (let ((name nil))
|
|
|
122 (setq name (mapconcat
|
|
|
123 '(lambda (char)
|
|
|
124 (if (and (<= ?A char) (<= char ?Z))
|
|
|
125 (char-to-string (+ (- char ?A) ?a))
|
|
|
126 (char-to-string char)))
|
|
|
127 filename nil))
|
|
|
128 ;; Use expand-file-name to canonicalize directory separators, except
|
|
|
129 ;; with bare drive letters (which would have the cwd appended).
|
|
|
130 (if (string-match "^.:$" name)
|
|
|
131 name
|
|
|
132 (expand-file-name name)))
|
|
|
133 filename))
|
|
|
134
|
|
|
135 (defun untranslated-file-p (filename)
|
|
|
136 "Test whether CR/LF translation should be disabled for FILENAME.
|
|
|
137 Return t if FILENAME is on a filesystem that does not require
|
|
|
138 CR/LF translation, and nil otherwise."
|
|
|
139 (let ((fs (untranslated-canonical-name filename))
|
|
|
140 (ufs-list untranslated-filesystem-list)
|
|
|
141 (found nil))
|
|
|
142 (while (and (not found) ufs-list)
|
|
|
143 (if (string-match (concat "^" (regexp-quote (car ufs-list))) fs)
|
|
|
144 (setq found t)
|
|
|
145 (setq ufs-list (cdr ufs-list))))
|
|
|
146 found))
|
|
|
147
|
|
|
148 (defun add-untranslated-filesystem (filesystem)
|
|
|
149 "Record that FILESYSTEM does not require CR/LF translation.
|
|
|
150 FILESYSTEM is a string containing the directory prefix corresponding to
|
|
|
151 the filesystem. For example, for a Unix filesystem mounted on drive Z:,
|
|
|
152 FILESYSTEM could be \"Z:\"."
|
|
|
153 (let ((fs (untranslated-canonical-name filesystem)))
|
|
|
154 (if (member fs untranslated-filesystem-list)
|
|
|
155 untranslated-filesystem-list
|
|
|
156 (setq untranslated-filesystem-list
|
|
|
157 (cons fs untranslated-filesystem-list)))))
|
|
|
158
|
|
|
159 (defun remove-untranslated-filesystem (filesystem)
|
|
|
160 "Record that FILESYSTEM requires CR/LF translation.
|
|
|
161 FILESYSTEM is a string containing the directory prefix corresponding to
|
|
|
162 the filesystem. For example, for a Unix filesystem mounted on drive Z:,
|
|
|
163 FILESYSTEM could be \"Z:\"."
|
|
|
164 (setq untranslated-filesystem-list
|
|
|
165 (delete (untranslated-canonical-name filesystem)
|
|
|
166 untranslated-filesystem-list)))
|
|
|
167
|
|
|
168 (provide 'dos-win32)
|
|
|
169
|
|
|
170 ;;; dos-win32.el ends here
|
