From: yamaoka Date: Tue, 14 Feb 2006 11:50:47 +0000 (+0000) Subject: Synch to No Gnus 200602141150. X-Git-Tag: t-gnus-6_17_4-quimby-~98 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=91713cea79d02882fd48f4b69a3bb658103ed3bb;p=elisp%2Fgnus.git- Synch to No Gnus 200602141150. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d67e5f9..5aa990d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,17 @@ 2006-02-14 Katsumi Yamaoka + * mm-util.el (mm-make-temp-file): Import the Emacs 22 version of + make-temp-file; make it work with XEmacs as well. + + * gnus-art.el (gnus-article-browse-html-parts): Use the 3rd arg of + mm-make-temp-file. + + * mm-decode.el (mm-display-external): Use the 3rd arg of + mm-make-temp-file. + (mm-create-image-xemacs): Ditto. + +2006-02-14 Katsumi Yamaoka + * gnus-draft.el (gnus-draft-send): Replace message-narrow-to-head with message-narrow-to-headers. (gnus-draft-setup): Narrow to header to run message-fetch-field. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index bc88545..fe96f3d 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2726,10 +2726,9 @@ Recurse into multiparts." (when (listp handle) (cond ((and (bufferp (car handle)) (string-match "text/html" (car (mm-handle-type handle)))) - (let ((tmp-file - (concat (mm-make-temp-file - ;; Do we need to care for 8.3 filenames? - (format "mm-") nil) ".html"))) + (let ((tmp-file (mm-make-temp-file + ;; Do we need to care for 8.3 filenames? + "mm-" nil ".html"))) (mm-save-part-to-file handle tmp-file) (browse-url tmp-file) (setq showed t))) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index d594df8..af2049d 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -763,19 +763,18 @@ external if displayed external." (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)) dir)) - (setq file (mm-make-temp-file (expand-file-name "mm." dir))) - (let ((newname - ;; Use nametemplate (defined in RFC1524) if it is - ;; specified in mailcap. - (if (assoc "nametemplate" mime-info) - (format (cdr (assoc "nametemplate" mime-info)) file) - ;; Add a suffix according to `mailcap-mime-extensions'. - (concat file (car (rassoc (mm-handle-media-type handle) - mailcap-mime-extensions)))))) - (unless (string-equal file newname) - (when (file-exists-p file) - (rename-file file newname)) - (setq file newname)))) + ;; Use nametemplate (defined in RFC1524) if it is specified + ;; in mailcap. + (let ((suffix (cdr (assoc "nametemplate" mime-info)))) + (if (and suffix + (string-match "\\`%s\\(\\..+\\)\\'" suffix)) + (setq suffix (match-string 1 suffix)) + ;; Otherwise, use a suffix according to + ;; `mailcap-mime-extensions'. + (setq suffix (car (rassoc (mm-handle-media-type handle) + mailcap-mime-extensions)))) + (setq file (mm-make-temp-file (expand-file-name "mm." dir) + nil suffix)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) (message "Viewing with %s" method) @@ -1307,8 +1306,8 @@ be determined." ;; out to a file, and then create a file ;; specifier. (let ((file (mm-make-temp-file - (expand-file-name "emm.xbm" - mm-tmp-directory)))) + (expand-file-name "emm" mm-tmp-directory) + nil ".xbm"))) (unwind-protect (progn (write-region (point-min) (point-max) file) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index f811953..1823b35 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -103,16 +103,6 @@ (lambda (ch) (mm-string-as-multibyte (char-to-string ch))) string ""))) (multibyte-string-p . ignore) - ;; It is not a MIME function, but some MIME functions use it. - (make-temp-file . (lambda (prefix &optional dir-flag) - (let ((file (expand-file-name - (make-temp-name prefix) - (if (fboundp 'temp-directory) - (temp-directory) - temporary-file-directory)))) - (if dir-flag - (make-directory file)) - file))) (insert-byte . insert-char) (multibyte-char-to-unibyte . identity) (special-display-p @@ -1056,6 +1046,71 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) +;; It is not a MIME function, but some MIME functions use it. +(if (and (fboundp 'make-temp-file) + (ignore-errors + (let ((def (symbol-function 'make-temp-file))) + (and (byte-code-function-p def) + (setq def (if (fboundp 'compiled-function-arglist) + ;; XEmacs + (eval (list 'compiled-function-arglist def)) + (aref def 0))) + (>= (length def) 4) + (eq (nth 3 def) 'suffix))))) + (defalias 'mm-make-temp-file 'make-temp-file) + ;; Stolen (and modified for XEmacs) from Emacs 22. + (defun mm-make-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file. +The returned file name (created by appending some random characters at the end +of PREFIX, and expanding against `temporary-file-directory' if necessary), +is guaranteed to point to a newly created empty file. +You can then use `write-region' to write new data into the file. + +If DIR-FLAG is non-nil, create a new empty directory instead of a file. + +If SUFFIX is non-nil, add that at the end of the file name." + (let ((umask (default-file-modes)) + file) + (unwind-protect + (progn + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (set-default-file-modes 448) + (while (condition-case () + (progn + (setq file + (make-temp-name + (expand-file-name + prefix + (if (fboundp 'temp-directory) + ;; XEmacs + (temp-directory) + temporary-file-directory)))) + (if suffix + (setq file (concat file suffix))) + (if dir-flag + (make-directory file) + (if (featurep 'xemacs) + ;; NOTE: This is unsafe if an XEmacs user + ;; doesn't use a secure temp directory. + (if (file-exists-p file) + (signal 'file-already-exists + (list "File exists" file)) + (write-region "" nil file nil 'silent)) + (write-region "" nil file nil 'silent + nil 'excl))) + nil) + (file-already-exists t) + ;; The XEmacs version of `make-directory' issues it. + (file-error t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file) + ;; Reset the umask. + (set-default-file-modes umask))))) + (defun mm-image-load-path (&optional package) (let (dir result) (dolist (path load-path (nreverse result))