X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=7846ca6da9be4e6e56a0c5cb109f247ff0536f37;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=2454b3cac6e1c3ee54d4d6b885e86c031c14134b;hpb=39e9fe5670ea76bf6fd1f199f8f903aa79b0da3e;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 2454b3c..7846ca6 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -1046,6 +1046,11 @@ that were fetched.  Say, for nnultimate groups."
   :group 'gnus-summary
   :type '(choice boolean regexp))
 
+(defcustom gnus-summary-muttprint-program "muttprint"
+  "Command (and optional arguments) used to run Muttprint."
+  :group 'gnus-summary
+  :type 'string)
+
 ;;; Internal variables
 
 (defvar gnus-summary-display-cache nil)
@@ -1120,7 +1125,8 @@ that were fetched.  Say, for nnultimate groups."
     (?l (bbb-grouplens-score gnus-tmp-header) ?s)
     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
     (?U gnus-tmp-unread ?c)
-    (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s)
+    (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
+	?s)
     (?t (gnus-summary-number-of-articles-in-thread
 	 (and (boundp 'thread) (car thread)) gnus-tmp-level)
 	?d)
@@ -1129,7 +1135,9 @@ that were fetched.  Say, for nnultimate groups."
 	?c)
     (?u gnus-tmp-user-defined ?s)
     (?P (gnus-pick-line-number) ?d)
-    (?B gnus-tmp-thread-tree-header-string ?s))
+    (?B gnus-tmp-thread-tree-header-string ?s)
+    (user-date (gnus-user-date
+		,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
   "An alist of format specifications that can appear in summary lines.
 These are paired with what variables they correspond with, along with
 the type of the variable (string, integer, character, etc).")
@@ -1318,7 +1326,19 @@ end position and text.")
   "Variables that are buffer-local to the summary buffers.")
 
 (defvar gnus-newsgroup-variables nil
-  "Variables that have separate values in the newsgroups.")
+  "A list of variables that have separate values in different newsgroups.
+A list of newsgroup (summary buffer) local variables, or cons of
+variables and their default values (when the default values are not
+nil), that should be made global while the summary buffer is active.
+These variables can be used to set variables in the group parameters
+while still allowing them to affect operations done in other
+buffers. For example:
+
+\(setq gnus-newsgroup-variables
+     '(message-use-followup-to
+       (gnus-visible-headers .
+	 \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
+")
 
 ;; Byte-compiler warning.
 (eval-when-compile (defvar gnus-article-mode-map))
@@ -1548,6 +1568,7 @@ increase the score of each group you read."
     gnus-mouse-2 gnus-mouse-pick-article
     "m" gnus-summary-mail-other-window
     "a" gnus-summary-post-news
+    "i" gnus-summary-news-other-window
     "x" gnus-summary-limit-to-unread
     "s" gnus-summary-isearch-article
     "t" gnus-article-toggle-headers
@@ -1722,8 +1743,7 @@ increase the score of each group you read."
     "m" gnus-summary-toggle-mime
     "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
     "p" gnus-article-verify-x-pgp-sig
-    "d" gnus-article-treat-dumbquotes
-    "s" gnus-smiley-display)
+    "d" gnus-article-treat-dumbquotes)
 
   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
     "a" gnus-article-hide
@@ -1798,6 +1818,7 @@ increase the score of each group you read."
     "h" gnus-summary-save-article-folder
     "v" gnus-summary-save-article-vm
     "p" gnus-summary-pipe-output
+    "P" gnus-summary-muttprint
     "s" gnus-soup-add-article)
 
   (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
@@ -1916,6 +1937,7 @@ increase the score of each group you read."
 	      ["Save body in file" gnus-summary-save-article-body-file t]
 	      ["Pipe through a filter" gnus-summary-pipe-output t]
 	      ["Add to SOUP packet" gnus-soup-add-article t]
+	      ["Print with Muttprint" gnus-summary-muttprint t]
 	      ["Print" gnus-summary-print-article t])
 	     ("Backend"
 	      ["Respool article..." gnus-summary-respool-article t]
@@ -2000,7 +2022,7 @@ increase the score of each group you read."
     (easy-menu-define
      gnus-summary-post-menu gnus-summary-mode-map ""
      `("Post"
-       ["Post an article" gnus-summary-post-news
+       ["Send a message (mail or news)" gnus-summary-post-news
 	,@(if (featurep 'xemacs) '(t)
 	    '(:help "Post an article"))]
        ["Followup" gnus-summary-followup
@@ -2026,6 +2048,7 @@ increase the score of each group you read."
        ["Resend message" gnus-summary-resend-message t]
        ["Send bounced mail" gnus-summary-resend-bounced-mail t]
        ["Send a mail" gnus-summary-mail-other-window t]
+       ["Create a local message" gnus-summary-news-other-window t]
        ["Uuencode and post" gnus-uu-post-news
 	,@(if (featurep 'xemacs) '(t)
 	    '(:help "Post a uuencoded article"))]
@@ -2077,7 +2100,7 @@ increase the score of each group you read."
 	["Age..." gnus-summary-limit-to-age t]
 	["Extra..." gnus-summary-limit-to-extra t]
 	["Score" gnus-summary-limit-to-score t]
-	["Score" gnus-summary-limit-to-display-predicate t]
+	["Display Predicate" gnus-summary-limit-to-display-predicate t]
 	["Unread" gnus-summary-limit-to-unread t]
 	["Non-dormant" gnus-summary-limit-exclude-dormant t]
 	["Articles" gnus-summary-limit-to-articles t]
@@ -2765,7 +2788,7 @@ display only a single character."
 
 (defun gnus-summary-buffer-name (group)
   "Return the summary buffer name of GROUP."
-  (concat "*Summary " group "*"))
+  (concat "*Summary " (gnus-group-decoded-name group) "*"))
 
 (defun gnus-summary-setup-buffer (group)
   "Initialize summary buffer."
@@ -2911,30 +2934,29 @@ buffer that was in action when the last article was fetched."
    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
 
-(defun gnus-summary-from-or-to-or-newsgroups (header)
-  (let ((to (cdr (assq 'To (mail-header-extra header))))
-	(newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))
-	(default-mime-charset (with-current-buffer gnus-summary-buffer
+(defun gnus-summary-extract-address-component (from)
+  (or (car (funcall gnus-extract-address-components from))
+      from))
+
+(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
+  (let ((default-mime-charset (with-current-buffer gnus-summary-buffer
 				default-mime-charset)))
-    (cond
-     ((and to
-	   gnus-ignored-from-addresses
-	   (string-match gnus-ignored-from-addresses
-			 (mail-header-from header)))
-      (concat "-> "
-	      (or (car (funcall gnus-extract-address-components
-				(funcall
-				 gnus-decode-encoded-word-function to)))
-		  (funcall gnus-decode-encoded-word-function to))))
-     ((and newsgroups
-	   gnus-ignored-from-addresses
-	   (string-match gnus-ignored-from-addresses
-			 (mail-header-from header)))
-      (concat "=> " newsgroups))
-     (t
-      (or (car (funcall gnus-extract-address-components
-			(mail-header-from header)))
-	  (mail-header-from header))))))
+    ;; Is it really necessary to do this next part for each summary line?
+    ;; Luckily, doesn't seem to slow things down much.
+    (or
+     (and gnus-ignored-from-addresses
+	  (string-match gnus-ignored-from-addresses gnus-tmp-from)
+	  (let ((extra-headers (mail-header-extra header))
+		to
+		newsgroups)
+	    (cond
+	     ((setq to (cdr (assq 'To extra-headers)))
+	      (concat "-> "
+		      (gnus-summary-extract-address-component
+		       (funcall gnus-decode-encoded-word-function to))))
+	     ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
+	      (concat "=> " newsgroups)))))
+     (gnus-summary-extract-address-component gnus-tmp-from))))
 
 (defun gnus-summary-insert-line (gnus-tmp-header
 				 gnus-tmp-level gnus-tmp-current
@@ -4567,10 +4589,32 @@ If SELECT-ARTICLES, only select those articles from GROUP."
     (let ((display (gnus-group-find-parameter group 'display)))
       (setq gnus-newsgroup-display
 	    (cond
+	     ((not (zerop (or (car-safe read-all) 0)))
+	      ;; The user entered the group with C-u SPC/RET, let's show
+	      ;; all articles.
+	      'gnus-not-ignore)
 	     ((eq display 'all)
 	      'gnus-not-ignore)
 	     ((arrayp display)
 	      (gnus-summary-display-make-predicate (mapcar 'identity display)))
+	     ((numberp display)
+	      ;; The following is probably the "correct" solution, but
+	      ;; it makes Gnus fetch all headers and then limit the
+	      ;; articles (which is slow), so instead we hack the
+	      ;; select-articles parameter instead. -- Simon Josefsson
+	      ;; <jas@kth.se>
+	      ;;
+	      ;; (gnus-byte-compile
+	      ;;  `(lambda () (> number ,(- (cdr (gnus-active group))
+	      ;; 			 display)))))
+	      (setq select-articles
+		    (gnus-uncompress-range
+		     (cons (let ((tmp (- (cdr (gnus-active group)) display)))
+			     (if (> tmp 0)
+				 tmp
+			       1))
+			   (cdr (gnus-active group)))))
+	      nil)
 	     (t
 	      nil))))
 
