mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

(convert-standard-filename): Fix last change.

Browse Source
This commit is contained in:
Eli Zaretskii 2000-06-28 04:40:29 +00:00
parent 93e40f4000
commit 9d47450f73
2 changed files with 79 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lisp/ChangeLog
View File

@ -1,3 +1,7 @@
2000-06-28 Eli Zaretskii <eliz@is.elta.co.il>
* dos-fns.el (convert-standard-filename): Fix last change.
2000-06-27 Gerd Moellmann <gerd@gnu.org>
* help.el (describe-variable): Don't insert a second `'s' in front

139
lisp/dos-fns.el
View File

@ -35,73 +35,84 @@ This function's standard definition is trivial; it just returns the argument.
However, on some systems, the function is redefined
with a definition that really does change some file names."
(if (or (not (stringp filename))
;; Note: the empty file-name-nondirectory catches the case
;; where FILENAME is "x:" or "x:/", thus preventing infinite
;; recursion.
(string-match "\\`[a-zA-Z]:[/\\]?\\'" filename))
;; This catches the case where FILENAME is "x:" or "x:/" or
;; "/", thus preventing infinite recursion.
(string-match "\\`\\([a-zA-Z]:\\)?[/\\]?\\'" filename))
filename
;; If FILENAME has a trailing slash, remove it and recurse.
(if (memq (aref filename (1- (length filename))) '(?/ ?\\))
(concat (convert-standard-filename
(substring filename 0 (1- (length filename))))
"/")
(let* ((dir
;; If FILENAME is "x:foo", file-name-directory returns
;; "x:/bar/baz", substituting the current working
;; directory on drive x:. We want to be left with "x:"
;; instead.
(if (and (eq (aref filename 1) ?:)
(null (string-match "[/\\]" filename)))
(substring filename 0 2)
(file-name-directory filename)))
(string (copy-sequence (file-name-nondirectory filename)))
(lastchar (aref string (1- (length string))))
i firstdot)
(if (msdos-long-file-names)
(let ((flen (length filename)))
;; If FILENAME has a trailing slash, remove it and recurse.
(if (memq (aref filename (1- flen)) '(?/ ?\\))
(concat (convert-standard-filename
(substring filename 0 (1- flen)))
"/")
(let* (;; ange-ftp gets in the way for names like "/foo:bar".
;; We need to inhibit all magic file names, because
;; remote file names should never be passed through
;; this function, as they are not meant for the local
;; filesystem!
(file-name-handler-alist nil)
(dir
;; If FILENAME is "x:foo", file-name-directory returns
;; "x:/bar/baz", substituting the current working
;; directory on drive x:. We want to be left with "x:"
;; instead.
(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)
;; Replace characters that are invalid even on Windows.
(while (setq i (string-match "[?*:<>|\"\000-\037]" string))
(aset string i ?!))
;; Change a leading period to a leading underscore.
(if (= (aref string 0) ?.)
(aset string 0 ?_))
;; Get rid of invalid characters.
(while (setq i (string-match
"[^-a-zA-Z0-9_.%~^$!#&{}@`'()\200-\376]"
string))
(aset string i ?_))
;; If we don't have a period,
;; and we have a dash or underscore that isn't the first char,
;; change that to a period.
(if (and (not (string-match "\\." string))
(setq i (string-match "[-_]" string 1)))
(aset string i ?\.))
;; If we don't have a period in the first 8 chars, insert one.
(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))))
;; Truncate to 3 chars after the first period.
(if (> (length string) (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
;; Change all periods except the first one into underscores.
(while (string-match "\\." string (1+ firstdot))
(setq i (string-match "\\." string (1+ firstdot)))
(aset string i ?_))
;; If the last character of the original filename was `~',
;; make sure the munged name ends with it also.
(if (equal lastchar ?~)
(aset string (1- (length string)) lastchar)))
(concat (if (and (stringp dir)
(memq (aref dir (1- (length dir))) '(?/ ?\\)))
(concat (convert-standard-filename
(substring dir 0 (1- (length dir))))
"/")
(convert-standard-filename dir))
string)))))
(aset string i ?!)))
((not (member string '("" "." "..")))
;; Change a leading period to a leading underscore.
(if (= (aref string 0) ?.)
(aset string 0 ?_))
;; Get rid of invalid characters.
(while (setq i (string-match
"[^-a-zA-Z0-9_.%~^$!#&{}@`'()\200-\376]"
string))
(aset string i ?_))
;; If we don't have a period,
;; and we have a dash or underscore that isn't the first char,
;; change that to a period.
(if (and (not (string-match "\\." string))
(setq i (string-match "[-_]" string 1)))
(aset string i ?\.))
;; If we don't have a period in the first 8 chars, insert one.
(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))))
;; Truncate to 3 chars after the first period.
(if (> (length string) (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
;; Change all periods except the first one into underscores.
(while (string-match "\\." string (1+ firstdot))
(setq i (string-match "\\." string (1+ firstdot)))
(aset string i ?_))
;; If the last character of the original filename was `~',
;; make sure the munged name ends with it also. This is so
;; a backup file retains its final `~'.
(if (equal 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))))))
;; See dos-vars.el for defcustom.
(defvar msdos-shells)