]> code.delx.au - gnu-emacs/blobdiff - lisp/dos-fns.el
(save-abbrevs, save-some-buffers): Don't ask the user
[gnu-emacs] / lisp / dos-fns.el
index 5280280be2bef8aed598a8fba76b11a7b298f222..4b91cdf7a1b93bdaf66f76e0417a7300271bfc3f 100644 (file)
@@ -1,4 +1,4 @@
-;;; dos-fns.el --- MS-Dos specific functions.
+;;; dos-fns.el --- MS-Dos specific functions
 
 ;; Copyright (C) 1991, 1993, 1995, 1996 Free Software Foundation, Inc.
 
@@ -74,18 +74,25 @@ with a definition that really does change some file names."
            ;; Change a leading period to a leading underscore.
            (if (= (aref string 0) ?.)
                (aset string 0 ?_))
+           ;; If the name is longer than 8 chars, and doesn't have a
+           ;; period, and we have a dash or underscore that isn't too
+           ;; close to the beginning, change that to a period.  This
+           ;; is so we could salvage more characters of the original
+           ;; name by pushing them into the extension.
+           (if (and (not (string-match "\\." string))
+                    (> (length string) 8)
+                    ;; We don't gain anything if we put the period closer
+                    ;; than 5 chars from the beginning (5 + 3 = 8).
+                    (setq i (string-match "[-_]" string 5)))
+               (aset string i ?\.))
            ;; 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.
+           ;; This enables to have 3 more characters from the original
+           ;; name in the extension.
            (if (> (or (string-match "\\." string) (length string))
                   8)
                (setq string
@@ -98,13 +105,14 @@ with a definition that really does change some file names."
            (if (> (length string) (+ firstdot 4))
                (setq string (substring string 0 (+ firstdot 4))))
            ;; Change all periods except the first one into underscores.
+           ;; (DOS doesn't allow more than one period.)
            (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 ?~)
+           ;; If the last character of the original filename was `~' or `#',
+           ;; make sure the munged name ends with it also.  This is so that
+           ;; backup and auto-save files retain their telltale form.
+           (if (memq lastchar '(?~ ?#))
                (aset string (1- (length string)) lastchar))))
          (concat (if (and (stringp dir)
                           (memq (aref dir dlen-m-1) '(?/ ?\\)))
@@ -114,7 +122,7 @@ with a definition that really does change some file names."
                    (convert-standard-filename dir))
                  string))))))
 
-(defun dos-truncate-to-8+3 (filename)
+(defun dos-8+3-filename (filename)
   "Truncate FILENAME to DOS 8+3 limits."
   (if (or (not (stringp filename))
          (< (length filename) 5))      ; too short to give any trouble
@@ -122,7 +130,7 @@ with a definition that really does change some file names."
     (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)))
+         (concat (dos-8+3-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
@@ -166,12 +174,31 @@ with a definition that really does change some file names."
              (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))
+                     (concat (dos-8+3-filename (substring dir 0 dlen-m-1))
                              "/")
                    ;; Recurse to truncate the leading directories.
-                   (dos-truncate-to-8+3 dir))
+                   (dos-8+3-filename dir))
                  string))))))
 
+;; Make sure auto-save file names don't contain characters invalid for
+;; the underlying filesystem.  This is particularly annoying with
+;; `compose-mail's *mail* buffers: `*' is not allowed in file names on
+;; DOS/Windows, so Emacs bitches on you each time it tries to autosave
+;; the message being composed.
+(fset 'original-make-auto-save-file-name
+      (symbol-function 'make-auto-save-file-name))
+
+(defun make-auto-save-file-name ()
+  "Return file name to use for auto-saves of current buffer.
+Does not consider `auto-save-visited-file-name' as that variable is checked
+before calling this function.  You can redefine this for customization.
+See also `auto-save-file-name-p'."
+  (let ((filename (original-make-auto-save-file-name)))
+    ;; Don't modify remote (ange-ftp) filenames
+    (if (string-match "^/\\w+@[-A-Za-z0-9._]+:" filename)
+       filename
+      (convert-standard-filename filename))))
+
 ;; See dos-vars.el for defcustom.
 (defvar msdos-shells)
 
@@ -244,4 +271,4 @@ that your video hardware might not support 50-line mode."
 
 (provide 'dos-fns)
 
-; dos-fns.el ends here
+;;; dos-fns.el ends here