@@ -5152,6 +5196,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
 	     (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
 	     (gnus-info-set-read ',info ',(gnus-info-read info))
 	     (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+	     (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
 	     (gnus-group-update-group ,group t))))
       ;; Add the read articles to the range.
       (gnus-info-set-read info range)
@@ -6837,24 +6882,35 @@ If given a prefix, remove all limits."
       (gnus-summary-limit nil 'pop)
     (gnus-summary-position-point)))
 
-(defun gnus-summary-limit-to-subject (subject &optional header)
-  "Limit the summary buffer to articles that have subjects that match a regexp."
-  (interactive "sLimit to subject (regexp): ")
+(defun gnus-summary-limit-to-subject (subject &optional header not-matching)
+  "Limit the summary buffer to articles that have subjects that match a regexp.
+If NOT-MATCHING, excluding articles that have subjects that match a regexp."
+  (interactive
+   (list (read-string (if current-prefix-arg
+			  "Exclude subject (regexp): "
+			"Limit to subject (regexp): "))
+	 nil current-prefix-arg))
   (unless header
     (setq header "subject"))
   (when (not (equal "" subject))
     (prog1
 	(let ((articles (gnus-summary-find-matching
-			 (or header "subject") subject 'all)))
+			 (or header "subject") subject 'all nil nil
+			 not-matching)))
 	  (unless articles
 	    (error "Found no matches for \"%s\"" subject))
 	  (gnus-summary-limit articles))
       (gnus-summary-position-point))))
 
-(defun gnus-summary-limit-to-author (from)
-  "Limit the summary buffer to articles that have authors that match a regexp."
-  (interactive "sLimit to author (regexp): ")
-  (gnus-summary-limit-to-subject from "from"))
+(defun gnus-summary-limit-to-author (from &optional not-matching)
+  "Limit the summary buffer to articles that have authors that match a regexp.
+If NOT-MATCHING, excluding articles that have authors that match a regexp."
+  (interactive
+   (list (read-string (if current-prefix-arg
+			  "Exclude author (regexp): "
+			"Limit to author (regexp): "))
+	 current-prefix-arg))
+  (gnus-summary-limit-to-subject from "from" not-matching))
 
 (defun gnus-summary-limit-to-age (age &optional younger-p)
   "Limit the summary buffer to articles that are older than (or equal) AGE days.
@@ -6894,25 +6950,31 @@ articles that are younger than AGE days."
 	(gnus-summary-limit (nreverse articles)))
     (gnus-summary-position-point)))
 
