From: Eli Zaretskii Date: Wed, 28 Jun 2000 04:40:29 +0000 (+0000) Subject: (convert-standard-filename): Fix last change. X-Git-Tag: emacs-pretest-21.0.90~3045 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9d47450f738b7c89a310057a287fb313b6cf20e8;p=emacs.git (convert-standard-filename): Fix last change. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d5cf54fe107..7634c8caa4d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2000-06-28 Eli Zaretskii + + * dos-fns.el (convert-standard-filename): Fix last change. + 2000-06-27 Gerd Moellmann * help.el (describe-variable): Don't insert a second `'s' in front diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index d4fb12c1927..8037de4f54c 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el @@ -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)