Commit 531bedc3 authored by Miles Bader's avatar Miles Bader
Browse files

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
parent 3dcef10b
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.
......
......@@ -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 @@ Deleting parts may malfunction or destroy the article; continue? ")
(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 @@ Deleting parts may malfunction or destroy the article; continue? ")
(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 @@ If displaying \"text/html\" is discouraged \(see
(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 @@ not have a face in `gnus-article-boring-faces'."
(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."
......
......@@ -1459,6 +1459,9 @@ Return nil otherwise."
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)
......
......@@ -4671,7 +4671,9 @@ If NOW, use that time instead."
(* 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) ?_))
......
......@@ -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 @@ external if displayed external."
;;; 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 @@ string if you do not like underscores."
(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? "
......
......@@ -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 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
(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)
......
......@@ -464,7 +464,8 @@ value of `mm-uu-text-plain-type'."
(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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment