:group 'gnus-article-mime
:type 'boolean)
-(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message
- "Function to process a MIME message.
+(defcustom gnus-article-display-method-for-mime
+ 'gnus-article-display-mime-message
+ "Function to display a MIME message.
The function is called from the article buffer."
:group 'gnus-article-mime
:type 'function)
-(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word
- "*Function to decode MIME encoded words.
+(defcustom gnus-article-display-method-for-encoded-word
+ 'gnus-article-display-message-with-encoded-word
+ "*Function to display a message with MIME encoded-words.
+The function is called from the article buffer."
+ :group 'gnus-article-mime
+ :type 'function)
+
+(defcustom gnus-article-display-method-for-traditional
+ 'gnus-article-display-traditional-message
+ "*Function to display a traditional message.
The function is called from the article buffer."
:group 'gnus-article-mime
:type 'function)
from reply-to
(ignore-errors
(equal
- (nth 1 (mail-extract-address-components from))
- (nth 1 (mail-extract-address-components reply-to)))))
+ (nth 1 (funcall gnus-extract-address-components from))
+ (nth 1 (funcall gnus-extract-address-components reply-to)))))
(gnus-article-hide-header "reply-to"))))
((eq elem 'date)
(let ((date (message-fetch-field "date")))
(article-fill . gnus-article-word-wrap)
article-remove-cr
article-display-x-face
- article-de-quoted-unreadable
- article-mime-decode-quoted-printable
article-hide-pgp
article-hide-pem
article-hide-signature
["Scroll backwards" gnus-article-goto-prev-page t]
["Show summary" gnus-article-show-summary t]
["Fetch Message-ID at point" gnus-article-refer-article t]
- ["Mail to address at point" gnus-article-mail t]))
+ ["Mail to address at point" gnus-article-mail t]
+ ["Send a bug report" gnus-bug t]))
(easy-menu-define
gnus-article-treatment-menu gnus-article-mode-map ""
;;; @@ article filters
;;;
-(defun gnus-article-preview-mime-message ()
+(defun gnus-article-display-mime-message ()
+ "Article display method for MIME message."
(make-local-variable 'mime-button-mother-dispatcher)
(setq mime-button-mother-dispatcher
(function gnus-article-push-button))
(set-buffer gnus-summary-buffer)
default-mime-charset))
)
- (save-excursion
- (mime-view-mode nil nil nil gnus-original-article-buffer
- gnus-article-buffer
- gnus-article-mode-map)
- ))
+ (mime-display-message mime-message-structure
+ gnus-article-buffer nil gnus-article-mode-map)
+ )
(run-hooks 'gnus-mime-article-prepare-hook)
)
-(defun gnus-article-decode-encoded-word ()
- "Header filter for gnus-article-mode.
-It is registered to variable `mime-view-content-header-filter-alist'."
+(defun gnus-article-display-traditional-message ()
+ "Article display method for traditional message."
+ (set-buffer gnus-article-buffer)
+ (let (buffer-read-only)
+ (erase-buffer)
+ (insert-buffer-substring gnus-original-article-buffer)
+ ))
+
+(defun gnus-article-display-message-with-encoded-word ()
+ "Article display method for message with encoded-words."
(let ((charset (save-excursion
(set-buffer gnus-summary-buffer)
default-mime-charset)))
- (eword-decode-header charset)
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (decode-mime-charset-region (match-end 0) (point-max) charset))
+ (gnus-article-display-traditional-message)
+ (let (buffer-read-only)
+ (eword-decode-header charset)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (decode-mime-charset-region (match-end 0) (point-max) charset))
+ )
(mime-maybe-hide-echo-buffer)
)
(gnus-run-hooks 'gnus-mime-article-prepare-hook)
(unless (eq major-mode 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(setq gnus-summary-buffer (current-buffer))
- ;; Make sure the connection to the server is alive.
- (unless (gnus-server-opened
- (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-request-group gnus-newsgroup-name t))
(let* ((gnus-article (if header (mail-header-number header) article))
(summary-buffer (current-buffer))
(internal-hook gnus-article-internal-prepare-hook)
result)
(save-excursion
(gnus-article-setup-buffer)
- (set-buffer gnus-article-buffer)
+ (set-buffer gnus-original-article-buffer)
;; Deactivate active regions.
(when (and (boundp 'transient-mark-mode)
transient-mark-mode)
(unless (vectorp gnus-current-headers)
(setq gnus-current-headers nil))
(gnus-summary-goto-subject gnus-current-article)
- (gnus-summary-show-thread)
+ (when (gnus-summary-show-thread)
+ ;; If the summary buffer really was folded, the
+ ;; previous goto may not actually have gone to
+ ;; the right article, but the thread root instead.
+ ;; So we go again.
+ (gnus-summary-goto-subject gnus-current-article))
(gnus-run-hooks 'gnus-mark-article-hook)
(gnus-set-mode-line 'summary)
(when (gnus-visual-p 'article-highlight 'highlight)
(or all-headers gnus-show-all-headers))))
(when (or (numberp article)
(stringp article))
- ;; Hooks for getting information from the article.
- ;; This hook must be called before being narrowed.
- (let (buffer-read-only)
+ (let ((method
+ (if gnus-show-mime
+ (progn
+ (mime-parse-buffer)
+ (if (or (not gnus-strict-mime)
+ (mime-fetch-field "MIME-Version"))
+ gnus-article-display-method-for-mime
+ gnus-article-display-method-for-encoded-word))
+ gnus-article-display-method-for-traditional)))
+ ;; Hooks for getting information from the article.
+ ;; This hook must be called before being narrowed.
(gnus-run-hooks 'internal-hook)
(gnus-run-hooks 'gnus-article-prepare-hook)
- ;; Decode MIME message.
- (when gnus-show-mime
- (if (or (not gnus-strict-mime)
- (gnus-fetch-field "MIME-Version"))
- (funcall gnus-show-mime-method)
- (funcall gnus-decode-encoded-word-method)))
+ ;; Display message.
+ (funcall method)
+ ;; Associate this article with the current summary buffer.
+ (setq gnus-article-current-summary summary-buffer)
;; Perform the article display hooks.
(gnus-run-hooks 'gnus-article-display-hook))
;; Do page break.
(error "There is no summary buffer for this article buffer")
(gnus-article-set-globals)
(gnus-configure-windows 'article)
- (gnus-summary-goto-subject gnus-current-article)))
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-position-point)))
(defun gnus-article-describe-briefly ()
"Describe article mode commands briefly."
(gnus-article-hide-signature arg))
(defun gnus-article-maybe-highlight ()
- "Do some article highlighting if `article-visual' is non-nil."
+ "Do some article highlighting if article highlighting is requested."
(when (gnus-visual-p 'article-highlight 'highlight)
(gnus-article-highlight-some)))
+(defun gnus-check-group-server ()
+ ;; Make sure the connection to the server is alive.
+ (unless (gnus-server-opened
+ (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-request-group gnus-newsgroup-name t)))
+
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
- (let (do-update-line)
+ (let (do-update-line sparse-header)
(prog1
(save-excursion
(erase-buffer)
(gnus-kill-all-overlays)
(setq group (or group gnus-newsgroup-name))
- ;; Open server if it has closed.
- (gnus-check-server (gnus-find-method-for-group group))
-
;; Using `gnus-request-article' directly will insert the article into
;; `nntp-server-buffer' - so we'll save some time by not having to
;; copy it from the server buffer into the article buffer.
(setq do-update-line article)
(setq article (mail-header-id header))
(let ((gnus-override-method gnus-refer-article-method))
- (gnus-read-header article))
+ (setq sparse-header (gnus-read-header article)))
(setq gnus-newsgroup-sparse
(delq article gnus-newsgroup-sparse)))
((vectorp header)
(assq article gnus-newsgroup-reads)))
gnus-canceled-mark))
nil)
- ;; We first check `gnus-original-article-buffer'.
- ((and (get-buffer gnus-original-article-buffer)
- (numberp article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (and (equal (car gnus-original-article) group)
- (eq (cdr gnus-original-article) article))))
- (insert-buffer-substring gnus-original-article-buffer)
- 'article)
;; Check the backlog.
((and gnus-keep-backlog
(gnus-backlog-request-article group article (current-buffer)))
(buffer-read-only nil))
(erase-buffer)
(gnus-kill-all-overlays)
+ (gnus-check-group-server)
(when (gnus-request-article article group (current-buffer))
(when (numberp article)
(gnus-async-prefetch-next group article gnus-summary-buffer)
;; It was a pseudo.
(t article)))
- ;; Associate this article with the current summary buffer.
- (setq gnus-article-current-summary gnus-summary-buffer)
-
- ;; Take the article from the original article buffer
- ;; and place it in the buffer it's supposed to be in.
- (when (and (get-buffer gnus-article-buffer)
- (equal (buffer-name (current-buffer))
- (buffer-name (get-buffer gnus-article-buffer))))
- (save-excursion
- (if (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (set-buffer (get-buffer-create gnus-original-article-buffer))
- (buffer-disable-undo (current-buffer))
- (setq major-mode 'gnus-original-article-mode)
- (setq buffer-read-only t)
- (gnus-add-current-to-buffer-list))
- (let (buffer-read-only)
- (erase-buffer)
- (insert-buffer-substring gnus-article-buffer))
- (setq gnus-original-article (cons group article))))
-
;; Update sparse articles.
(when (and do-update-line
(or (numberp article)
(stringp article)))
(let ((buf (current-buffer)))
(set-buffer gnus-summary-buffer)
- (gnus-summary-update-article do-update-line)
+ (gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
(set-window-point (get-buffer-window (current-buffer) t)
(point))
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
- ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 2)
+ ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
(match-string 3 address)
"nntp")))))))
-(defun gnus-split-string (string pattern)
- "Return a list of substrings of STRING which are separated by PATTERN."
- (let (parts (start 0))
- (while (string-match pattern string start)
- (setq parts (cons (substring string start (match-beginning 0)) parts)
- start (match-end 0)))
- (nreverse (cons (substring string start) parts))))
-
(defun gnus-url-parse-query-string (query &optional downcase)
(let (retval pairs cur key val)
(setq pairs (gnus-split-string query "&"))
;;; @ for mime-view
;;;
-(defun gnus-content-header-filter ()
- "Header filter for mime-view.
-It is registered to variable `mime-view-content-header-filter-alist'."
- (eword-decode-header default-mime-charset))
-
-(defun mime-preview-quitting-method-for-gnus ()
- (if (not gnus-show-mime)
- (mime-preview-kill-buffer))
- (delete-other-windows)
- (gnus-article-show-summary)
- (if (or (not gnus-show-mime)
- (null gnus-have-all-headers))
- (gnus-summary-select-article nil t)
- ))
+(defun gnus-article-header-presentation-method (entity situation)
+ (mime-insert-decoded-header entity)
+ )
-(set-alist 'mime-view-content-header-filter-alist
+(set-alist 'mime-header-presentation-method-alist
'gnus-original-article-mode
- #'gnus-content-header-filter)
-
-(set-alist 'mime-raw-representation-type-alist
- 'gnus-original-article-mode 'binary)
+ #'gnus-article-header-presentation-method)
+
+(defun gnus-mime-preview-quitting-method ()
+ (if gnus-show-mime
+ (gnus-article-show-summary)
+ (mime-preview-kill-buffer)
+ (delete-other-windows)
+ (gnus-article-show-summary)
+ (gnus-summary-select-article nil t)
+ ))
(set-alist 'mime-preview-quitting-method-alist
- 'gnus-original-article-mode
- #'mime-preview-quitting-method-for-gnus)
-
-(set-alist 'mime-view-show-summary-method
- 'gnus-original-article-mode
- #'mime-preview-quitting-method-for-gnus)
+ 'gnus-original-article-mode #'gnus-mime-preview-quitting-method)
(defun gnus-following-method (buf)
(set-buffer buf)
(goto-char (point-min))
)
-(set-alist 'mime-view-following-method-alist
- 'gnus-original-article-mode
- #'gnus-following-method)
+(set-alist 'mime-preview-following-method-alist
+ 'gnus-original-article-mode #'gnus-following-method)
;;; @ end
projects / elisp / gnus.git- / blobdiff