Mercurial > emacs
changeset 69572:b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 58-61)
- Update from CVS
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Sun, 19 Mar 2006 19:39:53 +0000 |
| parents | 4f6b547120ec |
| children | 96795267cd9b e3bacb89536a |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-util.el lisp/gnus/message.el lisp/gnus/mm-decode.el lisp/gnus/mm-extern.el lisp/gnus/mm-uu.el |
| diffstat | 7 files changed, 160 insertions(+), 75 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Sun Mar 19 19:38:48 2006 +0000 +++ b/lisp/gnus/ChangeLog Sun Mar 19 19:39:53 2006 +0000 @@ -1,3 +1,38 @@ +2006-03-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-decode.el (mm-with-part): New macro. + (mm-get-part): Use it; work with message/external-body as well. + (mm-save-part): Treat name and filename equally. + + * mm-extern.el (mm-extern-cache-contents): New function. + (mm-inline-external-body): Use it; force the part to be displayed; + move undisplayer added to the cached handle to the parent. + + * gnus-art.el (gnus-mime-save-part-and-strip): Add name parameter. + (gnus-mime-view-part-as-type): Work with message/external-body. + + * gnus-util.el (gnus-tool-bar-update): Bind tool-bar-mode. + +2006-03-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> + + * gnus-art.el (gnus-article-only-boring-p): Bind + inhibit-point-motion-hooks to avoid infinite loop when entering + intangible text. Reported by Ralf Wachinger + <rwnewsmampfer@geekmail.de>. + +2006-03-14 Simon Josefsson <jas@extundo.com> + + * message.el (message-unique-id): Don't use message-number-base36 + if (user-uid) is a float. Reported by Bjorn Solberg + <bjorn_ding1@hekneby.org>. + +2006-03-13 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-uu.el (mm-uu-dissect): Dissect all parts correctly. + + * gnus-art.el (gnus-mime-display-single): Make sure there is an + empty line between a part and a message part. + 2006-03-10 Reiner Steib <Reiner.Steib@gmx.de> * smiley.el: Add more test smileys.
--- a/lisp/gnus/gnus-art.el Sun Mar 19 19:38:48 2006 +0000 +++ b/lisp/gnus/gnus-art.el Sun Mar 19 19:39:53 2006 +0000 @@ -49,6 +49,7 @@ (autoload 'gnus-button-mailto "gnus-msg") (autoload 'gnus-button-reply "gnus-msg" nil t) (autoload 'parse-time-string "parse-time" nil nil) +(autoload 'mm-extern-cache-contents "mm-extern") (defgroup gnus-article nil "Article display." @@ -4151,6 +4152,9 @@ (insert "Content-Type: " (mm-handle-media-type data)) (mml-insert-parameter-string (cdr (mm-handle-type data)) '(charset)) + ;; Add a filename for the sake of saving the part again. + (mml-insert-parameter + (mail-header-encode-parameter "name" (file-name-nondirectory file))) (insert "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: binary\n") @@ -4330,6 +4334,10 @@ (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) (when handle + (when (equal (mm-handle-media-type handle) "message/external-body") + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (setq handle (mm-handle-cache handle))) (setq handle (mm-make-handle (mm-handle-buffer handle) (cons mime-type (cdr (mm-handle-type handle))) @@ -4889,13 +4897,18 @@ (let ((id (1+ (length gnus-article-mime-handle-alist))) beg) (push (cons id handle) gnus-article-mime-handle-alist) + (when (and display + (equal (mm-handle-media-supertype handle) "message")) + (insert-char + ?\n + (cond ((not (bolp)) 2) + ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0) + (t 1)))) (when (or (not display) (not (gnus-unbuttonized-mime-type-p type))) - ;(gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display (and not-attachment text)))) (gnus-article-insert-newline) - ;(gnus-article-insert-newline) ;; Remember modify the number of forward lines. (setq move t)) (setq beg (point)) @@ -5313,14 +5326,15 @@ (boundp 'gnus-article-boring-faces) (symbol-value 'gnus-article-boring-faces)) (save-excursion - (catch 'only-boring - (while (re-search-forward "\\b\\w\\w" nil t) - (forward-char -1) - (when (not (gnus-intersection - (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces))) - (throw 'only-boring nil))) - (throw 'only-boring t))))) + (let ((inhibit-point-motion-hooks t)) + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (gnus-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces))) + (throw 'only-boring nil))) + (throw 'only-boring t)))))) (defun gnus-article-refer-article () "Read article specified by message-id around point."
--- a/lisp/gnus/gnus-util.el Sun Mar 19 19:38:48 2006 +0000 +++ b/lisp/gnus/gnus-util.el Sun Mar 19 19:39:53 2006 +0000 @@ -1459,6 +1459,9 @@ display)) display))))) +(eval-when-compile + (defvar tool-bar-mode)) + (defun gnus-tool-bar-update (&rest ignore) "Update the tool bar." (when (and (boundp 'tool-bar-mode)
--- a/lisp/gnus/message.el Sun Mar 19 19:38:48 2006 +0000 +++ b/lisp/gnus/message.el Sun Mar 19 19:39:53 2006 +0000 @@ -4671,7 +4671,9 @@ (* 25 25))) (let ((tm (current-time))) (concat - (if (memq system-type '(ms-dos emx vax-vms)) + (if (or (memq system-type '(ms-dos emx vax-vms)) + ;; message-number-base36 doesn't handle bigints. + (floatp (user-uid))) (let ((user (downcase (user-login-name)))) (while (string-match "[^a-z0-9_]" user) (aset user (match-beginning 0) ?_))
--- a/lisp/gnus/mm-decode.el Sun Mar 19 19:38:48 2006 +0000 +++ b/lisp/gnus/mm-decode.el Sun Mar 19 19:39:53 2006 +0000 @@ -36,6 +36,7 @@ (autoload 'executable-find "executable") (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") + (autoload 'mm-extern-cache-contents "mm-extern") (autoload 'mm-insert-inline "mm-view")) (defvar gnus-current-window-configuration) @@ -1082,17 +1083,35 @@ ;;; Functions for outputting parts ;;; +(defmacro mm-with-part (handle &rest forms) + "Run FORMS in the temp buffer containing the contents of HANDLE." + `(let* ((handle ,handle) + ;; The multibyteness of the temp buffer should be turned on + ;; if inserting a multibyte string. Contrarily, the buffer's + ;; multibyteness should be off if inserting a unibyte string, + ;; especially if a string contains 8bit data. + (default-enable-multibyte-characters + (with-current-buffer (mm-handle-buffer handle) + (mm-multibyte-p)))) + (with-temp-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-disable-multibyte) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + ,@forms))) +(put 'mm-with-part 'lisp-indent-function 1) +(put 'mm-with-part 'edebug-form-spec '(body)) + (defun mm-get-part (handle) "Return the contents of HANDLE as a string." - (let ((default-enable-multibyte-characters - (with-current-buffer (mm-handle-buffer handle) - (mm-multibyte-p)))) - (with-temp-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-disable-multibyte) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) + (if (equal (mm-handle-media-type handle) "message/external-body") + (progn + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (with-current-buffer (mm-handle-buffer (mm-handle-cache handle)) + (buffer-string))) + (mm-with-part handle (buffer-string)))) (defun mm-insert-part (handle) @@ -1148,18 +1167,19 @@ (defun mm-save-part (handle) "Write HANDLE to a file." - (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) - (filename (mail-content-type-get - (mm-handle-disposition handle) 'filename)) - file) + (let ((filename (or (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (mail-content-type-get + (mm-handle-type handle) 'name))) + file) (when filename (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file (mm-with-multibyte - (read-file-name "Save MIME part to: " - (or mm-default-directory default-directory) - nil nil (or filename name "")))) + (read-file-name "Save MIME part to: " + (or mm-default-directory default-directory) + nil nil (or filename "")))) (setq mm-default-directory (file-name-directory file)) (and (or (not (file-exists-p file)) (yes-or-no-p (format "File %s already exists; overwrite? "
--- a/lisp/gnus/mm-extern.el Sun Mar 19 19:38:48 2006 +0000 +++ b/lisp/gnus/mm-extern.el Sun Mar 19 19:39:53 2006 +0000 @@ -112,11 +112,8 @@ (insert "[" info "]\n\n"))) ;;;###autoload -(defun mm-inline-external-body (handle &optional no-display) - "Show the external-body part of HANDLE. -This function replaces the buffer of HANDLE with a buffer contains -the entire message. -If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." +(defun mm-extern-cache-contents (handle) + "Put the external-body part of HANDLE into its cache." (let* ((access-type (cdr (assq 'access-type (cdr (mm-handle-type handle))))) (func (cdr (assq (intern @@ -124,48 +121,61 @@ (or access-type (error "Couldn't find access type")))) mm-extern-function-alist))) - gnus-displaying-mime buf - handles) - (unless (mm-handle-cache handle) - (unless func - (error "Access type (%s) is not supported" access-type)) - (with-temp-buffer - (mm-insert-part handle) - (goto-char (point-max)) - (insert "\n\n") - (setq handles (mm-dissect-buffer t))) - (unless (bufferp (car handles)) - (mm-destroy-parts handles) - (error "Multipart external body is not supported")) - (save-excursion ;; single part - (set-buffer (setq buf (mm-handle-buffer handles))) - (let (good) - (unwind-protect - (progn - (funcall func handle) - (setq good t)) - (unless good - (mm-destroy-parts handles)))) - (mm-handle-set-cache handle handles)) - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles))) - (unless no-display - (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (gnus-display-mime (mm-handle-cache handle)) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (condition-case nil - ;; This is only valid on XEmacs. - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground)) - (error nil)) - (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + buf handles) + (unless func + (error "Access type (%s) is not supported" access-type)) + (mm-with-part handle + (goto-char (point-max)) + (insert "\n\n") + ;; It should be just a single MIME handle. + (setq handles (mm-dissect-buffer t))) + (unless (bufferp (car handles)) + (mm-destroy-parts handles) + (error "Multipart external body is not supported")) + (save-excursion + (set-buffer (setq buf (mm-handle-buffer handles))) + (let (good) + (unwind-protect + (progn + (funcall func handle) + (setq good t)) + (unless good + (mm-destroy-parts handles)))) + (mm-handle-set-cache handle handles)) + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handles)))) + +;;;###autoload +(defun mm-inline-external-body (handle &optional no-display) + "Show the external-body part of HANDLE. +This function replaces the buffer of HANDLE with a buffer contains +the entire message. +If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (unless no-display + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (let* ((type (regexp-quote + (mm-handle-media-type (mm-handle-cache handle)))) + ;; Force the part to be displayed (but if there is no + ;; method to display, a user will be prompted to save). + ;; See `gnus-mime-display-single'. + (mm-inline-override-types nil) + (mm-attachment-override-types + (cons type mm-attachment-override-types)) + (mm-automatic-display (cons type mm-automatic-display)) + (mm-automatic-external-display + (cons type mm-automatic-external-display)) + ;; Suppress adding of button to the cached part. + (gnus-inhibit-mime-unbuttonizing nil)) + (gnus-display-mime (mm-handle-cache handle))) + ;; Move undisplayer added to the cached handle to the parent. + (mm-handle-set-undisplayer + handle + (mm-handle-undisplayer (mm-handle-cache handle))) + (mm-handle-set-undisplayer (mm-handle-cache handle) nil))))) (provide 'mm-extern)
--- a/lisp/gnus/mm-uu.el Sun Mar 19 19:38:48 2006 +0000 +++ b/lisp/gnus/mm-uu.el Sun Mar 19 19:39:53 2006 +0000 @@ -464,7 +464,8 @@ (t (goto-char (point-max)))) (setq text-start (point)) (while (re-search-forward mm-uu-beginning-regexp nil t) - (setq start-point (match-beginning 0)) + (setq start-point (match-beginning 0) + entry nil) (let ((alist mm-uu-type-alist) (beginning-regexp (match-string 0))) (while (not entry)