X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-art.el;h=442a1fc1d632e772a7985eb48e93343f501c197a;hb=3c6a96d019e0fcdf0d35f9d4873f62c1962995ad;hp=0406f863fef06b58c3286e6385814c2cba90156a;hpb=c205a216f1bcecce14c4c5051b8e5cf3db649e74;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 0406f86..442a1fc 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -1,5 +1,5 @@
 ;;; gnus-art.el --- article mode commands for Semi-gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -181,8 +181,8 @@ Possible values in this list are `empty', `newsgroups', `followup-to',
 	      (const :tag "Followup-to identical to newsgroups." followup-to)
 	      (const :tag "Reply-to identical to from." reply-to)
 	      (const :tag "Date less than four days old." date)
-	      (const :tag "Very long To header." long-to)
-	      (const :tag "Multiple To headers." many-to))
+	      (const :tag "Very long To and/or Cc header." long-to)
+	      (const :tag "Multiple To and/or Cc headers." many-to))
   :group 'gnus-article-hiding)
 
 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
@@ -1233,11 +1233,15 @@ always hide."
 			      4))
 		  (gnus-article-hide-header "date"))))
 	     ((eq elem 'long-to)
-	      (let ((to (message-fetch-field "to")))
+	      (let ((to (message-fetch-field "to"))
+		    (cc (message-fetch-field "cc")))
 		(when (> (length to) 1024)
-		  (gnus-article-hide-header "to"))))
+		  (gnus-article-hide-header "to"))
+		(when (> (length cc) 1024)
+		  (gnus-article-hide-header "cc"))))
 	     ((eq elem 'many-to)
-	      (let ((to-count 0))
+	      (let ((to-count 0)
+		    (cc-count 0))
 		(goto-char (point-min))
 		(while (re-search-forward "^to:" nil t)
 		  (setq to-count (1+ to-count)))
@@ -1249,7 +1253,19 @@ always hide."
 		      (forward-line -1)
 		      (narrow-to-region (point) (point-max))
 		      (gnus-article-hide-header "to"))
-		    (setq to-count (1- to-count)))))))))))))
+		    (setq to-count (1- to-count))))
+		(goto-char (point-min))
+		(while (re-search-forward "^cc:" nil t)
+		  (setq cc-count (1+ cc-count)))
+		(when (> cc-count 1)
+		  (while (> cc-count 0)
+		    (goto-char (point-min))
+		    (save-restriction
+		      (re-search-forward "^cc:" nil nil cc-count)
+		      (forward-line -1)
+		      (narrow-to-region (point) (point-max))
+		      (gnus-article-hide-header "cc"))
+		    (setq cc-count (1- cc-count)))))))))))))
 
 (defun gnus-article-hide-header (header)
   (save-excursion
@@ -1526,7 +1542,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
 			     (not (string-match gnus-article-x-face-too-ugly
 						from))))
 		    ;; Has to be present.
-		    (re-search-forward "^X-Face: " nil t))
+		    (re-search-forward "^X-Face:[ \t]*" nil t))
 	  ;; This used to try to do multiple faces (`while' instead of
 	  ;; `when' above), but (a) sending multiple EOFs to xv doesn't
 	  ;; work (b) it can crash some versions of Emacs (c) are
@@ -1591,6 +1607,8 @@ If PROMPT (the prefix), prompt for a coding system to use."
 		      (mm-read-coding-system "Charset to decode: "))
 		     (ctl
 		      (mail-content-type-get ctl 'charset))))
+      (when cte
+	(setq cte (mail-header-strip cte)))
       (if (and ctl (not (string-match "/" (car ctl)))) 
 	  (setq ctl nil))
       (goto-char (point-max)))
@@ -1625,11 +1643,7 @@ or not."
       (when (or force
 		(and type (string-match "quoted-printable" (downcase type))))
 	(article-goto-body)
-	(save-restriction
-	  (narrow-to-region (point) (point-max))
-	  (quoted-printable-decode-region (point-min) (point-max))
-	  (when charset
-	    (mm-decode-body charset)))))))
+	(quoted-printable-decode-region (point) (point-max) charset)))))
 
 (eval-when-compile
   (require 'rfc1843))
@@ -2664,7 +2678,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
   "s" gnus-article-show-summary
   "\C-c\C-m" gnus-article-mail
   "?" gnus-article-describe-briefly
-  "e" gnus-summary-article-edit
+  "e" gnus-summary-edit-article
   "<" beginning-of-buffer
   ">" end-of-buffer
   "\C-c\C-i" gnus-info-find-node
@@ -2763,7 +2777,7 @@ commands:
   (make-local-variable 'gnus-article-mime-handles)
   (make-local-variable 'gnus-article-decoded-p)
   (make-local-variable 'gnus-article-mime-handle-alist)
-  (make-local-variable 'gnus-article-washed-types)
+  (make-local-variable 'gnus-article-wash-types)
   (gnus-set-default-directory)
   (buffer-disable-undo)
   (setq buffer-read-only t)
@@ -2797,7 +2811,6 @@ commands:
     (if (get-buffer name)
 	(save-excursion
 	  (set-buffer name)
-	  (kill-all-local-variables)
 	  (buffer-disable-undo)
 	  (setq buffer-read-only t)
 	  (unless (eq major-mode 'gnus-article-mode)
@@ -2929,8 +2942,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 		      (message "Message marked for downloading"))
 		  (gnus-summary-mark-article article gnus-canceled-mark)
 		  (unless (memq article gnus-newsgroup-sparse)
-		    (gnus-error 1
-				"No such article (may have expired or been canceled)")))))
+		    (gnus-error 1 "No such article (may have expired or been canceled)")))))
 	  (if (or (eq result 'pseudo)
 		  (eq result 'nneething))
 	      (progn
@@ -3220,14 +3232,33 @@ value of the variable `gnus-show-mime' is non-nil."
   (let ((data (get-text-property (point) 'gnus-data)))
     (mm-interactively-view-part data)))
 
-(defun gnus-mime-view-part-as-type ()
+(defun gnus-mime-view-part-as-type-internal ()
+  (gnus-article-check-buffer)
+  (let* ((name (mail-content-type-get
+		(mm-handle-type (get-text-property (point) 'gnus-data))
+		'name))
+	 (def-type (and name (mm-default-file-encoding name))))
+    (and def-type (cons def-type 0))))
+
+(defun gnus-mime-view-part-as-type (mime-type)
   "Choose a MIME media type, and view the part as such."
   (interactive
-   (list (completing-read "View as MIME type: "
-			  (mapcar 'list (mailcap-mime-types)))))
+   (list (completing-read
+	  "View as MIME type: "
+	  (mapcar (lambda (i) (list i i)) (mailcap-mime-types))
+	  nil nil
+	  (gnus-mime-view-part-as-type-internal))))
   (gnus-article-check-buffer)
   (let ((handle (get-text-property (point) 'gnus-data)))
-    (gnus-mm-display-part handle)))
+    (gnus-mm-display-part
+     (mm-make-handle (mm-handle-buffer handle)
+		     (cons mime-type (cdr (mm-handle-type handle)))
+		     (mm-handle-encoding handle)
+		     (mm-handle-undisplayer handle)
+		     (mm-handle-disposition handle)
+		     (mm-handle-description handle)
+		     (mm-handle-cache handle)
+		     (mm-handle-id handle)))))
 
 (defun gnus-mime-copy-part (&optional handle)
   "Put the the MIME part under point into a new buffer."
@@ -3859,7 +3890,8 @@ Argument LINES specifies lines to be scrolled up."
 	  (t
 	   (if start
 	       (set-window-start (selected-window) start)
-	     (scroll-up lines))
+	     (let (window-pixel-scroll-increment)
+	       (scroll-up lines)))
 	   nil))))
 
 (defun gnus-article-prev-page (&optional lines)
@@ -3878,7 +3910,8 @@ Argument LINES specifies lines to be scrolled down."
 	   (gnus-narrow-to-page -1))
 	  (t
 	   (condition-case nil
-	       (scroll-down lines)
+	       (let (window-pixel-scroll-increment)
+		 (scroll-down lines))
 	     (beginning-of-buffer
 	      (goto-char (point-min))))))))
 
@@ -3969,7 +4002,8 @@ Argument LINES specifies lines to be scrolled down."
             ;; We disable the pick minor mode commands.
             (let (gnus-pick-mode)
               (setq func (lookup-key (current-local-map) keys))))
-          (if (not func)
+          (if (or (not func)
+		  (numberp func))
               (ding)
             (unless (member keys nosave-in-article)
               (set-buffer gnus-article-current-summary))
@@ -4118,7 +4152,8 @@ If given a prefix, show the hidden text instead."
 		 (gnus-cache-request-article article group))
 	    'article)
 	   ;; Get the article and put into the article buffer.
-	   ((or (stringp article) (numberp article))
+	   ((or (stringp article)
+		(numberp article))
 	    (let ((gnus-override-method gnus-override-method)
 		  (methods (and (stringp article) 
 				gnus-refer-article-method))
@@ -4126,11 +4161,14 @@ If given a prefix, show the hidden text instead."
 		  (buffer-read-only nil))
 	      (setq methods
 		    (if (listp methods)
-			(delq 'current methods)
+			methods
 		      (list methods)))
-	      (if (and (null gnus-override-method) methods)
-		  (setq gnus-override-method (pop methods)))
+	      (when (and (null gnus-override-method)
+			 methods)
+		(setq gnus-override-method (pop methods)))
 	      (while (not result)
+		(when (eq gnus-override-method 'current)
+		  (setq gnus-override-method gnus-current-select-method))
 		(erase-buffer)
 		(gnus-kill-all-overlays)
 		(let ((gnus-newsgroup-name group))
@@ -4435,7 +4473,7 @@ after replacing with the original article."
 
 ;;; Internal Variables:
 
-(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
+(defcustom gnus-button-url-regexp "\\b\\(\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)\\|[-a-zA-Z0-9_]+\\.[-a-zA-Z0-9_]+\\(\\.[-a-zA-Z0-9_]+[-a-zA-Z0-9_/]+\\)+"
   "Regular expression that matches URLs."
   :group 'gnus-article-buttons
   :type 'regexp)
@@ -5085,7 +5123,8 @@ For example:
     (gnus-run-hooks 'gnus-part-display-hook)
     (unless gnus-inhibit-treatment
       (while (setq elem (pop alist))
-	(setq val (symbol-value (car elem)))
+	(with-current-buffer gnus-summary-buffer
+	  (setq val (symbol-value (car elem))))
 	(when (and (or (consp val)
 		       treated-type)
 		   (gnus-treat-predicate val)