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 ;;; Add %t: into the mode line format just after the open-paren.
31 (let ((tail (member " %[(" mode-line-format
)))
32 (setcdr tail
(cons (purecopy "%t:")
35 ;; Use ";" instead of ":" as a path separator (from files.el).
36 (setq path-separator
";")
38 ;; Set the null device (for compile.el).
39 (setq grep-null-device
"NUL")
41 ;; Set the grep regexp to match entries with drive letters.
42 (setq grep-regexp-alist
43 '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
45 ;; This overrides a trivial definition in files.el.
46 (defun convert-standard-filename (filename)
47 "Convert a standard file's name to something suitable for the current OS.
48 This function's standard definition is trivial; it just returns the argument.
49 However, on some systems, the function is redefined
50 with a definition that really does change some file names."
51 (let ((dir (file-name-directory filename
))
52 (string (copy-sequence (file-name-nondirectory filename
)))
54 ;; Change a leading period to a leading underscore.
55 (if (= (aref string
0) ?.
)
57 ;; Get rid of invalid characters.
58 (while (setq i
(string-match "[^a-zA-Z0-9_.%~]" string
))
60 ;; If we don't have a period,
61 ;; and we have a dash or underscore that isn't the first char,
62 ;; change that to a period.
63 (if (and (not (string-match "\\." string
))
64 (setq i
(string-match "[-_]" string
1)))
66 ;; If we don't have a period in the first 8 chars, insert one.
67 (if (> (or (string-match "\\." string
)
71 (concat (substring string
0 8)
73 (substring string
8))))
74 (setq firstdot
(string-match "\\." string
))
75 ;; Truncate to 3 chars after the first period.
76 (if (> (length string
) (+ firstdot
4))
77 (setq string
(substring string
0 (+ firstdot
4))))
78 ;; Change all periods except the first one into underscores.
79 (while (string-match "\\." string
(1+ firstdot
))
80 (setq i
(string-match "\\." string
(1+ firstdot
)))
84 (defvar file-name-buffer-file-type-alist
86 ("[:/].*config.sys$" . nil
) ; config.sys text
87 ("\\.elc$" . t
) ; emacs stuff
88 ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t
)
90 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t
)
92 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t
)
95 ; Borland Pascal stuff
99 "*Alist for distinguishing text files from binary files.
100 Each element has the form (REGEXP . TYPE), where REGEXP is matched
101 against the file name, and TYPE is nil for text, t for binary.")
103 (defun find-buffer-file-type (filename)
104 (let ((alist file-name-buffer-file-type-alist
)
107 (let ((case-fold-search t
))
108 (setq filename
(file-name-sans-versions filename
))
109 (while (and (not found
) alist
)
110 (if (string-match (car (car alist
)) filename
)
111 (setq code
(cdr (car alist
))
113 (setq alist
(cdr alist
))))
115 (cond((memq code
'(nil t
)) code
)
116 ((and (symbolp code
) (fboundp code
))
117 (funcall code filename
)))
118 default-buffer-file-type
)))
120 (defun find-file-binary (filename)
121 "Visit file FILENAME and treat it as binary."
122 (interactive "FFind file binary: ")
123 (let ((file-name-buffer-file-type-alist '(("" . t
))))
124 (find-file filename
)))
126 (defun find-file-text (filename)
127 "Visit file FILENAME and treat it as a text file."
128 (interactive "FFind file text: ")
129 (let ((file-name-buffer-file-type-alist '(("" . nil
))))
130 (find-file filename
)))
132 (defun find-file-not-found-set-buffer-file-type ()
134 (set-buffer (current-buffer))
135 (setq buffer-file-type
(find-buffer-file-type (buffer-file-name))))
138 ;;; To set the default file type on new files.
139 (add-hook 'find-file-not-found-hooks
'find-file-not-found-set-buffer-file-type
)
141 (defvar msdos-shells
'("command.com" "4dos.com" "ndos.com")
142 "*List of shells that use `/c' instead of `-c' and a backslashed command.")
144 (defconst register-name-alist
145 '((ax .
0) (bx .
1) (cx .
2) (dx .
3) (si .
4) (di .
5)
146 (cflag .
6) (flags .
7)
147 (al .
(0 .
0)) (bl .
(1 .
0)) (cl .
(2 .
0)) (dl .
(3 .
0))
148 (ah .
(0 .
1)) (bh .
(1 .
1)) (ch .
(2 .
1)) (dh .
(3 .
1))))
150 (defun make-register ()
153 (defun register-value (regs name
)
154 (let ((where (cdr (assoc name register-name-alist
))))
156 (let ((tem (aref regs
(car where
))))
157 (if (zerop (cdr where
))
164 (defun set-register-value (regs name value
)
167 (let ((where (cdr (assoc name register-name-alist
))))
169 (let ((tem (aref regs
(car where
)))
170 (value (logand value
255)))
173 (if (zerop (cdr where
))
174 (logior (logand tem
65280) value
)
175 (logior (logand tem
255) (lsh value
8))))))
177 (aset regs where
(logand value
65535))))))
180 (defsubst intdos
(regs)
183 ;; Extra stub to functions in src/frame.c
184 ;; Emacs aborts during dump if the following don't have a doc string.
185 (defun window-frame (window)
186 "Return the frame that WINDOW resides on."
188 (defun raise-frame (frame)
189 "Raise FRAME to the top of the desktop."
191 (defun select-frame (frame &optional no-enter
)
192 "Select FRAME for input events."