From: yamaoka Date: Tue, 5 Mar 2002 22:59:50 +0000 (+0000) Subject: Synch with Oort Gnus. X-Git-Tag: t-gnus-6_15_6-01-quimby~18 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9f3a6724a9d8bf59608aa8e447388f46ad39c071;p=elisp%2Fgnus.git- Synch with Oort Gnus. --- diff --git a/ChangeLog b/ChangeLog index 3f5d92a..2644a39 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2002-03-05 Katsumi Yamaoka + + * lisp/message.el (mm-make-temp-file): Copied from mm-util.el. + 2002-03-04 Katsumi Yamaoka * lisp/message.el (message-fix-before-sending): Bind diff --git a/contrib/ChangeLog b/contrib/ChangeLog index fc27e8c..9658294 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,7 @@ +2002-03-05 ShengHuo ZHU + + * xml.el: Sync with Emacs 21. + 2002-01-25 Josh Huber * gpg.el (gpg-command-decrypt): Enable the status-fd command line diff --git a/contrib/xml.el b/contrib/xml.el index d128b83..a495721 100644 --- a/contrib/xml.el +++ b/contrib/xml.el @@ -73,32 +73,30 @@ ;;** ;;******************************************************************* -(defmacro xml-node-name (node) +(defsubst xml-node-name (node) "Return the tag associated with NODE. The tag is a lower-case symbol." - (list 'car node)) + (car node)) -(defmacro xml-node-attributes (node) +(defsubst xml-node-attributes (node) "Return the list of attributes of NODE. The list can be nil." - (list 'nth 1 node)) + (nth 1 node)) -(defmacro xml-node-children (node) +(defsubst xml-node-children (node) "Return the list of children of NODE. This is a list of nodes, and it can be nil." - (list 'cddr node)) + (cddr node)) (defun xml-get-children (node child-name) "Return the children of NODE whose tag is CHILD-NAME. CHILD-NAME should be a lower case symbol." - (let ((children (xml-node-children node)) - match) - (while children - (if (car children) - (if (equal (xml-node-name (car children)) child-name) - (set 'match (append match (list (car children)))))) - (set 'children (cdr children))) - match)) + (let ((match ())) + (dolist (child (xml-node-children node)) + (if child + (if (equal (xml-node-name child) child-name) + (push child match)))) + (nreverse match))) (defun xml-get-attribute (node attribute) "Get from NODE the value of ATTRIBUTE. @@ -155,16 +153,17 @@ and returned as the first element of the list" (forward-char -1) (if (null xml) (progn - (set 'result (xml-parse-tag end parse-dtd)) + (setq result (xml-parse-tag end parse-dtd)) (cond + ((null result)) ((listp (car result)) - (set 'dtd (car result)) + (setq dtd (car result)) (add-to-list 'xml (cdr result))) (t (add-to-list 'xml result)))) ;; translation of rule [1] of XML specifications - (error "XML files can have only one toplevel tag."))) + (error "XML files can have only one toplevel tag"))) (goto-char end))) (if parse-dtd (cons dtd (reverse xml)) @@ -197,7 +196,7 @@ Returns one of: ((looking-at "" end) - (skip-chars-forward " \t\n") - (xml-parse-tag end)) + nil) ;; end tag ((looking-at " \t\n]+\\)") - (let* ((node-name (match-string 1)) - (children (list (intern node-name))) - (case-fold-search nil) ;; XML is case-sensitive + (goto-char (match-end 1)) + (let* ((case-fold-search nil) ;; XML is case-sensitive. + (node-name (match-string 1)) + ;; Parse the attribute list. + (children (list (xml-parse-attlist end) (intern node-name))) pos) - (goto-char (match-end 1)) - - ;; parses the attribute list - (set 'children (append children (list (xml-parse-attlist end)))) ;; is this an empty element ? (if (looking-at "/>") (progn (forward-char 2) - (skip-chars-forward " \t\n") - (append children '(""))) + (nreverse (cons '("") children))) ;; is this a valid start tag ? - (if (= (char-after) ?>) + (if (eq (char-after) ?>) (progn (forward-char 1) - (skip-chars-forward " \t\n") - ;; Now check that we have the right end-tag. Note that this one might - ;; contain spaces after the tag name + ;; Now check that we have the right end-tag. Note that this + ;; one might contain spaces after the tag name (while (not (looking-at (concat ""))) (cond ((looking-at " (point) end) - (error "XML: End tag for %s not found before end of region." + (error "XML: End tag for %s not found before end of region" node-name)) - children - ) + (nreverse children)) ;; This was an invalid start tag (error "XML: Invalid attribute list") )))) (t ;; This is not a tag. - (error "XML: Invalid character.")) + (error "XML: Invalid character")) )) (defun xml-parse-attlist (end) "Return the attribute-list that point is looking at. The search for attributes end at the position END in the current buffer. Leaves the point on the first non-blank character after the tag." - (let ((attlist '()) + (let ((attlist ()) name) (skip-chars-forward " \t\n") (while (looking-at "\\([a-zA-Z_:][-a-zA-Z0-9._:]*\\)[ \t\n]*=[ \t\n]*") - (set 'name (intern (match-string 1))) + (setq name (intern (match-string 1))) (goto-char (match-end 0)) ;; Do we have a string between quotes (or double-quotes), ;; or a simple word ? - (unless (looking-at "\"\\([^\"]+\\)\"") - (unless (looking-at "'\\([^\"]+\\)'") - (error "XML: Attribute values must be given between quotes."))) + (unless (looking-at "\"\\([^\"]*\\)\"") + (unless (looking-at "'\\([^']*\\)'") + (error "XML: Attribute values must be given between quotes"))) ;; Each attribute must be unique within a given element (if (assoc name attlist) - (error "XML: each attribute must be unique within an element.")) + (error "XML: each attribute must be unique within an element")) - (set 'attlist (append attlist - (list (cons name (match-string-no-properties 1))))) + (push (cons name (match-string-no-properties 1)) attlist) (goto-char (match-end 0)) (skip-chars-forward " \t\n") (if (> (point) end) - (error "XML: end of attribute list not found before end of region.")) + (error "XML: end of attribute list not found before end of region")) ) - attlist - )) + (nreverse attlist))) ;;******************************************************************* ;;** @@ -335,25 +332,25 @@ This follows the rule [28] in the XML specifications." (defun xml-parse-dtd (end) "Parse the DTD that point is looking at. The DTD must end before the position END in the current buffer." - (let (dtd type element end-pos) - (forward-char (length "") - (error "XML: invalid DTD (excepting name of the document)")) - - ;; Get the name of the document - (looking-at "\\sw+") - (set 'dtd (list 'dtd (match-string-no-properties 0))) + (forward-char (length "") + (error "XML: invalid DTD (excepting name of the document)")) + + ;; Get the name of the document + (looking-at "\\sw+") + (let ((dtd (list (match-string-no-properties 0) 'dtd)) + type element end-pos) (goto-char (match-end 0)) (skip-chars-forward " \t\n") ;; External DTDs => don't know how to handle them yet (if (looking-at "SYSTEM") - (error "XML: Don't know how to handle external DTDs.")) + (error "XML: Don't know how to handle external DTDs")) (if (not (= (char-after) ?\[)) - (error "XML: Unknown declaration in the DTD.")) + (error "XML: Unknown declaration in the DTD")) ;; Parse the rest of the DTD (forward-char 1) @@ -367,16 +364,16 @@ The DTD must end before the position END in the current buffer." (setq element (intern (match-string-no-properties 1)) type (match-string-no-properties 2)) - (set 'end-pos (match-end 0)) + (setq end-pos (match-end 0)) ;; Translation of rule [46] of XML specifications (cond ((string-match "^EMPTY[ \t\n]*$" type) ;; empty declaration - (set 'type 'empty)) + (setq type 'empty)) ((string-match "^ANY[ \t\n]*$" type) ;; any type of contents - (set 'type 'any)) + (setq type 'any)) ((string-match "^(\\(.*\\))[ \t\n]*$" type) ;; children ([47]) - (set 'type (xml-parse-elem-type (match-string-no-properties 1 type)))) + (setq type (xml-parse-elem-type (match-string-no-properties 1 type)))) ((string-match "^%[^;]+;[ \t\n]*$" type) ;; substitution nil) (t @@ -384,13 +381,12 @@ The DTD must end before the position END in the current buffer." ;; rule [45]: the element declaration must be unique (if (assoc element dtd) - (error "XML: elements declaration must be unique in a DTD (<%s>)." + (error "XML: elements declaration must be unique in a DTD (<%s>)" (symbol-name element))) ;; Store the element in the DTD - (set 'dtd (append dtd (list (list element type)))) - (goto-char end-pos) - ) + (push (list element type) dtd) + (goto-char end-pos)) (t @@ -400,8 +396,7 @@ The DTD must end before the position END in the current buffer." ;; Skip the end of the DTD (search-forward ">" end) - dtd - )) + (nreverse dtd))) (defun xml-parse-elem-type (string) @@ -413,11 +408,11 @@ The DTD must end before the position END in the current buffer." (setq elem (match-string 1 string) modifier (match-string 2 string)) (if (string-match "|" elem) - (set 'elem (append '(choice) + (setq elem (cons 'choice (mapcar 'xml-parse-elem-type (split-string elem "|")))) (if (string-match "," elem) - (set 'elem (append '(seq) + (setq elem (cons 'seq (mapcar 'xml-parse-elem-type (split-string elem ",")))) ))) @@ -425,19 +420,18 @@ The DTD must end before the position END in the current buffer." (setq elem (match-string 1 string) modifier (match-string 2 string)))) - (if (and (stringp elem) - (string= elem "#PCDATA")) - (set 'elem 'pcdata)) + (if (and (stringp elem) (string= elem "#PCDATA")) + (setq elem 'pcdata)) - (cond - ((string= modifier "+") - (list '+ elem)) - ((string= modifier "*") - (list '* elem)) - ((string= modifier "?") - (list '? elem)) - (t - elem)))) + (cond + ((string= modifier "+") + (list '+ elem)) + ((string= modifier "*") + (list '* elem)) + ((string= modifier "?") + (list '? elem)) + (t + elem)))) ;;******************************************************************* @@ -449,15 +443,15 @@ The DTD must end before the position END in the current buffer." (defun xml-substitute-special (string) "Return STRING, after subsituting special XML sequences." (while (string-match "&" string) - (set 'string (replace-match "&" t nil string))) + (setq string (replace-match "&" t nil string))) (while (string-match "<" string) - (set 'string (replace-match "<" t nil string))) + (setq string (replace-match "<" t nil string))) (while (string-match ">" string) - (set 'string (replace-match ">" t nil string))) + (setq string (replace-match ">" t nil string))) (while (string-match "'" string) - (set 'string (replace-match "'" t nil string))) + (setq string (replace-match "'" t nil string))) (while (string-match """ string) - (set 'string (replace-match "\"" t nil string))) + (setq string (replace-match "\"" t nil string))) string) ;;******************************************************************* @@ -468,50 +462,39 @@ The DTD must end before the position END in the current buffer." ;;******************************************************************* (defun xml-debug-print (xml) - (while xml - (xml-debug-print-internal (car xml) "") - (set 'xml (cdr xml))) - ) + (dolist (node xml) + (xml-debug-print-internal node ""))) -(defun xml-debug-print-internal (xml &optional indent-string) +(defun xml-debug-print-internal (xml indent-string) "Outputs the XML tree in the current buffer. The first line indented with INDENT-STRING." (let ((tree xml) attlist) - (unless indent-string - (set 'indent-string "")) - (insert indent-string "<" (symbol-name (xml-node-name tree))) ;; output the attribute list - (set 'attlist (xml-node-attributes tree)) + (setq attlist (xml-node-attributes tree)) (while attlist (insert " ") (insert (symbol-name (caar attlist)) "=\"" (cdar attlist) "\"") - (set 'attlist (cdr attlist))) + (setq attlist (cdr attlist))) (insert ">") - (set 'tree (xml-node-children tree)) + (setq tree (xml-node-children tree)) ;; output the children - (while tree + (dolist (node tree) (cond - ((listp (car tree)) + ((listp node) (insert "\n") - (xml-debug-print-internal (car tree) (concat indent-string " ")) - ) - ((stringp (car tree)) - (insert (car tree)) - ) + (xml-debug-print-internal node (concat indent-string " "))) + ((stringp node) (insert node)) (t - (error "Invalid XML tree"))) - (set 'tree (cdr tree)) - ) + (error "Invalid XML tree")))) (insert "\n" indent-string - "") - )) + ""))) (provide 'xml) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d58c256..5db824f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,29 @@ +2002-03-05 ShengHuo ZHU + + * message.el (message-syntax-checks): Because canlock is + supported, we disable sender syntax check. + (message-shoot-gnksa-feet): Add cancel-messages option doc. + + * gnus-draft.el (gnus-draft-send): If interactive, use its default + value of message-syntax-checks. + + * qp.el (quoted-printable-decode-region): Doc addition. + From: Eli Zaretskii + + * mail-source.el (make-source-make-complex-temp-name): Use + make-temp-file. + + * mm-util.el (mm-make-temp-file): New function. + * nneething.el (nneething-file-name): Use it. + * mml-smime.el (mml-smime-encrypt): Ditto. + * mm-view.el (mm-inline-wash-with-file): Ditto. + * mm-decode.el (mm-display-external, mm-create-image-xemacs): Ditto. + * gnus-uu.el (gnus-uu-decode-binhex, gnus-uu-decode-binhex-view) + (gnus-uu-digest-mail-forward, gnus-uu-initialize): Ditto. + * gnus-start.el (gnus-slave-save-newsrc): Ditto. + * gnus-fun.el (gnus-convert-image-to-gray-x-face): Ditto. + * gnus-art.el (gnus-mime-print-part): Ditto. + 2002-03-04 Paul Jarc * message.el (nnmaildir-article-number-to-base-name): New diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index f2b7604..6d620b0 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -4247,7 +4247,7 @@ General format specifiers can also be used. See (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (file (make-temp-name (expand-file-name "mm." mm-tmp-directory))) + (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) (printer (mailcap-mime-info (mm-handle-type handle) "print"))) (when contents (if printer diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index b2fbed5..55fffd1 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -132,7 +132,7 @@ (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (let ((message-syntax-checks (if interactive nil + (let ((message-syntax-checks (if interactive message-syntax-checks 'dont-check-for-anything-just-trust-me)) (message-inhibit-body-encoding (or (not group) (equal group "nndraft:queue") diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index 473470b..57803e5 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -75,7 +75,8 @@ Output to the current buffer, replace text, and don't mingle error." (shell-quote-argument file))))) (defun gnus-convert-image-to-gray-x-face (file depth) - (let* ((mapfile (make-temp-name (expand-file-name "gnus." mm-tmp-directory))) + (let* ((mapfile (mm-make-temp-file (expand-file-name "gnus." + mm-tmp-directory))) (levels (expt 2 depth)) (step (/ 255 (1- levels))) color-alist bits bits-list mask pixel x-faces) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 8f9befe..a476275 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2745,7 +2745,7 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (save-excursion (set-buffer gnus-dribble-buffer) (let ((slave-name - (make-temp-name (concat gnus-current-startup-file "-slave-"))) + (mm-make-temp-file (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) (gnus-write-buffer-as-coding-system gnus-ding-file-coding-system diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 26a36bb..1c52075 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -406,7 +406,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." gnus-uu-default-dir gnus-uu-default-dir)))) (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) + (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-uu-view (&optional n) @@ -459,7 +459,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-file-name "Unbinhex, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir))) (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) + (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) @@ -470,7 +470,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Digests and forwards all articles in this series." (interactive "P") (let ((gnus-uu-save-in-digest t) - (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward"))) + (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward"))) (message-forward-as-mime message-forward-as-mime) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) @@ -1732,8 +1732,7 @@ Gnus might fail to display all of it.") gnus-uu-tmp-dir))) (setq gnus-uu-work-dir - (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) - (gnus-make-directory gnus-uu-work-dir) + (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) (set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (push (cons gnus-newsgroup-name gnus-uu-work-dir) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index bc2314d..5cf4016 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -471,13 +471,16 @@ Return the number of files that were found." (error "Cannot get new mail")) 0))))))))) -(defun mail-source-make-complex-temp-name (prefix) - (let ((newname (make-temp-name prefix)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)) +(eval-and-compile + (if (fboundp 'make-temp-file) + (defalias 'mail-source-make-complex-temp-name 'make-temp-file) + (defun mail-source-make-complex-temp-name (prefix) + (let ((newname (make-temp-name prefix)) + (newprefix prefix)) + (while (file-exists-p newname) + (setq newprefix (concat newprefix "x")) + (setq newname (make-temp-name newprefix))) + newname)))) (defun mail-source-callback (callback info) "Call CALLBACK on the mail file, and then remove the mail file. diff --git a/lisp/message.el b/lisp/message.el index 0b159ed..165d8cb 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -203,7 +203,14 @@ Otherwise, most addresses look like `angles', but they look like (const default)) :group 'message-headers) -(defcustom message-syntax-checks nil +(defcustom message-insert-canlock t + "Whether to insert a Cancel-Lock header in news postings." + :version "21.3" + :group 'message-headers + :type 'boolean) + +(defcustom message-syntax-checks + (if message-insert-canlock '((sender . disabled)) nil) ;; Guess this one shouldn't be easy to customize... "*Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add @@ -1025,8 +1032,9 @@ feet of Good Net-Keeping Seal of Approval. The following are foot candidates: `empty-article' Allow you to post an empty article; `quoted-text-only' Allow you to post quoted text only; -`multiple-copies' Allow you to post multiple copies.") -;; `cancel-messages' Allow you to cancel or supersede others' messages. +`multiple-copies' Allow you to post multiple copies; +`cancel-messages' Allow you to cancel or supersede messages from + your other email addresses.") (defsubst message-gnksa-enable-p (feature) (or (not (listp message-shoot-gnksa-feet)) @@ -1311,11 +1319,7 @@ If this variable is non-nil, pose the question \"Reply to all recipients?\" before a wide reply to multiple recipients. If the user answers yes, reply to all recipients as usual. If the user answers no, only reply back to the author." - :group 'message-headers - :type 'boolean) - -(defcustom message-insert-canlock t - "Whether to insert a Cancel-Lock header in news postings." + :version "21.3" :group 'message-headers :type 'boolean) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 66f203c..0377cfa 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -669,8 +669,8 @@ external if displayed external." (mm-handle-set-undisplayer handle mm))))) ;; The function is a string to be executed. (mm-insert-part handle) - (let* ((dir (make-temp-name - (expand-file-name "emm." mm-tmp-directory))) + (let* ((dir (mm-make-temp-file + (expand-file-name "emm." mm-tmp-directory) 'dir)) (filename (or (mail-content-type-get (mm-handle-disposition handle) 'filename) @@ -683,14 +683,13 @@ external if displayed external." (copiousoutput (assoc "copiousoutput" mime-info)) file buffer) ;; We create a private sub-directory where we store our files. - (make-directory dir) (set-file-modes dir 448) (if filename (setq file (expand-file-name (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)) dir)) - (setq file (make-temp-name (expand-file-name "mm." dir)))) + (setq file (mm-make-temp-file (expand-file-name "mm." dir)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) (message "Viewing with %s" method) @@ -1171,7 +1170,7 @@ be determined." ;; (without a ton of work) is to write them ;; out to a file, and then create a file ;; specifier. - (let ((file (make-temp-name + (let ((file (mm-make-temp-file (expand-file-name "emm.xbm" mm-tmp-directory)))) (unwind-protect diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 3a58cb5..93a595c 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -783,6 +783,20 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." (t 'iso-8859-1)))) +;; It is not a MIME function, but some MIME functions use it. +(defalias 'mm-make-temp-file + (if (fboundp 'make-temp-file) + '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)))) + (provide 'mm-util) ;;; mm-util.el ends here diff --git a/lisp/mm-view.el b/lisp/mm-view.el index f40257c..2a096ab 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -311,7 +311,7 @@ will not be substituted.") (delete-region (match-beginning 0) (match-end 0)))) (defun mm-inline-wash-with-file (post-func cmd &rest args) - (let ((file (make-temp-name + (let ((file (mm-make-temp-file (expand-file-name "mm" mm-tmp-directory)))) (let ((coding-system-for-write 'binary)) (write-region (point-min) (point-max) file nil 'silent)) diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index d5baf3f..2eec919 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -45,7 +45,8 @@ (if (not (and (not (file-exists-p tmp)) (get-buffer tmp))) (push tmp certfiles) - (setq file (make-temp-name mm-tmp-directory)) + (setq file (mm-make-temp-file (expand-file-name "mml." + mm-tmp-directory))) (with-current-buffer tmp (write-region (point-min) (point-max) file)) (push file certfiles) diff --git a/lisp/nneething.el b/lisp/nneething.el index 628e2a4..420d7f9 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -521,7 +521,7 @@ This variable is used as the alternative of `mailcap-mime-extensions'.") (if (numberp article) (if (setq fname (cadr (assq article nneething-map))) (expand-file-name fname dir) - (make-temp-name (expand-file-name "nneething" dir))) + (mm-make-temp-file (expand-file-name "nneething" dir))) (expand-file-name article dir)))) (provide 'nneething) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 1db7d6d..0235b0c 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -239,7 +239,21 @@ Equivalent to `progn' in XEmacs" ((boundp 'MULE) (lambda nil mc-flag)) (t - (lambda nil enable-multibyte-characters))))) + (lambda nil enable-multibyte-characters)))) + + ;; Should keep track of the same alias in mm-util.el. + (defalias 'mm-make-temp-file + (if (fboundp 'make-temp-file) + '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))))) ;; mail-parse stuff. (unless (featurep 'mail-parse) diff --git a/lisp/qp.el b/lisp/qp.el index 75d6779..52f6999 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -35,7 +35,10 @@ (defun quoted-printable-decode-region (from to &optional coding-system) "Decode quoted-printable in the region between FROM and TO, per RFC 2045. If CODING-SYSTEM is non-nil, decode bytes into characters with that -coding-system." +coding-system. + +Interactively, you can supply the CODING-SYSTEM argument +with \\[universal-coding-system-argument]." (interactive ;; Let the user determine the coding system with "C-x RET c". (list (region-beginning) (region-end) coding-system-for-read))