1 ;;; dos-fns.el --- MS-Dos specific functions.
3 ;; Copyright (C) 1991, 1993, 1995 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 the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Part of this code is taken from (or derived from) demacs.
31 ;;; Add %t: into the mode line format just after the open-paren.
32 (let ((tail (member " %[(" mode-line-format
)))
33 (setcdr tail
(cons (purecopy "%t:")
36 ;; Use ";" instead of ":" as a path separator (from files.el).
37 (setq path-separator
";")
39 ;; Set the null device (for compile.el).
40 (setq grep-null-device
"NUL")
42 ;; Set the grep regexp to match entries with drive letters.
43 (setq grep-regexp-alist
44 '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
46 ;; This overrides a trivial definition in files.el.
47 (defun convert-standard-filename (filename)
48 "Convert a standard file's name to something suitable for the current OS.
49 This function's standard definition is trivial; it just returns the argument.
50 However, on some systems, the function is redefined
51 with a definition that really does change some file names."
52 (let ((dir (file-name-directory filename
))
53 (string (copy-sequence (file-name-nondirectory filename
)))
55 ;; Change a leading period to a leading underscore.
56 (if (= (aref string
0) ?.
)
58 ;; Get rid of invalid characters.
59 (while (setq i
(string-match "[^a-zA-Z0-9_.%~]" string
))
61 ;; If we don't have a period,
62 ;; and we have a dash or underscore that isn't the first char,
63 ;; change that to a period.
64 (if (and (not (string-match "\\." string
))
65 (setq i
(string-match "[-_]" string
1)))
67 ;; If we don't have a period in the first 8 chars, insert one.
68 (if (> (or (string-match "\\." string
)
72 (concat (substring string
0 8)
74 (substring string
8))))
75 (setq firstdot
(or (string-match "\\." string
) (1- (length string
))))
76 ;; Truncate to 3 chars after the first period.
77 (if (> (length string
) (+ firstdot
4))
78 (setq string
(substring string
0 (+ firstdot
4))))
79 ;; Change all periods except the first one into underscores.
80 (while (string-match "\\." string
(1+ firstdot
))
81 (setq i
(string-match "\\." string
(1+ firstdot
)))
85 (defvar file-name-buffer-file-type-alist
87 ("[:/].*config.sys$" . nil
) ; config.sys text
88 ("\\.elc$" . t
) ; emacs stuff
89 ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t
)
91 ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t
)
93 ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t
)
96 ; Borland Pascal stuff
100 "*Alist for distinguishing text files from binary files.
101 Each element has the form (REGEXP . TYPE), where REGEXP is matched
102 against the file name, and TYPE is nil for text, t for binary.")
104 (defun find-buffer-file-type (filename)
105 (let ((alist file-name-buffer-file-type-alist
)
108 (let ((case-fold-search t
))
109 (setq filename
(file-name-sans-versions filename
))
110 (while (and (not found
) alist
)
111 (if (string-match (car (car alist
)) filename
)
112 (setq code
(cdr (car alist
))
114 (setq alist
(cdr alist
))))
116 (cond((memq code
'(nil t
)) code
)
117 ((and (symbolp code
) (fboundp code
))
118 (funcall code filename
)))
119 default-buffer-file-type
)))
121 (defun find-file-binary (filename)
122 "Visit file FILENAME and treat it as binary."
123 (interactive "FFind file binary: ")
124 (let ((file-name-buffer-file-type-alist '(("" . t
))))
125 (find-file filename
)))
127 (defun find-file-text (filename)
128 "Visit file FILENAME and treat it as a text file."
129 (interactive "FFind file text: ")
130 (let ((file-name-buffer-file-type-alist '(("" . nil
))))
131 (find-file filename
)))
133 (defun find-file-not-found-set-buffer-file-type ()
135 (set-buffer (current-buffer))
136 (setq buffer-file-type
(find-buffer-file-type (buffer-file-name))))
139 ;;; To set the default file type on new files.
140 (add-hook 'find-file-not-found-hooks
'find-file-not-found-set-buffer-file-type
)
142 (defvar msdos-shells
'("command.com" "4dos.com" "ndos.com")
143 "*List of shells that use `/c' instead of `-c' and a backslashed command.")
145 (defconst register-name-alist
146 '((ax .
0) (bx .
1) (cx .
2) (dx .
3) (si .
4) (di .
5)
147 (cflag .
6) (flags .
7)
148 (al .
(0 .
0)) (bl .
(1 .
0)) (cl .
(2 .
0)) (dl .
(3 .
0))
149 (ah .
(0 .
1)) (bh .
(1 .
1)) (ch .
(2 .
1)) (dh .
(3 .
1))))
151 (defun make-register ()
154 (defun register-value (regs name
)
155 (let ((where (cdr (assoc name register-name-alist
))))
157 (let ((tem (aref regs
(car where
))))
158 (if (zerop (cdr where
))
165 (defun set-register-value (regs name value
)
168 (let ((where (cdr (assoc name register-name-alist
))))
170 (let ((tem (aref regs
(car where
)))
171 (value (logand value
255)))
174 (if (zerop (cdr where
))
175 (logior (logand tem
65280) value
)
176 (logior (logand tem
255) (lsh value
8))))))
178 (aset regs where
(logand value
65535))))))
181 (defsubst intdos
(regs)
184 ;; Extra stub to functions in src/frame.c
185 ;; Emacs aborts during dump if the following don't have a doc string.
186 (defun window-frame (window)
187 "Return the frame that WINDOW resides on."
189 (defun raise-frame (frame)
190 "Raise FRAME to the top of the desktop."
192 (defun select-frame (frame &optional no-enter
)
193 "Select FRAME for input events."