(defun convert-standard-filename (filename)
"Convert a standard file's name to something suitable for the current OS.
This means to guarantee valid names and perhaps to canonicalize
certain patterns.
On Windows and DOS, replace invalid characters. On DOS, make
sure to obey the 8.3 limitations. On Windows, turn Cygwin names
into native names, and also turn slashes into backslashes if the
shell requires it (see `w32-shell-dos-semantics')."
(if (or (not (stringp filename))
(string-match "\\`\\([a-zA-Z]:\\)?[/\\]?\\'" filename))
filename
(let ((flen (length filename)))
(if (memq (aref filename (1- flen)) '(?/ ?\\))
(concat (convert-standard-filename
(substring filename 0 (1- flen)))
"/")
(let* ( (file-name-handler-alist nil)
(dir
(if (and (< 1 flen)
(eq (aref filename 1) ?:)
(null (string-match "[/\\]" filename)))
(substring filename 0 2)
(file-name-directory filename)))
(dlen-m-1 (1- (length dir)))
(string (copy-sequence (file-name-nondirectory filename)))
(lastchar (aref string (1- (length string))))
i firstdot)
(cond
((msdos-long-file-names)
(while (setq i (string-match "[?*:<>|\"\000-\037]" string))
(aset string i ?!)))
((not (member string '("" "." "..")))
(if (= (aref string 0) ?.)
(aset string 0 ?_))
(if (and (not (string-match "\\." string))
(> (length string) 8)
(setq i (string-match "[-_]" string 5)))
(aset string i ?\.))
(while (setq i (string-match
"[^-a-zA-Z0-9_.%~^$!#&{}@`'()\200-\376]"
string))
(aset string i ?_))
(if (> (or (string-match "\\." string) (length string))
8)
(setq string
(concat (substring string 0 8)
"."
(substring string 8))))
(setq firstdot (or (string-match "\\." string)
(1- (length string))))
(if (> (length string) (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
(while (string-match "\\." string (1+ firstdot))
(setq i (string-match "\\." string (1+ firstdot)))
(aset string i ?_))
(if (memq lastchar '(?~ ?#))
(aset string (1- (length string)) lastchar))))
(concat (if (and (stringp dir)
(memq (aref dir dlen-m-1) '(?/ ?\\)))
(concat (convert-standard-filename
(substring dir 0 dlen-m-1))
"/")
(convert-standard-filename dir))
string))))))
(defun dos-8+3-filename (filename)
"Truncate FILENAME to DOS 8+3 limits."
(if (or (not (stringp filename))
(< (length filename) 5)) filename
(let ((flen (length filename)))
(if (memq (aref filename (1- flen)) '(?/ ?\\))
(concat (dos-8+3-filename (substring filename 0 (1- flen)))
"/")
(let* ( (file-name-handler-alist nil)
(dir
(if (and (< 1 flen)
(eq (aref filename 1) ?:)
(null (string-match "[/\\]" filename)))
(substring filename 0 2)
(file-name-directory filename)))
(dlen-m-1 (1- (length dir)))
(string (copy-sequence (file-name-nondirectory filename)))
(strlen (length string))
(lastchar (aref string (1- strlen)))
i firstdot)
(setq firstdot (string-match "\\." string))
(cond
(firstdot
(if (> strlen (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
(if (> firstdot 8)
(setq string (concat (substring string 0 8)
"."
(substring string (1+ firstdot))))))
((> strlen 8)
(setq string (substring string 0 8))))
(if (equal lastchar ?~)
(aset string (1- (length string)) lastchar))
(concat (if (and (stringp dir)
(memq (aref dir dlen-m-1) '(?/ ?\\)))
(concat (dos-8+3-filename (substring dir 0 dlen-m-1))
"/")
(dos-8+3-filename dir))
string))))))
(defvar msdos-shells)
(defun set-default-process-coding-system ()
(setq default-process-coding-system
(if default-enable-multibyte-characters
'(undecided-dos . undecided-dos)
'(raw-text-dos . raw-text-dos))))
(add-hook 'before-init-hook 'set-default-process-coding-system)
(defvar register-name-alist
'((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5)
(cflag . 6) (flags . 7)
(al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0))
(ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1))))
(defun make-register ()
(make-vector 8 0))
(defun register-value (regs name)
(let ((where (cdr (assoc name register-name-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 (cdr (assoc name register-name-alist))))
(cond ((consp where)
(let ((tem (aref regs (car where)))
(value (logand value 255)))
(aset regs
(car where)
(if (zerop (cdr where))
(logior (logand tem 65280) value)
(logior (logand tem 255) (lsh value 8))))))
((numberp where)
(aset regs where (logand value 65535))))))
regs)
(defsubst intdos (regs)
(int86 33 regs))
(defun mode25 ()
"Changes the number of screen rows to 25."
(interactive)
(set-frame-size (selected-frame) 80 25))
(defun mode4350 ()
"Changes the number of rows to 43 or 50.
Emacs always tries to set the screen height to 50 rows first.
If this fails, it will try to set it to 43 rows, on the assumption
that your video hardware might not support 50-line mode."
(interactive)
(set-frame-size (selected-frame) 80 50)
(if (eq (frame-height (selected-frame)) 50)
nil (set-frame-size (selected-frame) 80 43)))
(provide 'dos-fns)