annotate lisp/dos-fns.el @ 85396:9ed1cbc73fd9

Regenerate.
author Glenn Morris <rgm@gnu.org>
date Thu, 18 Oct 2007 04:46:28 +0000
parents 9355f9b7bbff
children 73661ddc7ac7 22dc0bc9daf8 f55f9811f5d7
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,
75347
e3694f1cb928 Add 2007 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 74439
diff changeset
4 ;; 2005, 2006, 2007 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
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
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
78236
9355f9b7bbff Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents: 75347
diff changeset
13 ;; the Free Software Foundation; either version 3, or (at your option)
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; any later version.
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
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14162
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64091
6fb026ad601f Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 55865
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
6fb026ad601f Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 55865
diff changeset
24 ;; Boston, MA 02110-1301, USA.
5443
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 ;;; Commentary:
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 ;; Part of this code is taken from (or derived from) demacs.
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;;; Code:
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31
13913
4e4201bcea5d (convert-standard-filename): New alternate definition.
Richard M. Stallman <rms@gnu.org>
parents: 13487
diff changeset
32 ;; 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
33 (defun convert-standard-filename (filename)
4e4201bcea5d (convert-standard-filename): New alternate definition.
Richard M. Stallman <rms@gnu.org>
parents: 13487
diff changeset
34 "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
35 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
36 certain patterns.
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
37
ccd8cdf69359 Rework docstring (wording by Eli Zaretskii and Kai Grossjohann).
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
38 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
39 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
40 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
41 shell requires it (see `w32-shell-dos-semantics')."
29855
4a37c3f4cb29 (convert-standard-filename): Convert leading
Eli Zaretskii <eliz@gnu.org>
parents: 24515
diff changeset
42 (if (or (not (stringp filename))
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
43 ;; 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
44 ;; "/", thus preventing infinite recursion.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
45 (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
46 filename
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
47 (let ((flen (length filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
48 ;; 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
49 (if (memq (aref filename (1- flen)) '(?/ ?\\))
49588
37645a051842 Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 43756
diff changeset
50 (concat (convert-standard-filename
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
51 (substring filename 0 (1- flen)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
52 "/")
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
53 (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
54 ;; 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
55 ;; remote file names should never be passed through
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
56 ;; 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
57 ;; filesystem!
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
58 (file-name-handler-alist nil)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
59 (dir
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
60 ;; 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
61 ;; "x:/bar/baz", substituting the current working
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
62 ;; 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
63 ;; instead.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
64 (if (and (< 1 flen)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
65 (eq (aref filename 1) ?:)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
66 (null (string-match "[/\\]" filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
67 (substring filename 0 2)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
68 (file-name-directory filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
69 (dlen-m-1 (1- (length dir)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
70 (string (copy-sequence (file-name-nondirectory filename)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
71 (lastchar (aref string (1- (length string))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
72 i firstdot)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
73 (cond
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
74 ((msdos-long-file-names)
29855
4a37c3f4cb29 (convert-standard-filename): Convert leading
Eli Zaretskii <eliz@gnu.org>
parents: 24515
diff changeset
75 ;; Replace characters that are invalid even on Windows.
4a37c3f4cb29 (convert-standard-filename): Convert leading
Eli Zaretskii <eliz@gnu.org>
parents: 24515
diff changeset
76 (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
77 (aset string i ?!)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
78 ((not (member string '("" "." "..")))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
79 ;; Change a leading period to a leading underscore.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
80 (if (= (aref string 0) ?.)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
81 (aset string 0 ?_))
39305
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
82 ;; 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
83 ;; 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
84 ;; 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
85 ;; 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
86 ;; name by pushing them into the extension.
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
87 (if (and (not (string-match "\\." string))
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
88 (> (length string) 8)
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
89 ;; 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
90 ;; than 5 chars from the beginning (5 + 3 = 8).
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
91 (setq i (string-match "[-_]" string 5)))
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
92 (aset string i ?\.))
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
93 ;; Get rid of invalid characters.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
94 (while (setq i (string-match
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
95 "[^-a-zA-Z0-9_.%~^$!#&{}@`'()\200-\376]"
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
96 string))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
97 (aset string i ?_))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
98 ;; 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
99 ;; 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
100 ;; name in the extension.
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
101 (if (> (or (string-match "\\." string) (length string))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
102 8)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
103 (setq string
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
104 (concat (substring string 0 8)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
105 "."
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
106 (substring string 8))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
107 (setq firstdot (or (string-match "\\." string)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
108 (1- (length string))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
109 ;; Truncate to 3 chars after the first period.
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
110 (if (> (length string) (+ firstdot 4))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
111 (setq string (substring string 0 (+ firstdot 4))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
112 ;; 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
113 ;; (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
114 (while (string-match "\\." string (1+ firstdot))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
115 (setq i (string-match "\\." string (1+ firstdot)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
116 (aset string i ?_))
39305
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
117 ;; 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
118 ;; 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
119 ;; backup and auto-save files retain their telltale form.
22c925655e32 (convert-standard-filename): Replace invalid
Eli Zaretskii <eliz@gnu.org>
parents: 39301
diff changeset
120 (if (memq lastchar '(?~ ?#))
29966
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
121 (aset string (1- (length string)) lastchar))))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
122 (concat (if (and (stringp dir)
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
123 (memq (aref dir dlen-m-1) '(?/ ?\\)))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
124 (concat (convert-standard-filename
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
125 (substring dir 0 dlen-m-1))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
126 "/")
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
127 (convert-standard-filename dir))
cf435e74e3ee (convert-standard-filename): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 29855
diff changeset
128 string))))))
13913
4e4201bcea5d (convert-standard-filename): New alternate definition.
Richard M. Stallman <rms@gnu.org>
parents: 13487
diff changeset
129
37262
3e478bb3f389 (dos-8+3-filename): Rename from dos-truncate-to-8+3.
Eli Zaretskii <eliz@gnu.org>
parents: 37257
diff changeset
130 (defun dos-8+3-filename (filename)
37257
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
131 "Truncate FILENAME to DOS 8+3 limits."
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
132 (if (or (not (stringp filename))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
133 (< (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
134 filename
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
135 (let ((flen (length filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
136 ;; 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
137 (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
138 (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
139 "/")
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
140 (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
141 ;; 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
142 ;; 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
143 ;; 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
144 ;; filesystem!
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
145 (file-name-handler-alist nil)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
146 (dir
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
147 ;; 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
148 ;; "x:/bar/baz", substituting the current working
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
149 ;; 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
150 ;; instead.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
151 (if (and (< 1 flen)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
152 (eq (aref filename 1) ?:)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
153 (null (string-match "[/\\]" filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
154 (substring filename 0 2)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
155 (file-name-directory filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
156 (dlen-m-1 (1- (length dir)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
157 (string (copy-sequence (file-name-nondirectory filename)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
158 (strlen (length string))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
159 (lastchar (aref string (1- strlen)))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
160 i firstdot)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
161 (setq firstdot (string-match "\\." string))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
162 (cond
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
163 (firstdot
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
164 ;; Truncate the extension to 3 characters.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
165 (if (> strlen (+ firstdot 4))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
166 (setq string (substring string 0 (+ firstdot 4))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
167 ;; Truncate the basename to 8 characters.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
168 (if (> firstdot 8)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
169 (setq string (concat (substring string 0 8)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
170 "."
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
171 (substring string (1+ firstdot))))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
172 ((> strlen 8)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
173 ;; 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
174 (setq string (substring string 0 8))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
175 ;; 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
176 ;; 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
177 ;; a backup file retains its final `~'.
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
178 (if (equal lastchar ?~)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
179 (aset string (1- (length string)) lastchar))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
180 (concat (if (and (stringp dir)
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
181 (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
182 (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
183 "/")
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
184 ;; 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
185 (dos-8+3-filename dir))
37257
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
186 string))))))
6bbf8e77d787 (dos-truncate-to-8+3): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 29966
diff changeset
187
22070
d8e53123116c (dos-ps-printer, dos-printer, msdos-shells):
Richard M. Stallman <rms@gnu.org>
parents: 21568
diff changeset
188 ;; See dos-vars.el for defcustom.
d8e53123116c (dos-ps-printer, dos-printer, msdos-shells):
Richard M. Stallman <rms@gnu.org>
parents: 21568
diff changeset
189 (defvar msdos-shells)
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190
24515
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
191 ;;; Override setting chosen at startup.
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
192 (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
193 (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
194 (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
195 '(undecided-dos . undecided-dos)
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
196 '(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
197
ef4a540c34ff (set-default-process-coding-system): Copied from dos-w32.el.
Andrew Innes <andrewi@gnu.org>
parents: 22676
diff changeset
198 (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
199
16690
97029c2699a7 (register-name-alist): Use defvar.
Richard M. Stallman <rms@gnu.org>
parents: 16027
diff changeset
200 (defvar register-name-alist
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 '((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
202 (cflag . 6) (flags . 7)
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
203 (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
204 (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
205
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 (defun make-register ()
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (make-vector 8 0))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 (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
210 (let ((where (cdr (assoc name register-name-alist))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (cond ((consp where)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 (let ((tem (aref regs (car where))))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 (if (zerop (cdr where))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 (% tem 256)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 (/ tem 256))))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 ((numberp where)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (aref regs where))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 (t nil))))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 (defun set-register-value (regs name value)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 (and (numberp value)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
222 (>= value 0)
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
223 (let ((where (cdr (assoc name register-name-alist))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (cond ((consp where)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
225 (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
226 (value (logand value 255)))
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
227 (aset regs
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
228 (car where)
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
229 (if (zerop (cdr where))
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
230 (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
231 (logior (logand tem 255) (lsh value 8))))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 ((numberp where)
7256
0f06f87f3c3b (set-register-value): Setting the high byte of a
Richard M. Stallman <rms@gnu.org>
parents: 7087
diff changeset
233 (aset regs where (logand value 65535))))))
5443
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 regs)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (defsubst intdos (regs)
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (int86 33 regs))
391bfbbb9c1d Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238
14380
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
239 ;; 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
240 ;; set screen size.
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
241
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
242 (defun mode25 ()
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
243 "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
244 (interactive)
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
245 (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
246
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
247 (defun mode4350 ()
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
248 "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
249 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
250 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
251 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
252 (interactive)
874cd82cd2b4 (mode25): Moved from `src/dosfns.c' for backward compatibility.
Richard M. Stallman <rms@gnu.org>
parents: 14189
diff changeset
253 (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
254 (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
255 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
256 (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
257
14189
557b3d11a381 (ps-lpr-switches, ps-lpr-command): Just setq them;
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
258 (provide 'dos-fns)
557b3d11a381 (ps-lpr-switches, ps-lpr-command): Just setq them;
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
259
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49588
diff changeset
260 ;;; 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
261 ;;; dos-fns.el ends here