-(defun gnus-summary-limit-to-extra (header regexp)
+(defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
   "Limit the summary buffer to articles that match an 'extra' header."
   (interactive
    (let ((header
 	  (intern
 	   (gnus-completing-read
 	    (symbol-name (car gnus-extra-headers))
-	    "Limit extra header:"
+	    (if current-prefix-arg
+		"Exclude extra header:"
+	      "Limit extra header:")
 	    (mapcar (lambda (x)
 		      (cons (symbol-name x) x))
 		    gnus-extra-headers)
 	    nil
 	    t))))
      (list header
-	   (read-string (format "Limit to header %s (regexp): " header)))))
+	   (read-string (format "%s header %s (regexp): "
+				(if current-prefix-arg "Exclude" "Limit to")
+				header))
+	   current-prefix-arg)))
   (when (not (equal "" regexp))
     (prog1
 	(let ((articles (gnus-summary-find-matching
-			 (cons 'extra header) regexp 'all)))
+			 (cons 'extra header) regexp 'all nil nil
+			 not-matching)))
 	  (unless articles
 	    (error "Found no matches for \"%s\"" regexp))
 	  (gnus-summary-limit articles))
@@ -6922,7 +6984,7 @@ articles that are younger than AGE days."
   "Limit the summary buffer to the predicated in the `display' group parameter."
   (interactive)
   (unless gnus-newsgroup-display
-    (error "There is no `diplay' group parameter"))
+    (error "There is no `display' group parameter"))
   (let (articles)
     (dolist (number gnus-newsgroup-articles)
       (when (funcall gnus-newsgroup-display)
@@ -6982,12 +7044,9 @@ Returns how many articles were removed."
 	(gnus-summary-limit articles))
     (gnus-summary-position-point)))
 
