diff options
Diffstat (limited to 'lisp/dos-fns.el')
| -rw-r--r-- | lisp/dos-fns.el | 161 |
1 files changed, 161 insertions, 0 deletions
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el new file mode 100644 index 00000000000..f411acfb55e --- /dev/null +++ b/lisp/dos-fns.el @@ -0,0 +1,161 @@ +;;; dos-fns.el --- MS-Dos specific functions. + +;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. + +;; Maintainer: Morten Welinder (terra@diku.dk) +;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Part of this code is taken from (or derived from) demacs. + +;;; Code: + +(setq-default mode-line-format + (list (purecopy "") + 'mode-line-modified + 'mode-line-buffer-identification + (purecopy " ") + 'global-mode-string + (purecopy " %[(") + (purecopy "%t:") + 'mode-name 'minor-mode-alist "%n" 'mode-line-process + (purecopy ")%]--") + (purecopy '(line-number-mode "L%l--")) + (purecopy '(-3 . "%p")) + (purecopy "-%-"))) + +;; +;; buffer-file-type (0 "text") (1 "binary") +;; +(defvar file-name-buffer-file-type-alist + '( + ("[:/].*config.sys$" . 0) ; config.sys text + ("\\.elc$" . 1) ; emacs stuff + ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . 1) + ; MS-Dos stuff + ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . 1) + ; Packers + ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . 1) + ; Unix stuff + ("\\.tp[ulpw]$" . 1) + ; Borland Pascal stuff + ("[:/]tags$" . 1 ) + ; Emacs TAGS file + )) + +(defun find-buffer-file-type (filename) + (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 code + (cond((numberp code) code) + ((and (symbolp code) (fboundp code)) + (funcall code filename))) + default-buffer-file-type))) + +(defun find-file-binary (filename) + "Like find-file but always load the file as binary." + (interactive "FFind file binary: ") + (let ((file-name-buffer-file-type-alist '(("" . 1)))) + (find-file filename))) + +(defun find-file-text (filename) + "Like find-file but always load the file as text." + (interactive "FFind file text: ") + (let ((file-name-buffer-file-type-alist '(("" . 0)))) + (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) + +;;; We use the Emacs directory, not /usr/local +(setq Info-default-directory-list (list "c:/emacs/info")) + +(defvar msdos-shells '("command.com" "4dos.com" "ndos.com") + "*List of shells that use `/c' instead of `-c' and a backslashed command.") + +(defconst register-name-by-word-alist + '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5) + (cflag . 6) (flags . 7))) + +(defconst register-name-by-byte-alist + '((al . (0 . 0)) (ah . (0 . 1)) + (bl . (1 . 0)) (bh . (1 . 1)) + (cl . (2 . 0)) (ch . (2 . 1)) + (dl . (3 . 0)) (dh . (3 . 1)))) + +(defun make-register () + (make-vector 8 0)) + +(defun register-value (regs name) + (let ((where (or (cdr (assoc name register-name-by-word-alist)) + (cdr (assoc name register-name-by-byte-alist))))) + (cond ((consp where) + (let ((tem (aref regs (car where)))) + (if (zerop (cdr where)) + (% tem 256) + (/ tem 256)))) + ((numberp where) + (aref regs where)) + (t nil)))) + +(defun set-register-value (regs name value) + (and (numberp value) + (> value 0) + (let ((where (or (cdr (assoc name register-name-by-word-alist)) + (cdr (assoc name register-name-by-byte-alist))))) + (cond ((consp where) + (setq value (% value 256)) ; 0x100 + (let* ((tem (aref regs (car where))) + (l (% tem 256)) + (h (/ tem 256))) + (if (zerop (cdr where)) + (aset regs (car where) (+ (* h 256) value)) + (aset regs (car where) (+ (* value 256) h))))) + ((numberp where) + (setq value (% value 65536)) ; 0x10000 + (aset regs where value))))) + regs) + +(defsubst intdos (regs) + (int86 33 regs)) + +;;; Fix interface to (X-specific) mouse.el +(defalias 'window-frame 'ignore) +(defalias 'x-set-selection 'ignore) +(fset 'x-get-selection '(lambda (&rest rest) "")) +(fset 'frame-parameters 'ignore) +(fmakunbound 'font-menu-add-default) +(global-unset-key [C-down-mouse-1]) +(global-unset-key [C-down-mouse-2]) +(global-unset-key [C-down-mouse-3]) |