From: yamaoka <yamaoka>
Date: Fri, 22 Jun 2001 12:59:07 +0000 (+0000)
Subject: Synch with Oort Gnus.
X-Git-Tag: t-gnus-6_15_4-02-quimby-last-~10
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=107bbd435027893acf83e4aa7ef6d95faf33a4d0;p=elisp%2Fgnus.git-

Synch with Oort Gnus.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0a0f357..2bed0a2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2001-04-06  Ralph Schleicher  <rs@nunatak.allgaeu.org>
+
+	* mm-decode.el (mm-save-part): Rewrite file name.
+	(mm-file-name-rewrite-functions): New variable.
+	(mm-file-name-delete-whitespace): New function.
+	(mm-file-name-trim-whitespace): New function.
+	(mm-file-name-collapse-whitespace): New function.
+	(mm-file-name-replace-whitespace): New variable and function.
+
+2001-06-22  Simon Josefsson  <jas@extundo.com>
+
+	* message.el (message-make-date): Workaround locale for weekdays.
+
 2001-06-21 17:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
 
 	* message.el (message-goto-body): Return nil if not found. (revert!)
diff --git a/lisp/message.el b/lisp/message.el
index 631101d..9e0133c 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -3963,7 +3963,10 @@ If NOW, use that time instead."
       (setq sign "-")
       (setq zone (- zone)))
     (concat
-     (format-time-string "%a, %d" now)
+     ;; The day name of the %a spec is locale-specific.  Pfff.
+     (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now))
+					     parse-time-weekdays))))
+     (format-time-string "%d" now)
      ;; The month name of the %b spec is locale-specific.  Pfff.
      (format " %s "
 	     (capitalize (car (rassoc (nth 4 (decode-time now))
diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 0ca7321..dcb6783 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -253,6 +253,21 @@ to:
   :type 'boolean
   :group 'mime-display)
 
+(defvar mm-file-name-rewrite-functions nil
+  "*List of functions used for rewriting file names of MIME parts.
+Each function takes a file name as input and returns a file name.
+
+Ready-made functions include
+`mm-file-name-delete-whitespace',
+`mm-file-name-trim-whitespace',
+`mm-file-name-collapse-whitespace',
+`mm-file-name-replace-whitespace',
+`capitalize', `downcase', `upcase', and
+`upcase-initials'.")
+
+(defvar mm-file-name-replace-whitespace nil
+  "String used for replacing whitespace characters; default is `\"_\"'.")
+
 (defcustom mm-default-directory nil
   "The default directory where mm will save files.
 If not set, `default-directory' will be used."
@@ -856,6 +871,35 @@ external if displayed external."
 	    (set-buffer cur)
 	    (insert-buffer-substring temp)))))))
 
+(defun mm-file-name-delete-whitespace (file-name)
+  "Remove all whitespace characters from FILE-NAME."
+  (while (string-match "\\s-+" file-name)
+    (setq file-name (replace-match "" t t file-name)))
+  file-name)
+
+(defun mm-file-name-trim-whitespace (file-name)
+  "Remove leading and trailing whitespace characters from FILE-NAME."
+  (when (string-match "\\`\\s-+" file-name)
+    (setq file-name (substring file-name (match-end 0))))
+  (when (string-match "\\s-+\\'" file-name)
+    (setq file-name (substring file-name 0 (match-beginning 0))))
+  file-name)
+
+(defun mm-file-name-collapse-whitespace (file-name)
+  "Collapse multiple whitespace characters in FILE-NAME."
+  (while (string-match "\\s-\\s-+" file-name)
+    (setq file-name (replace-match " " t t file-name)))
+  file-name)
+
+(defun mm-file-name-replace-whitespace (file-name)
+  "Replace whitespace characters in FILE-NAME with underscores.
+Set `mm-file-name-replace-whitespace' to any other string if you do not
+like underscores."
+  (let ((s (or mm-file-name-replace-whitespace "_")))
+    (while (string-match "\\s-" file-name)
+      (setq file-name (replace-match s t t file-name))))
+  file-name)
+
 (defun mm-save-part (handle)
   "Write HANDLE to a file."
   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
@@ -863,7 +907,8 @@ external if displayed external."
 		    (mm-handle-disposition handle) 'filename))
 	 file)
     (when filename
-      (setq filename (file-name-nondirectory filename)))
+      (setq filename (gnus-map-function mm-file-name-rewrite-functions
+					(file-name-nondirectory filename))))
     (setq file
 	  (read-file-name "Save MIME part to: "
 			  (expand-file-name