-(defun gnus-summary-limit-to-score (&optional score)
+(defun gnus-summary-limit-to-score (score)
   "Limit to articles with score at or above SCORE."
-  (interactive "P")
-  (setq score (if score
-		  (prefix-numeric-value score)
-		(or gnus-summary-default-score 0)))
+  (interactive "NLimit to articles with score of at least: ")
   (let ((data gnus-newsgroup-data)
 	articles)
     (while data
@@ -7814,13 +7873,14 @@ fetched headers for, whether they are displayed or not."
     (nreverse articles)))
 
 (defun gnus-summary-find-matching (header regexp &optional backward unread
-					  not-case-fold)
+					  not-case-fold not-matching)
   "Return a list of all articles that match REGEXP on HEADER.
 The search stars on the current article and goes forwards unless
 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
 If UNREAD is non-nil, only unread articles will
 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
-in the comparisons."
+in the comparisons. If NOT-MATCHING, return a list of all articles that
+not match REGEXP on HEADER."
   (let ((case-fold-search (not not-case-fold))
 	articles d func)
     (if (consp header)
@@ -7841,8 +7901,12 @@ in the comparisons."
       (when (and (or (not unread)	; We want all articles...
 		     (gnus-data-unread-p d)) ; Or just unreads.
 		 (vectorp (gnus-data-header d)) ; It's not a pseudo.
-		 (string-match regexp
-			       (funcall func (gnus-data-header d)))) ; Match.
+		 (if not-matching
+		     (not (string-match
+			   regexp
+			   (funcall func (gnus-data-header d))))
+		   (string-match regexp
+				 (funcall func (gnus-data-header d)))))
 	(push (gnus-data-number d) articles))) ; Success!
     (nreverse articles)))
 
@@ -7900,6 +7964,13 @@ article.  If BACKWARD (the prefix) is non-nil, search backward instead."
     (when gnus-page-broken
       (gnus-narrow-to-page))))
 
