--- a/lisp/gnus/gnus-kill.el	Mon Aug 13 08:48:43 2007 +0200
+++ b/lisp/gnus/gnus-kill.el	Mon Aug 13 08:49:20 2007 +0200
@@ -1,5 +1,5 @@
 ;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -27,18 +27,36 @@
 ;;; Code:
 
 (require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-art)
+(require 'gnus-range)
 
-(defvar gnus-kill-file-mode-hook nil
-  "*A hook for Gnus kill file mode.")
+(defcustom gnus-kill-file-mode-hook nil
+  "Hook for Gnus kill file mode."
+  :group 'gnus-score
+  :type 'hook)
+
+(defcustom gnus-kill-expiry-days 7
+  "*Number of days before expiring unused kill file entries."
+  :group 'gnus-score
+  :type 'integer)
 
-(defvar gnus-kill-expiry-days 7
-  "*Number of days before expiring unused kill file entries.")
+(defcustom gnus-kill-save-kill-file nil
+  "*If non-nil, will save kill files after processing them."
+  :group 'gnus-score
+  :type 'boolean)
 
-(defvar gnus-kill-save-kill-file nil
-  "*If non-nil, will save kill files after processing them.")
+(defcustom gnus-winconf-kill-file nil
+  "What does this do, Lars?"
+  :group 'gnus-score
+  :type 'sexp)
 
-(defvar gnus-winconf-kill-file nil)
+(defcustom gnus-kill-killed t
+  "*If non-nil, Gnus will apply kill files to already killed articles.
+If it is nil, Gnus will never apply kill files to articles that have
+already been through the scoring process, which might very well save lots
+of time."
+  :group 'gnus-score
+  :type 'boolean)
 
 
 
@@ -57,15 +75,15 @@
 (defvar gnus-kill-file-mode-map nil)
 
 (unless gnus-kill-file-mode-map
-  (gnus-define-keymap
-   (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
-   "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
-   "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
-   "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
-   "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
-   "\C-c\C-a" gnus-kill-file-apply-buffer
-   "\C-c\C-e" gnus-kill-file-apply-last-sexp
-   "\C-c\C-c" gnus-kill-file-exit))
+  (gnus-define-keymap (setq gnus-kill-file-mode-map
+			    (copy-keymap emacs-lisp-mode-map))
+    "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
+    "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
+    "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
+    "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
+    "\C-c\C-a" gnus-kill-file-apply-buffer
+    "\C-c\C-e" gnus-kill-file-apply-last-sexp
+    "\C-c\C-c" gnus-kill-file-exit))
 
 (defun gnus-kill-file-mode ()
   "Major mode for editing kill files.
@@ -93,12 +111,12 @@
 does this easily for non-Lisp programmers.
 
   The `gnus-kill' function executes commands available in Summary Mode
-by their key sequences. `gnus-kill' should be called with FIELD,
+by their key sequences.  `gnus-kill' should be called with FIELD,
 REGEXP and optional COMMAND and ALL.  FIELD is a string representing
 the header field or an empty string.  If FIELD is an empty string, the
 entire article body is searched for.  REGEXP is a string which is
-compared with FIELD value. COMMAND is a string representing a valid
-key sequence in Summary mode or Lisp expression. COMMAND defaults to
+compared with FIELD value.  COMMAND is a string representing a valid
+key sequence in Summary mode or Lisp expression.  COMMAND defaults to
 '(gnus-summary-mark-as-read nil \"X\").  Make sure that COMMAND is
 executed in the Summary buffer.  If the second optional argument ALL
 is non-nil, the COMMAND is applied to articles which are already
@@ -180,8 +198,8 @@
   ;; REGEXP: The string to kill.
   (save-excursion
     (let (string)
-      (or (eq major-mode 'gnus-kill-file-mode)
-	  (gnus-kill-set-kill-buffer))
+      (unless (eq major-mode 'gnus-kill-file-mode)
+	(gnus-kill-set-kill-buffer))
       (unless dont-move
 	(goto-char (point-max)))
       (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
@@ -195,7 +213,8 @@
    (if (vectorp gnus-current-headers)
        (regexp-quote 
 	(gnus-simplify-subject (mail-header-subject gnus-current-headers)))
-     "") t))
+     "")
+   t))
   
 (defun gnus-kill-file-kill-by-author ()
   "Kill by author."
@@ -218,19 +237,19 @@
 (defun gnus-kill-file-kill-by-xref ()
   "Kill by Xref."
   (interactive)
-  (let ((xref (and (vectorp gnus-current-headers) 
+  (let ((xref (and (vectorp gnus-current-headers)
 		   (mail-header-xref gnus-current-headers)))
 	(start 0)
 	group)
     (if xref
 	(while (string-match " \\([^ \t]+\\):" xref start)
 	  (setq start (match-end 0))
-	  (if (not (string= 
-		    (setq group 
-			  (substring xref (match-beginning 1) (match-end 1)))
-		    gnus-newsgroup-name))
-	      (gnus-kill-file-enter-kill 
-	       "Xref" (concat " " (regexp-quote group) ":") t)))
+	  (when (not (string= 
+		      (setq group 
+			    (substring xref (match-beginning 1) (match-end 1)))
+		      gnus-newsgroup-name))
+	    (gnus-kill-file-enter-kill 
+	     "Xref" (concat " " (regexp-quote group) ":") t)))
       (gnus-kill-file-enter-kill "Xref" "" t))))
 
 (defun gnus-kill-file-raise-followups-to-author (level)
@@ -293,13 +312,13 @@
   (save-buffer)
   (let ((killbuf (current-buffer)))
     ;; We don't want to return to article buffer.
-    (and (get-buffer gnus-article-buffer)
-	 (bury-buffer gnus-article-buffer))
+    (when (get-buffer gnus-article-buffer)
+      (bury-buffer gnus-article-buffer))
     ;; Delete the KILL file windows.
     (delete-windows-on killbuf)
     ;; Restore last window configuration if available.
-    (and gnus-winconf-kill-file
-	 (set-window-configuration gnus-winconf-kill-file))
+    (when gnus-winconf-kill-file
+      (set-window-configuration gnus-winconf-kill-file))
     (setq gnus-winconf-kill-file nil)
     ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
     (kill-buffer killbuf)))
@@ -334,9 +353,9 @@
   "Apply .KILL file, unless a .SCORE file for the same newsgroup exists."
   (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
          ;; Ignores global KILL.
-         (if (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
-             (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
-			     gnus-newsgroup-name))
+         (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
+	   (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
+			 gnus-newsgroup-name))
          0)
         ((or (file-exists-p (gnus-newsgroup-kill-file nil))
              (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
@@ -355,7 +374,7 @@
     (setq gnus-newsgroup-kill-headers nil)
     ;; If there are any previously scored articles, we remove these
     ;; from the `gnus-newsgroup-headers' list that the score functions
-    ;; will see. This is probably pretty wasteful when it comes to
+    ;; will see.  This is probably pretty wasteful when it comes to
     ;; conses, but is, I think, faster than having to assq in every
     ;; single score function.
     (let ((files kill-files))
@@ -367,12 +386,11 @@
 			(mapcar (lambda (header) (mail-header-number header))
 				headers))
 		(while headers
-		  (or (gnus-member-of-range 
-		       (mail-header-number (car headers)) 
-		       gnus-newsgroup-killed)
-		      (setq gnus-newsgroup-kill-headers 
-			    (cons (mail-header-number (car headers))
-				  gnus-newsgroup-kill-headers)))
+		  (unless (gnus-member-of-range 
+			   (mail-header-number (car headers))
+			   gnus-newsgroup-killed)
+		    (push (mail-header-number (car headers))
+			  gnus-newsgroup-kill-headers))
 		  (setq headers (cdr headers))))
 	      (setq files nil))
  	  (setq files (cdr files)))))
@@ -388,8 +406,7 @@
 	      (gnus-add-current-to-buffer-list)
 	      (goto-char (point-min))
 
-	      (if (consp (condition-case nil (read (current-buffer)) 
-			   (error nil)))
+	      (if (consp (ignore-errors (read (current-buffer))))
 		  (gnus-kill-parse-gnus-kill-file)
 		(gnus-kill-parse-rn-kill-file))
 	    
@@ -423,10 +440,9 @@
   (let (beg form)
     (while (progn 
 	     (setq beg (point))
-	     (setq form (condition-case () (read (current-buffer))
-			  (error nil))))
-      (or (listp form)
-	  (error "Illegal kill entry (possibly rn kill file?): %s" form))
+	     (setq form (ignore-errors (read (current-buffer)))))
+      (unless (listp form)
+	(error "Illegal kill entry (possibly rn kill file?): %s" form))
       (if (or (eq (car form) 'gnus-kill)
 	      (eq (car form) 'gnus-raise)
 	      (eq (car form) 'gnus-lower))
@@ -435,8 +451,8 @@
 	    (insert (or (eval form) "")))
 	(save-excursion
 	  (set-buffer gnus-summary-buffer)
-	  (condition-case () (eval form) (error nil)))))
-    (and (buffer-modified-p) 
+	  (ignore-errors (eval form)))))
+    (and (buffer-modified-p)
 	 gnus-kill-save-kill-file
 	 (save-buffer))
     (set-buffer-modified-p nil)))
@@ -465,17 +481,16 @@
 	;; The "f:+" command marks everything *but* the matches as read,
 	;; so we simply first match everything as read, and then unmark
 	;; PATTERN later. 
-	(and (string-match "\\+" commands)
-	     (progn
-	       (gnus-kill "from" ".")
-	       (setq commands "m")))
+	(when (string-match "\\+" commands)
+	  (gnus-kill "from" ".")
+	  (setq commands "m"))
 
 	(gnus-kill 
 	 (or (cdr (assq modifier mod-to-header)) "subject")
 	 pattern 
-	 (if (string-match "m" commands) 
+	 (if (string-match "m" commands)
 	     '(gnus-summary-mark-as-unread nil " ")
-	   '(gnus-summary-mark-as-read nil "X")) 
+	   '(gnus-summary-mark-as-read nil "X"))
 	 nil t))
       (forward-line 1))))
 
