annotate lisp/dos-fns.el @ 103512:ce2fc4a55d15

(lisp-indent-offset): Fix safe-local-variable property. (lisp-indent-function): Make it a defcustom.
author Glenn Morris <rgm@gnu.org>
date Mon, 22 Jun 2009 06:24:32 +0000
parents a9dc0e7c3f2b
children c4fb8f245750
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38436
b174db545cfd Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 37262
diff changeset
1 ;;; dos-fns.el --- MS-Dos specific functions
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
74439
ddcbd2c1b70d Update copyright years.
Glenn Morris <rgm@gnu.org>
parents: 68651
diff changeset
3 ;; Copyright (C) 1991, 1993, 1995, 1996, 2001, 2002, 2003, 2004,
100908
a9dc0e7c3f2b Add 2009 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 100691
diff changeset
4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5
17977
727cf56647a4 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 16690
diff changeset
6 ;; Maintainer: Morten Welinder <terra@diku.dk>
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Keywords: internal
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
13 ;; the Free Software Foundation, either version 3 of the License, or
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
14 ;; (at your option) any later version.
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ;;; Commentary:
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;; Part of this code is taken from (or derived from) demacs.
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;;; Code:
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29
86293
f68aca4b5962 (int86): Fix declaration.
Glenn Morris <rgm@gnu.org>
parents: 86289
diff changeset
30 (declare-function int86 "dosfns.c")
86289
8a7ed478f7bc * international/titdic-cnv.el (dos-8+3-filename):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 86277
diff changeset
31 (declare-function msdos-long-file-names "msdos.c")
8a7ed478f7bc * international/titdic-cnv.el (dos-8+3-filename):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 86277
diff changeset
32
13913
4e4201bcea5d (convert-standard-filename): New alternate definition.
Richard M. Stallman <rms@gnu.org>
parents: 13487
diff changeset
33 ;; This overrides a trivial definition in files.el.
4e4201bcea5d (convert-standard-filename): New alternate definition.
Richard M. Stallman <rms@gnu.org>
parents: 13487
diff changeset
34 (defun convert-standard-filename (filename)
4e4201bcea5d (convert-standard-filename): New alternate definition.
Richard M. Stallman <rms@gnu.org>
parents: 13487
diff changeset
35 "Convert a standard file's name to something suitable for the current OS.
55865
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
36 This means to guarantee valid names and perhaps to canonicalize
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
37 certain patterns.
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
38
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
39 On Windows and DOS, replace invalid characters. On DOS, make
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
40 sure to obey the 8.3 limitations. On Windows, turn Cygwin names
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
41 into native names, and also turn slashes into backslashes if the
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
42 shell requires it (see `w32-shell-dos-semantics')."
29855
4a37c3f4cb29 (convert-standard-filename): Convert leading
Eli Zaretskii <eliz@gnu.org>
parents: 24515
diff changeset
43 (if (or (not (stringp filename))
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
44 ;; This catches the case where FILENAME is "x:" or "x:/" or
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
45 ;; "/", thus preventing infinite recursion.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
46 (string-match "\\`\\([a-zA-Z]:\\)?[/\\]?\\'" filename))
15187
d46c1e8bdb0d (convert-standard-filename): Test msdos-long-file-names.
Richard M. Stallman <rms@gnu.org>
parents: 14734
diff changeset
47 filename
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
48 (let ((flen (length filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
49 ;; If FILENAME has a trailing slash, remove it and recurse.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
50 (if (memq (aref filename (1- flen)) '(?/ ?\\))
49588
37645a051842 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43756
diff changeset
51 (concat (convert-standard-filename
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
52 (substring filename 0 (1- flen)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
53 "/")
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
54 (let* (;; ange-ftp gets in the way for names like "/foo:bar".
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
55 ;; We need to inhibit all magic file names, because
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
56 ;; remote file names should never be passed through
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
57 ;; this function, as they are not meant for the local
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
58 ;; filesystem!
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
59 (file-name-handler-alist nil)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
60 (dir
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
61 ;; If FILENAME is "x:foo", file-name-directory returns
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
62 ;; "x:/bar/baz", substituting the current working
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
63 ;; directory on drive x:. We want to be left with "x:"
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
64 ;; instead.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
65 (if (and (< 1 flen)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
66 (eq (aref filename 1) ?:)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
67 (null (string-match "[/\\]" filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
68 (substring filename 0 2)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
69 (file-name-directory filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
70 (dlen-m-1 (1- (length dir)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
71 (string (copy-sequence (file-name-nondirectory filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
72 (lastchar (aref string (1- (length string))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
73 i firstdot)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
74 (cond
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
75 ((msdos-long-file-names)
29855
4a37c3f4cb29 (convert-standard-filename): Convert leading
Eli Zaretskii <eliz@gnu.org>
parents: 24515
diff changeset
76 ;; Replace characters that are invalid even on Windows.
4a37c3f4cb29 (convert-standard-filename): Convert leading
Eli Zaretskii <eliz@gnu.org>
parents: 24515
diff changeset
77 (while (setq i (string-match "[?*:<>|\"\000-\037]" string))
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
78 (aset string i ?!)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
79 ((not (member string '("" "." "..")))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
80 ;; Change a leading period to a leading underscore.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
81 (if (= (aref string 0) ?.)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
82 (aset string 0 ?_))
39305
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
83 ;; If the name is longer than 8 chars, and doesn't have a
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
84 ;; period, and we have a dash or underscore that isn't too
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
85 ;; close to the beginning, change that to a period. This
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
86 ;; is so we could salvage more characters of the original
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
87 ;; name by pushing them into the extension.
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
88 (if (and (not (string-match "\\." string))
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
89 (> (length string) 8)
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
90 ;; We don't gain anything if we put the period closer
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
91 ;; than 5 chars from the beginning (5 + 3 = 8).
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
92 (setq i (string-match "[-_]" string 5)))
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
93 (aset string i ?\.))
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
94 ;; Get rid of invalid characters.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
95 (while (setq i (string-match
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
96 "[^-a-zA-Z0-9_.%~^$!#&{}@`'()\200-\376]"
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
97 string))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
98 (aset string i ?_))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
99 ;; If we don't have a period in the first 8 chars, insert one.
39305
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
100 ;; This enables to have 3 more characters from the original
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
101 ;; name in the extension.
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
102 (if (> (or (string-match "\\." string) (length string))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
103 8)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
104 (setq string
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
105 (concat (substring string 0 8)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
106 "."
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
107 (substring string 8))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
108 (setq firstdot (or (string-match "\\." string)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
109 (1- (length string))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
110 ;; Truncate to 3 chars after the first period.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
111 (if (> (length string) (+ firstdot 4))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
112 (setq string (substring string 0 (+ firstdot 4))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
113 ;; Change all periods except the first one into underscores.
39305
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
114 ;; (DOS doesn't allow more than one period.)
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
115 (while (string-match "\\." string (1+ firstdot))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
116 (setq i (string-match "\\." string (1+ firstdot)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
117 (aset string i ?_))
39305
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
118 ;; If the last character of the original filename was `~' or `#',
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
119 ;; make sure the munged name ends with it also. This is so that
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
120 ;; backup and auto-save files retain their telltale form.
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
121 (if (memq lastchar '(?~ ?#))
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
122 (aset string (1- (length string)) lastchar))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
123 (concat (if (and (stringp dir)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
124 (memq (aref dir dlen-m-1) '(?/ ?\\)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
125 (concat (convert-standard-filename
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
126 (substring dir 0 dlen-m-1))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
127 "/")
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
128 (convert-standard-filename dir))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
129 string))))))
13913
4e4201bcea5d (convert-standard-filename): New alternate definition.
Richard M. Stallman <rms@gnu.org>
parents: 13487
diff changeset
130
37262
3e478bb3f389 (dos-8+3-filename): Rename from dos-truncate-to-8+3.
Eli Zaretskii <eliz@gnu.org>
parents: 37257
diff changeset
131 (defun dos-8+3-filename (filename)
37257
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
132 "Truncate FILENAME to DOS 8+3 limits."
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
133 (if (or (not (stringp filename))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
134 (< (length filename) 5)) ; too short to give any trouble
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
135 filename
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
136 (let ((flen (length filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
137 ;; If FILENAME has a trailing slash, remove it and recurse.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
138 (if (memq (aref filename (1- flen)) '(?/ ?\\))
37262
3e478bb3f389 (dos-8+3-filename): Rename from dos-truncate-to-8+3.
Eli Zaretskii <eliz@gnu.org>
parents: 37257
diff changeset
139 (concat (dos-8+3-filename (substring filename 0 (1- flen)))
37257
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
140 "/")
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
141 (let* (;; ange-ftp gets in the way for names like "/foo:bar".
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
142 ;; We need to inhibit all magic file names, because
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
143 ;; remote file names should never be passed through
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
144 ;; this function, as they are not meant for the local
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
145 ;; filesystem!
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
146 (file-name-handler-alist nil)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
147 (dir
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
148 ;; If FILENAME is "x:foo", file-name-directory returns
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
149 ;; "x:/bar/baz", substituting the current working
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
150 ;; directory on drive x:. We want to be left with "x:"
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
151 ;; instead.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
152 (if (and (< 1 flen)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
153 (eq (aref filename 1) ?:)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
154 (null (string-match "[/\\]" filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
155 (substring filename 0 2)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
156 (file-name-directory filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
157 (dlen-m-1 (1- (length dir)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
158 (string (copy-sequence (file-name-nondirectory filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
159 (strlen (length string))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
160 (lastchar (aref string (1- strlen)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
161 i firstdot)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
162 (setq firstdot (string-match "\\." string))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
163 (cond
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
164 (firstdot
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
165 ;; Truncate the extension to 3 characters.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
166 (if (> strlen (+ firstdot 4))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
167 (setq string (substring string 0 (+ firstdot 4))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
168 ;; Truncate the basename to 8 characters.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
169 (if (> firstdot 8)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
170 (setq string (concat (substring string 0 8)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
171 "."
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
172 (substring string (1+ firstdot))))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
173 ((> strlen 8)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
174 ;; No dot; truncate file name to 8 characters.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
175 (setq string (substring string 0 8))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
176 ;; If the last character of the original filename was `~',
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
177 ;; make sure the munged name ends with it also. This is so
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
178 ;; a backup file retains its final `~'.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
179 (if (equal lastchar ?~)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
180 (aset string (1- (length string)) lastchar))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
181 (concat (if (and (stringp dir)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
182 (memq (aref dir dlen-m-1) '(?/ ?\\)))
37262
3e478bb3f389 (dos-8+3-filename): Rename from dos-truncate-to-8+3.
Eli Zaretskii <eliz@gnu.org>
parents: 37257
diff changeset
183 (concat (dos-8+3-filename (substring dir 0 dlen-m-1))
37257
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
184 "/")
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
185 ;; Recurse to truncate the leading directories.
37262
3e478bb3f389 (dos-8+3-filename): Rename from dos-truncate-to-8+3.
Eli Zaretskii <eliz@gnu.org>
parents: 37257
diff changeset
186 (dos-8+3-filename dir))
37257
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
187 string))))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
188
100691
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
189 ;; This is for the sake of standard file names elsewhere in Emacs that
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
190 ;; are defined as constant strings or via defconst, and whose
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
191 ;; conversion via `convert-standard-filename' does not give good
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
192 ;; enough results.
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
193 (defun dosified-file-name (file-name)
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
194 "Return a variant of FILE-NAME that is valid on MS-DOS filesystems.
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
195
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
196 This function is for those rare cases where `convert-standard-filename'
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
197 does not do a job that is good enough, e.g. if you need to preserve the
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
198 file-name extension. It recognizes only certain specific file names
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
199 that are used in Emacs Lisp sources; any other file name will be
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
200 returned unaltered."
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
201 (cond
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
202 ;; See files.el:dir-locals-file.
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
203 ((string= file-name ".dir-locals.el")
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
204 "_dir-locals.el")
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
205 (t
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
206 file-name)))
89166beb2187 (dosified-file-name): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 98874
diff changeset
207
22070
d8e53123116c (dos-ps-printer, dos-printer, msdos-shells):
Richard M. Stallman <rms@gnu.org>
parents: 21568
diff changeset
208 ;; See dos-vars.el for defcustom.
d8e53123116c (dos-ps-printer, dos-printer, msdos-shells):
Richard M. Stallman <rms@gnu.org>
parents: 21568
diff changeset
209 (defvar msdos-shells)
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210
98859
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
211 ;; Override settings chosen at startup.
24515
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
212 (defun set-default-process-coding-system ()
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
213 (setq default-process-coding-system
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
214 (if default-enable-multibyte-characters
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
215 '(undecided-dos . undecided-dos)
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
216 '(raw-text-dos . raw-text-dos))))
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
217
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
218 (add-hook 'before-init-hook 'set-default-process-coding-system)
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
219
98859
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
220 ;; File names defined in preloaded packages can be incorrect or
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
221 ;; invalid if long file names were available during dumping, but not
98874
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
222 ;; at runtime, or vice versa, and if the default file name begins with
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
223 ;; a period. Their defcustom's need to be reevaluated at startup. To
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
224 ;; see if the list of defcustom's below is up to date, run the command
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
225 ;; "M-x apropos-value RET ~/\. RET".
98859
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
226 (defun dos-reevaluate-defcustoms ()
98874
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
227 ;; This was computed in paths.el, but that was at dump time.
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
228 (setq abbrev-file-name
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
229 (if (msdos-long-file-names)
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
230 "~/.abbrev_defs"
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
231 "~/_abbrev.defs"))
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
232 ;; This was computed in loaddefs.el, but that was at dump time.
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
233 (setq calc-settings-file
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
234 (if (msdos-long-file-names)
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
235 "~/.calc.el"
d42cab7ccc5d (dos-reevaluate-defcustoms): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98859
diff changeset
236 "~/_calc.el"))
98859
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
237 (custom-reevaluate-setting 'trash-directory))
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
238
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
239 (add-hook 'before-init-hook 'dos-reevaluate-defcustoms)
ff71052e3573 (dos-reevaluate-defcustoms): New function. Add it to before-init-hook.
Eli Zaretskii <eliz@gnu.org>
parents: 94678
diff changeset
240
16690
97029c2699a7 (register-name-alist): Use defvar.
Richard M. Stallman <rms@gnu.org>
parents: 16027
diff changeset
241 (defvar register-name-alist
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
243 (cflag . 6) (flags . 7)
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
244 (al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0))
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
245 (ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (defun make-register ()
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (make-vector 8 0))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 (defun register-value (regs name)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
251 (let ((where (cdr (assoc name register-name-alist))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 (cond ((consp where)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (let ((tem (aref regs (car where))))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (if (zerop (cdr where))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 (% tem 256)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (/ tem 256))))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 ((numberp where)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 (aref regs where))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 (t nil))))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 (defun set-register-value (regs name value)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 (and (numberp value)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
263 (>= value 0)
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
264 (let ((where (cdr (assoc name register-name-alist))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 (cond ((consp where)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
266 (let ((tem (aref regs (car where)))
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
267 (value (logand value 255)))
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
268 (aset regs
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
269 (car where)
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
270 (if (zerop (cdr where))
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
271 (logior (logand tem 65280) value)
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
272 (logior (logand tem 255) (lsh value 8))))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 ((numberp where)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
274 (aset regs where (logand value 65535))))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 regs)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 (defsubst intdos (regs)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 (int86 33 regs))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279
14380
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
280 ;; Backward compatibility for obsolescent functions which
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
281 ;; set screen size.
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
282
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
283 (defun mode25 ()
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
284 "Changes the number of screen rows to 25."
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
285 (interactive)
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
286 (set-frame-size (selected-frame) 80 25))
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
287
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
288 (defun mode4350 ()
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
289 "Changes the number of rows to 43 or 50.
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
290 Emacs always tries to set the screen height to 50 rows first.
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
291 If this fails, it will try to set it to 43 rows, on the assumption
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
292 that your video hardware might not support 50-line mode."
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
293 (interactive)
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
294 (set-frame-size (selected-frame) 80 50)
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
295 (if (eq (frame-height (selected-frame)) 50)
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
296 nil ; the original built-in function returned nil
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
297 (set-frame-size (selected-frame) 80 43)))
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
298
14189
557b3d11a381 (ps-lpr-switches, ps-lpr-command): Just setq them;
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
299 (provide 'dos-fns)
557b3d11a381 (ps-lpr-switches, ps-lpr-command): Just setq them;
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
300
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 87649
diff changeset
301 ;; arch-tag: 00b03579-8ebb-4a02-8762-5c5a929774ad
38436
b174db545cfd Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 37262
diff changeset
302 ;;; dos-fns.el ends here