+(defun gnus-summary-print-truncate-and-quote (string &optional len)
+  "Truncate to LEN and quote all \"(\"'s in STRING."
+  (gnus-replace-in-string (if (and len (> (length string) len))
+			      (substring string 0 len)
+			    string)
+			  "[()]" "\\\\\\&"))
+
 (defun gnus-summary-print-article (&optional filename n)
   "Generate and print a PostScript image of the N next (mail) articles.
 
@@ -7929,9 +8000,13 @@ to save in."
 	      (let ((ps-left-header
 		     (list
 		      (concat "("
-			      (mail-header-subject gnus-current-headers) ")")
+			      (gnus-summary-print-truncate-and-quote
+			       (mail-header-subject gnus-current-headers)
+			       66) ")")
 		      (concat "("
-			      (mail-header-from gnus-current-headers) ")")))
+			      (gnus-summary-print-truncate-and-quote
+			       (mail-header-from gnus-current-headers)
+			       45) ")")))
 		    (ps-right-header
 		     (list
 		      "/pagenumberstring load"
@@ -7947,12 +8022,13 @@ to save in."
   (ps-despool filename))
 
 (defun gnus-summary-show-article (&optional arg)
-  "Force re-fetching of the current article.
+  "Force redisplaying of the current article.
 If ARG (the prefix) is a number, show the article with the charset
 defined in `gnus-summary-show-article-charset-alist', or the charset
 input.
 If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run."
+without any article massaging functions being run.  Normally, the key strokes
+are `C-u g'."
   (interactive "P")
   (cond
    ((numberp arg)
@@ -7963,20 +8039,29 @@ without any article massaging functions being run."
 		"View as charset: "
 		(save-excursion
 		  (set-buffer gnus-article-buffer)
-		  (detect-coding-region (point) (point-max) t)))))
+		  (let ((coding-systems
+			 (detect-coding-region (point) (point-max))))
+		    (or (car-safe coding-systems)
+			coding-systems))))))
 	  (gnus-newsgroup-ignored-charsets 'gnus-all))
       (gnus-summary-select-article nil 'force)
       (let ((deps gnus-newsgroup-dependencies)
-	    head header)
+	    head header lines)
 	(save-excursion
 	  (set-buffer gnus-original-article-buffer)
 	  (save-restriction
 	    (message-narrow-to-head)
-	    (setq head (buffer-string)))
+	    (setq head (buffer-string))
+	    (goto-char (point-min))
+	    (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
+	      (goto-char (point-max))
+	      (widen)
+	      (setq lines (1- (count-lines (point) (point-max))))))
 	  (with-temp-buffer
 	    (insert (format "211 %d Article retrieved.\n"
 			    (cdr gnus-article-current)))
 	    (insert head)
+	    (if lines (insert (format "Lines: %d\n" lines)))
 	    (insert ".\n")
 	    (let ((nntp-server-buffer (current-buffer)))
 	      (setq header (car (gnus-get-newsgroup-headers deps t))))))
@@ -8200,7 +8285,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
 		      (mail-header-xref (gnus-summary-article-header article))
 		      " ")))
 	   (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
-				  ":" article))
+				  ":" (number-to-string article)))
 	   (unless xref
 	     (setq xref (list (system-name))))
 	   (setq new-xref
@@ -8217,7 +8302,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
 				(gnus-request-accept-article
 				 to-newsgroup select-method (not articles))))
 	       (setq new-xref (concat new-xref " " (car art-group)
-				      ":" (cdr art-group)))
+				      ":"
+				      (number-to-string (cdr art-group))))
 	       ;; Now we have the new Xrefs header, so we insert
 	       ;; it and replace the new article.
 	       (nnheader-replace-header "Xref" new-xref)
@@ -8327,12 +8413,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
 	  (gnus-summary-mark-article article gnus-canceled-mark))))
       (gnus-summary-remove-process-mark article))
     ;; Re-activate all groups that have been moved to.
-    (while to-groups
-      (save-excursion
-	(set-buffer gnus-group-buffer)
-	(when (gnus-group-goto-group (car to-groups) t)
-	  (gnus-group-get-new-news-this-group 1 t))
-	(pop to-groups)))
+    (save-excursion
+      (set-buffer gnus-group-buffer)
+      (let ((gnus-group-marked to-groups))
+	(gnus-group-get-new-news-this-group nil t)))
 
     (gnus-kill-buffer copy-buf)
     (gnus-summary-position-point)
@@ -8352,10 +8436,9 @@ re-spool using this method."
   (gnus-summary-move-article n nil nil 'crosspost))
 
 (defcustom gnus-summary-respool-default-method nil
-  "Default method for respooling an article.
+  "Default method type for respooling an article.
 If nil, use to the current newsgroup method."
-  :type '(choice (gnus-select-method :value (nnml ""))
-		 (const nil))
+  :type 'symbol
   :group 'gnus-summary-mail)
 
 (defun gnus-summary-respool-article (&optional n method)
@@ -9897,7 +9980,9 @@ The variable `gnus-default-article-saver' specifies the saver function."
 	    (gnus-message 1 "Article %d is unsaveable" article))
 	;; This is a real article.
 	(save-window-excursion
-	  (gnus-summary-select-article t nil nil article))
+	  (let ((gnus-display-mime-function nil)
+		(gnus-article-prepare-hook nil))
+	    (gnus-summary-select-article t nil nil article)))
 	(save-excursion
 	  (set-buffer save-buffer)
 	  (erase-buffer)
@@ -9981,6 +10066,17 @@ save those articles instead."
   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
     (gnus-summary-save-article arg)))
 
+(defun gnus-summary-muttprint (&optional arg)
+  "Print the current article using Muttprint.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+  (interactive "P")
+  (require 'gnus-art)
+  (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
+    (gnus-summary-save-article arg t)))
+
 (defun gnus-summary-pipe-message (program)
   "Pipe the current article through PROGRAM."
   (interactive "sProgram: ")