1 ;;; dos-fns.el --- MS-Dos specific functions.
3 ;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.
5 ;; Maintainer: Morten Welinder (terra@diku.dk)
8 ;; This file is part of GNU Emacs.
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)
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.
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
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;; Part of this code is taken from (or derived from) demacs.
30 (setq-default mode-line-format
33 'mode-line-buffer-identification
38 'mode-name
'minor-mode-alist
"%n" 'mode-line-process
40 (purecopy '(line-number-mode "L%l--"))
41 (purecopy '(-3 .
"%p"))
45 ;; buffer-file-type (0 "text") (1 "binary")
47 (defvar file-name-buffer-file-type-alist
49 ("[:/].*config.sys$" .
0) ; config.sys text
50 ("\\.elc$" .
1) ; emacs stuff
51 ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" .
1)
53 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" .
1)
55 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" .
1)
58 ; Borland Pascal stuff
63 (defun find-buffer-file-type (filename)
64 (let ((alist file-name-buffer-file-type-alist
)
67 (let ((case-fold-search t
))
68 (setq filename
(file-name-sans-versions filename
))
69 (while (and (not found
) alist
)
70 (if (string-match (car (car alist
)) filename
)
71 (setq code
(cdr (car alist
))
73 (setq alist
(cdr alist
))))
75 (cond((numberp code
) code
)
76 ((and (symbolp code
) (fboundp code
))
77 (funcall code filename
)))
78 default-buffer-file-type
)))
80 (defun find-file-binary (filename)
81 "Like find-file but always load the file as binary."
82 (interactive "FFind file binary: ")
83 (let ((file-name-buffer-file-type-alist '(("" .
1))))
84 (find-file filename
)))
86 (defun find-file-text (filename)
87 "Like find-file but always load the file as text."
88 (interactive "FFind file text: ")
89 (let ((file-name-buffer-file-type-alist '(("" .
0))))
90 (find-file filename
)))
92 (defun find-file-not-found-set-buffer-file-type ()
94 (set-buffer (current-buffer))
95 (setq buffer-file-type
(find-buffer-file-type (buffer-file-name))))
98 ;;; To set the default file type on new files.
99 (add-hook 'find-file-not-found-hooks
'find-file-not-found-set-buffer-file-type
)
101 ;;; We use the Emacs directory, not /usr/local
102 (setq Info-default-directory-list
(list "c:/emacs/info"))
104 (defvar msdos-shells
'("command.com" "4dos.com" "ndos.com")
105 "*List of shells that use `/c' instead of `-c' and a backslashed command.")
107 (defconst register-name-by-word-alist
108 '((ax .
0) (bx .
1) (cx .
2) (dx .
3) (si .
4) (di .
5)
109 (cflag .
6) (flags .
7)))
111 (defconst register-name-by-byte-alist
112 '((al .
(0 .
0)) (ah .
(0 .
1))
113 (bl .
(1 .
0)) (bh .
(1 .
1))
114 (cl .
(2 .
0)) (ch .
(2 .
1))
115 (dl .
(3 .
0)) (dh .
(3 .
1))))
117 (defun make-register ()
120 (defun register-value (regs name
)
121 (let ((where (or (cdr (assoc name register-name-by-word-alist
))
122 (cdr (assoc name register-name-by-byte-alist
)))))
124 (let ((tem (aref regs
(car where
))))
125 (if (zerop (cdr where
))
132 (defun set-register-value (regs name value
)
135 (let ((where (or (cdr (assoc name register-name-by-word-alist
))
136 (cdr (assoc name register-name-by-byte-alist
)))))
138 (setq value
(% value
256)) ; 0x100
139 (let* ((tem (aref regs
(car where
)))
142 (if (zerop (cdr where
))
143 (aset regs
(car where
) (+ (* h
256) value
))
144 (aset regs
(car where
) (+ (* value
256) h
)))))
146 (setq value
(% value
65536)) ; 0x10000
147 (aset regs where value
)))))
150 (defsubst intdos
(regs)
153 ;;; Fix interface to (X-specific) mouse.el
154 (defalias 'window-frame
'ignore
)
155 (defalias 'x-set-selection
'ignore
)
156 (fset 'x-get-selection
'(lambda (&rest rest
) ""))
157 (fset 'frame-parameters
'ignore
)
158 (fmakunbound 'font-menu-add-default
)
159 (global-unset-key [C-down-mouse-1
])
160 (global-unset-key [C-down-mouse-2
])
161 (global-unset-key [C-down-mouse-3
])