summaryrefslogtreecommitdiff
path: root/lisp/dos-win32.el
diff options
context:
space:
mode:
authorDave Love <fx@gnu.org>1999-10-04 17:15:48 +0000
committerDave Love <fx@gnu.org>1999-10-04 17:15:48 +0000
commit6edcb099fc0d92a9c69ddde30045111a6891ebd3 (patch)
tree3f01ee7ed9e2762ee18ddf68bc893725bd574856 /lisp/dos-win32.el
parentd56a50549da324e7a2d380d9c19b0a39f2a07339 (diff)
downloademacs-6edcb099fc0d92a9c69ddde30045111a6891ebd3.tar.gz
#
Diffstat (limited to 'lisp/dos-win32.el')
-rw-r--r--lisp/dos-win32.el170
1 files changed, 0 insertions, 170 deletions
diff --git a/lisp/dos-win32.el b/lisp/dos-win32.el
deleted file mode 100644
index 89704c029c5..00000000000
--- a/lisp/dos-win32.el
+++ /dev/null
@@ -1,170 +0,0 @@
-;;; dos-win32.el --- Functions shared among MS-DOS and Win32 (NT/95) platforms
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Maintainer: Geoff Voelker (voelker@cs.washington.edu)
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Parts of this code are duplicated functions taken from dos-fns.el
-;; and winnt.el.
-
-;;; Code:
-
-;;; Add %t: into the mode line format just after the open-paren.
-(let ((tail (member " %[(" mode-line-format)))
- (setcdr tail (cons (purecopy "%t:")
- (cdr tail))))
-
-;; Use ";" instead of ":" as a path separator (from files.el).
-(setq path-separator ";")
-
-;; Set the null device (for compile.el).
-(setq grep-null-device "NUL")
-
-;; Set the grep regexp to match entries with drive letters.
-(setq grep-regexp-alist
- '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
-
-;; For distinguishing file types based upon suffixes.
-(defvar file-name-buffer-file-type-alist
- '(
- ("[:/].*config.sys$" . nil) ; config.sys text
- ("\\.elc$" . t) ; emacs stuff
- ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
- ; MS-Dos stuff
- ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
- ; Packers
- ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
- ; Unix stuff
- ("\\.tp[ulpw]$" . t)
- ; Borland Pascal stuff
- ("[:/]tags$" . t)
- ; Emacs TAGS file
- )
- "*Alist for distinguishing text files from binary files.
-Each element has the form (REGEXP . TYPE), where REGEXP is matched
-against the file name, and TYPE is nil for text, t for binary.")
-
-(defun find-buffer-file-type (filename)
- ;; First check if file is on an untranslated filesystem, then on the alist.
- (if (untranslated-file-p filename)
- t ; for binary
- (let ((alist file-name-buffer-file-type-alist)
- (found nil)
- (code nil))
- (let ((case-fold-search t))
- (setq filename (file-name-sans-versions filename))
- (while (and (not found) alist)
- (if (string-match (car (car alist)) filename)
- (setq code (cdr (car alist))
- found t))
- (setq alist (cdr alist))))
- (if found
- (cond ((memq code '(nil t)) code)
- ((and (symbolp code) (fboundp code))
- (funcall code filename)))
- default-buffer-file-type))))
-
-(defun find-file-binary (filename)
- "Visit file FILENAME and treat it as binary."
- (interactive "FFind file binary: ")
- (let ((file-name-buffer-file-type-alist '(("" . t))))
- (find-file filename)))
-
-(defun find-file-text (filename)
- "Visit file FILENAME and treat it as a text file."
- (interactive "FFind file text: ")
- (let ((file-name-buffer-file-type-alist '(("" . nil))))
- (find-file filename)))
-
-(defun find-file-not-found-set-buffer-file-type ()
- (save-excursion
- (set-buffer (current-buffer))
- (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
- nil)
-
-;;; To set the default file type on new files.
-(add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
-
-
-;;; To accomodate filesystems that do not require CR/LF translation.
-(defvar untranslated-filesystem-list nil
- "List of filesystems that require no CR/LF translation during file I/O.
-Each element in the list is a string naming the directory prefix
-corresponding to the filesystem.")
-
-(defun untranslated-canonical-name (filename)
- "Return FILENAME in a canonicalized form.
-This is for use with the functions dealing with untranslated filesystems."
- (if (memq system-type '(ms-dos windows-nt))
- ;; The canonical form for DOS/NT/Win95 is with A-Z downcased and all
- ;; directory separators changed to directory-sep-char.
- (let ((name nil))
- (setq name (mapconcat
- '(lambda (char)
- (if (and (<= ?A char) (<= char ?Z))
- (char-to-string (+ (- char ?A) ?a))
- (char-to-string char)))
- filename nil))
- ;; Use expand-file-name to canonicalize directory separators, except
- ;; with bare drive letters (which would have the cwd appended).
- (if (string-match "^.:$" name)
- name
- (expand-file-name name)))
- filename))
-
-(defun untranslated-file-p (filename)
- "Test whether CR/LF translation should be disabled for FILENAME.
-Return t if FILENAME is on a filesystem that does not require
-CR/LF translation, and nil otherwise."
- (let ((fs (untranslated-canonical-name filename))
- (ufs-list untranslated-filesystem-list)
- (found nil))
- (while (and (not found) ufs-list)
- (if (string-match (concat "^" (regexp-quote (car ufs-list))) fs)
- (setq found t)
- (setq ufs-list (cdr ufs-list))))
- found))
-
-(defun add-untranslated-filesystem (filesystem)
- "Record that FILESYSTEM does not require CR/LF translation.
-FILESYSTEM is a string containing the directory prefix corresponding to
-the filesystem. For example, for a Unix filesystem mounted on drive Z:,
-FILESYSTEM could be \"Z:\"."
- (let ((fs (untranslated-canonical-name filesystem)))
- (if (member fs untranslated-filesystem-list)
- untranslated-filesystem-list
- (setq untranslated-filesystem-list
- (cons fs untranslated-filesystem-list)))))
-
-(defun remove-untranslated-filesystem (filesystem)
- "Record that FILESYSTEM requires CR/LF translation.
-FILESYSTEM is a string containing the directory prefix corresponding to
-the filesystem. For example, for a Unix filesystem mounted on drive Z:,
-FILESYSTEM could be \"Z:\"."
- (setq untranslated-filesystem-list
- (delete (untranslated-canonical-name filesystem)
- untranslated-filesystem-list)))
-
-(provide 'dos-win32)
-
-;;; dos-win32.el ends here