(max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
+(defmacro gnus-with-article (article &rest forms)
+ "Select ARTICLE, copy the contents of the original article buffer to a new buffer, and then perform FORMS there.
+Then replace the article with the result."
+ `(progn
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil ,article))
+ (set-buffer gnus-original-article-buffer)
+ (let ((buf (format "%s" (buffer-string))))
+ (with-temp-buffer
+ (insert buf)
+ ,@forms
+ (unless (gnus-request-replace-article
+ ,article (car gnus-article-current)
+ (current-buffer) t)
+ (error "Couldn't replace article"))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; Flush original article as well.
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
+
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
(remove-text-properties b e gnus-hidden-properties)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(gnus-run-hooks 'gnus-article-prepare-hook)
(when gnus-display-mime-function
- ;(let ((url-standalone-mode (not gnus-plugged)))
- (funcall gnus-display-mime-function)
- )
- ;)
+ (let ((url-standalone-mode (not gnus-plugged)))
+ (funcall gnus-display-mime-function)))
;; Perform the article display hooks.
(gnus-run-hooks 'gnus-article-display-hook)))
;(gnus-mime-view-part "\M-\r" "View Interactively...")
(gnus-mime-view-part "v" "View Interactively...")
(gnus-mime-save-part "o" "Save...")
- (gnus-mime-copy-part "c" "View In Buffer")
- (gnus-mime-inline-part "i" "View Inline")
+ (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
+ (gnus-mime-inline-part "i" "View As Text, In This Buffer")
(gnus-mime-externalize-part "e" "View Externally")
(gnus-mime-pipe-part "|" "Pipe To Command...")))
(interactive "P") ; For compatibility reasons we are not using "z".
(gnus-article-check-buffer)
(let* ((data (get-text-property (point) 'gnus-data))
- (contents (mm-get-part data))
+ contents
;(url-standalone-mode (not gnus-plugged))
(b (point))
buffer-read-only)
(if (mm-handle-undisplayer data)
(mm-remove-part data)
+ (setq contents (mm-get-part data))
(forward-line 2)
(when charset
(unless (symbolp charset)
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
(let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
+ (filename (mail-content-type-get (mm-handle-disposition handle)
+ 'filename))
(gnus-tmp-type (car (mm-handle-type handle)))
(gnus-tmp-description (mm-handle-description handle))
(gnus-tmp-dots
(set-buffer (mm-handle-buffer handle))
(buffer-size)))
b e)
+ (setq gnus-tmp-name (or gnus-tmp-name filename))
(setq gnus-tmp-name
(if gnus-tmp-name
(concat " (" gnus-tmp-name ")")
(defun gnus-display-mime (&optional ihandles)
"Insert MIME buttons in the buffer."
- (save-selected-window
- (let ((window (get-buffer-window gnus-article-buffer)))
- (when window
- (select-window window)))
- (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
- handle name type b e display)
- (unless ihandles
- ;; Top-level call; we clean up.
- (mm-destroy-parts gnus-article-mime-handles)
- (setq gnus-article-mime-handles handles
- gnus-article-mime-handle-alist nil)
- ;; We allow users to glean info from the handles.
- (when gnus-article-mime-part-function
- (gnus-mime-part-function handles)))
- (when (and handles
- (or (not (stringp (car handles)))
- (cdr handles)))
+ (save-excursion
+ (save-selected-window
+ (let ((window (get-buffer-window gnus-article-buffer)))
+ (when window
+ (select-window window)))
+ (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
+ handle name type b e display)
(unless ihandles
- ;; Clean up for mime parts.
- (article-goto-body)
- (delete-region (point) (point-max)))
- (if (stringp (car handles))
- (if (equal (car handles) "multipart/alternative")
- (let ((id (1+ (length gnus-article-mime-handle-alist))))
- (push (cons id handles) gnus-article-mime-handle-alist)
- (gnus-mime-display-alternative (cdr handles) nil nil id))
- (gnus-mime-display-mixed (cdr handles)))
- (gnus-mime-display-single handles))))))
+ ;; Top-level call; we clean up.
+ (mm-destroy-parts gnus-article-mime-handles)
+ (setq gnus-article-mime-handles handles
+ gnus-article-mime-handle-alist nil)
+ ;; We allow users to glean info from the handles.
+ (when gnus-article-mime-part-function
+ (gnus-mime-part-function handles)))
+ (when (and handles
+ (or (not (stringp (car handles)))
+ (cdr handles)))
+ (unless ihandles
+ ;; Clean up for mime parts.
+ (article-goto-body)
+ (delete-region (point) (point-max)))
+ (gnus-mime-display-part handles))))))
+
+(defun gnus-mime-display-part (handle)
+ (cond
+ ;; Single part.
+ ((not (stringp (car handle)))
+ (gnus-mime-display-single handle))
+ ;; multipart/alternative
+ ((equal (car handle) "multipart/alternative")
+ (let ((id (1+ (length gnus-article-mime-handle-alist))))
+ (push (cons id handle) gnus-article-mime-handle-alist)
+ (gnus-mime-display-alternative (cdr handle) nil nil id)))
+ ;; multipart/related
+ ((equal (car handle) "multipart/related")
+ ;;;!!!We should find the start part, but we just default
+ ;;;!!!to the first part.
+ (gnus-mime-display-part (cadr handle)))
+ ;; Other multiparts are handled like multipart/mixed.
+ (t
+ (gnus-mime-display-mixed (cdr handle)))))
(defun gnus-mime-part-function (handles)
(if (stringp (car handles))
(funcall gnus-article-mime-part-function handles)))
(defun gnus-mime-display-mixed (handles)
- (let (handle)
- (while (setq handle (pop handles))
- (if (stringp (car handle))
- (if (equal (car handle) "multipart/alternative")
- (let ((id (1+ (length gnus-article-mime-handle-alist))))
- (push (cons id handle) gnus-article-mime-handle-alist)
- (gnus-mime-display-alternative (cdr handle) nil nil id))
- (gnus-mime-display-mixed (cdr handle)))
- (gnus-mime-display-single handle)))))
+ (mapcar 'gnus-mime-display-part handles))
(defun gnus-mime-display-single (handle)
(let ((type (car (mm-handle-type handle)))
(ignored gnus-ignored-mime-types)
(not-attachment t)
+ (move nil)
display text)
(catch 'ignored
(progn
(gnus-article-insert-newline)
(gnus-insert-mime-button
handle id (list (or display
- (and (not not-attachment) text))))
- (gnus-article-insert-newline)))
- (gnus-article-insert-newline)
+ (and not-attachment text))))
+ (gnus-article-insert-newline)
+ (gnus-article-insert-newline)
+ (setq move t)))
(cond
(display
- (forward-line -2)
+ (when move
+ (forward-line -2))
(let ((rfc2047-default-charset gnus-newsgroup-default-charset)
(mm-charset-iso-8859-1-forced
gnus-newsgroup-iso-8859-1-forced))
(mm-display-part handle t))
(goto-char (point-max)))
((and text not-attachment)
- (forward-line -2)
+ (when move
+ (forward-line -2))
(gnus-article-insert-newline)
(mm-insert-inline handle (mm-get-part handle))
(goto-char (point-max))))))))
(select-window win)))
(defvar gnus-decode-header-methods
- '(mail-decode-encoded-word-region)
+ '(gnus-decode-with-mail-decode-encoded-word-region)
"List of methods used to decode headers
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
(defvar gnus-decode-header-methods-cache nil)
+(defun gnus-decode-with-mail-decode-encoded-word-region (start end)
+ (let ((rfc2047-default-charset gnus-default-charset))
+ (mail-decode-encoded-word-region start end)))
+
(defun gnus-multi-decode-header (start end)
"Apply the functions from `gnus-encoded-word-methods' that match."
(unless (and gnus-decode-header-methods-cache
projects / elisp / gnus.git- / blobdiff