X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=224408b5db4022db88827b144618bd910dfb1981;hb=11f65cf2ffd5c39d314499e19ff17f12b3dac192;hp=ce5f687e46a214701fde2aaa82d1f86d07912d63;hpb=6d8fe57af17f2311e7fd109458bd672842bcf574;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index ce5f687..224408b 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -368,14 +368,23 @@ be used as possible file names."
   :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)
@@ -1834,7 +1843,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        ["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 ""
@@ -1948,7 +1958,8 @@ commands:
 ;;; @@ 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))
@@ -1957,24 +1968,32 @@ commands:
 	    (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)
@@ -1990,11 +2009,6 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (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)
@@ -2002,7 +2016,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 	   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)
@@ -2059,7 +2073,12 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 		(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)
@@ -2072,17 +2091,23 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 		      (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.
@@ -2258,7 +2283,8 @@ Argument LINES specifies lines to be scrolled down."
       (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."
@@ -2366,22 +2392,26 @@ If given a prefix, show the hidden text instead."
   (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.
@@ -2409,7 +2439,7 @@ If given a prefix, show the hidden text instead."
 		    (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)
@@ -2441,15 +2471,6 @@ If given a prefix, show the hidden text instead."
 			    (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)))
@@ -2472,6 +2493,7 @@ If given a prefix, show the hidden text instead."
 		  (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)
@@ -2482,34 +2504,13 @@ If given a prefix, show the hidden text instead."
 	   ;; 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))
@@ -2684,7 +2685,7 @@ groups."
     ("\\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)
@@ -3064,14 +3065,6 @@ specified by `gnus-button-alist'."
 				     (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 "&"))
@@ -3237,35 +3230,25 @@ forbidden in URL encoding."
 ;;; @ 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)
@@ -3275,9 +3258,8 @@ It is registered to variable `mime-view-content-header-filter-alist'."
   (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