@@ -493,7 +508,7 @@
     (save-excursion
       (save-window-excursion
 	;; Selected window must be summary buffer to execute keyboard
-	;; macros correctly. See command_loop_1.
+	;; macros correctly.  See command_loop_1.
 	(switch-to-buffer gnus-summary-buffer 'norecord)
 	(goto-char (point-min))		;From the beginning.
 	(let ((kill-list regexp)
@@ -505,11 +520,11 @@
 	      ;; It is a list.
 	      (if (not (consp (cdr kill-list)))
 		  ;; It's on the form (regexp . date).
-		  (if (zerop (gnus-execute field (car kill-list) 
+		  (if (zerop (gnus-execute field (car kill-list)
 					   command nil (not all)))
-		      (if (> (gnus-days-between date (cdr kill-list))
-			     gnus-kill-expiry-days)
-			  (setq regexp nil))
+		      (when (> (gnus-days-between date (cdr kill-list))
+			       gnus-kill-expiry-days)
+			(setq regexp nil))
 		    (setcdr kill-list date))
 		(while (setq kill (car kill-list))
 		  (if (consp kill)
@@ -518,14 +533,14 @@
 			(setq kdate (cdr kill))
 			(if (zerop (gnus-execute 
 				    field (car kill) command nil (not all)))
-			    (if (> (gnus-days-between date kdate)
-				   gnus-kill-expiry-days)
-				;; Time limit has been exceeded, so we
-				;; remove the match.
-				(if prev
-				    (setcdr prev (cdr kill-list))
-				  (setq regexp (cdr regexp))))
-			  ;; Successful kill. Set the date to today.
+			    (when (> (gnus-days-between date kdate)
+				     gnus-kill-expiry-days)
+			      ;; Time limit has been exceeded, so we
+			      ;; remove the match.
+			      (if prev
+				  (setcdr prev (cdr kill-list))
+				(setq regexp (cdr regexp))))
+			  ;; Successful kill.  Set the date to today.
 			  (setcdr kill date)))
 		    ;; It's a permanent kill.
 		    (gnus-execute field kill command nil (not all)))
@@ -533,19 +548,20 @@
 		  (setq kill-list (cdr kill-list))))
 	    (gnus-execute field kill-list command nil (not all))))))
     (switch-to-buffer old-buffer)
-    (if (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
-	(gnus-pp-gnus-kill
-	 (nconc (list 'gnus-kill field 
-		      (if (consp regexp) (list 'quote regexp) regexp))
-		(if (or exe-command all) (list (list 'quote exe-command)))
-		(if all (list t) nil))))))
+    (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
+      (gnus-pp-gnus-kill
+       (nconc (list 'gnus-kill field 
+		    (if (consp regexp) (list 'quote regexp) regexp))
+	      (when (or exe-command all)
+		(list (list 'quote exe-command)))
+	      (if all (list t) nil))))))
 
 (defun gnus-pp-gnus-kill (object)
   (if (or (not (consp (nth 2 object)))
 	  (not (consp (cdr (nth 2 object))))
 	  (and (eq 'quote (car (nth 2 object)))
 	       (not (consp (cdadr (nth 2 object))))))
-      (concat "\n" (prin1-to-string object))
+      (concat "\n" (gnus-prin1-to-string object))
     (save-excursion
       (set-buffer (get-buffer-create "*Gnus PP*"))
       (buffer-disable-undo (current-buffer))
@@ -555,17 +571,17 @@
 	    (first t))
 	(while klist
 	  (insert (if first (progn (setq first nil) "")  "\n    ")
-		  (prin1-to-string (car klist)))
+		  (gnus-prin1-to-string (car klist)))
 	  (setq klist (cdr klist))))
       (insert ")")
       (and (nth 3 object)
 	   (insert "\n  " 
 		   (if (and (consp (nth 3 object))
-			    (not (eq 'quote (car (nth 3 object))))) 
+			    (not (eq 'quote (car (nth 3 object)))))
 		       "'" "")
-		   (prin1-to-string (nth 3 object))))
-      (and (nth 4 object)
-	   (insert "\n  t"))
+		   (gnus-prin1-to-string (nth 3 object))))
+      (when (nth 4 object)
+	(insert "\n  t"))
       (insert ")")
       (prog1
 	  (buffer-substring (point-min) (point-max))
@@ -583,10 +599,10 @@
 		   (progn
 		     (setq value (funcall function header))
 		     ;; Number (Lines:) or symbol must be converted to string.
-		     (or (stringp value)
-			 (setq value (prin1-to-string value)))
+		     (unless (stringp value)
+		       (setq value (gnus-prin1-to-string value)))
 		     (setq did-kill (string-match regexp value)))
-		   (cond ((stringp form)	;Keyboard macro.
+		   (cond ((stringp form) ;Keyboard macro.
 			  (execute-kbd-macro form))
 			 ((gnus-functionp form)
 			  (funcall form))
@@ -601,27 +617,30 @@
 	     6 "Searching for article: %d..." (mail-header-number header))
 	    (gnus-article-setup-buffer)
 	    (gnus-article-prepare (mail-header-number header) t)
-	    (if (save-excursion
-		  (set-buffer gnus-article-buffer)
-		  (goto-char (point-min))
-		  (setq did-kill (re-search-forward regexp nil t)))
-		(if (stringp form)	;Keyboard macro.
-		    (execute-kbd-macro form)
-		  (eval form))))))
+	    (when (save-excursion
+		    (set-buffer gnus-article-buffer)
+		    (goto-char (point-min))
+		    (setq did-kill (re-search-forward regexp nil t)))
+	      (cond ((stringp form)	;Keyboard macro.
+		     (execute-kbd-macro form))
+		    ((gnus-functionp form)
+		     (funcall form))
+		    (t
+		     (eval form)))))))
       did-kill)))
 
-(defun gnus-execute (field regexp form &optional backward ignore-marked)
+(defun gnus-execute (field regexp form &optional backward unread)
   "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
 If FIELD is an empty string (or nil), entire article body is searched for.
 If optional 1st argument BACKWARD is non-nil, do backward instead.
-If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
+If optional 2nd argument UNREAD is non-nil, articles which are
 marked as read or ticked are ignored."
   (save-excursion
     (let ((killed-no 0)
 	  function article header)
       (cond 
        ;; Search body.
-       ((or (null field) 
+       ((or (null field)
 	    (string-equal field ""))
 	(setq function nil))
        ;; Get access function of header field.
@@ -640,8 +659,7 @@
 		   (setq article (gnus-summary-article-number)))
 	      ;; Find later articles.
 	      (setq article 
-		    (gnus-summary-search-forward 
-		     (not ignore-marked) nil backward)))
+		    (gnus-summary-search-forward unread nil backward)))
 	(and (or (null gnus-newsgroup-kill-headers)
 		 (memq article gnus-newsgroup-kill-headers))
 	     (vectorp (setq header (gnus-summary-article-header article)))
@@ -650,6 +668,49 @@
       ;; Return the number of killed articles.
       killed-no)))
 
+;;;###autoload
+(defalias 'gnus-batch-kill 'gnus-batch-score)
+;;;###autoload
+(defun gnus-batch-score ()
+  "Run batched scoring.
+Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
+Newsgroups is a list of strings in Bnews format.  If you want to score
+the comp hierarchy, you'd say \"comp.all\".  If you would not like to
+score the alt hierarchy, you'd say \"!alt.all\"."
+  (interactive)
+  (let* ((gnus-newsrc-options-n    
+	  (gnus-newsrc-parse-options
+	   (concat "options -n "
+		   (mapconcat 'identity command-line-args-left " "))))
+	 (gnus-expert-user t)
+	 (nnmail-spool-file nil)
+	 (gnus-use-dribble-file nil)
+	 (gnus-batch-mode t)
+	 group newsrc entry
+	 ;; Disable verbose message.
+	 gnus-novice-user gnus-large-newsgroup
+	 gnus-options-subscribe gnus-auto-subscribed-groups
+	 gnus-options-not-subscribe)
+    ;; Eat all arguments.
+    (setq command-line-args-left nil)
+    (gnus-slave)
+    ;; Apply kills to specified newsgroups in command line arguments.
+    (setq newsrc (cdr gnus-newsrc-alist))
+    (while (setq group (car (pop newsrc)))
+      (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+      (when (and (<= (gnus-info-level (car newsrc)) gnus-level-subscribed)
+		 (and (car entry)
+		      (or (eq (car entry) t)
+			  (not (zerop (car entry)))))
+		 ;;(eq (gnus-matches-options-n group) 'subscribe)
+		 )
+	(gnus-summary-read-group group nil t nil t)
+	(when (eq (current-buffer) (get-buffer gnus-summary-buffer))
+	  (gnus-summary-exit))))
+    ;; Exit Emacs.
+    (switch-to-buffer gnus-group-buffer)
+    (gnus-group-save-newsrc)))
+
 (provide 'gnus-kill)
 
 ;;; gnus-kill.el ends here