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

(dos-truncate-to-8+3): New function.

Browse Source
This commit is contained in:
Eli Zaretskii 2001-04-06 19:03:00 +00:00
parent 63685b9d09
commit a9d3625204
1 changed files with 58 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
lisp/dos-fns.el
View File

@ -114,6 +114,64 @@ with a definition that really does change some file names."
(convert-standard-filename dir))
string))))))
(defun dos-truncate-to-8+3 (filename)
"Truncate FILENAME to DOS 8+3 limits."
(if (or (not (stringp filename))
(< (length filename) 5)) ; too short to give any trouble
filename
(let ((flen (length filename)))
;; If FILENAME has a trailing slash, remove it and recurse.
(if (memq (aref filename (1- flen)) '(?/ ?\\))
(concat (dos-truncate-to-8+3 (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)))
(strlen (length string))
(lastchar (aref string (1- strlen)))
i firstdot)
(setq firstdot (string-match "\\." string))
(cond
(firstdot
;; Truncate the extension to 3 characters.
(if (> strlen (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
;; Truncate the basename to 8 characters.
(if (> firstdot 8)
(setq string (concat (substring string 0 8)
"."
(substring string (1+ firstdot))))))
((> strlen 8)
;; No dot; truncate file name to 8 characters.
(setq string (substring string 0 8))))
;; 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 (dos-truncate-to-8+3 (substring dir 0 dlen-m-1))
"/")
;; Recurse to truncate the leading directories.
(dos-truncate-to-8+3 dir))
string))))))
;; See dos-vars.el for defcustom.
(defvar msdos-shells)