xemacs-beta: lisp/gnus/gnus-kill.el comparison

comparison lisp/gnus/gnus-kill.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6

author	cvs
date	Mon, 13 Aug 2007 09:18:39 +0200
parents	4be1180a9e89
children

comparison

equal deleted inserted replaced

-:523141596bda
+:360340f9fd5f
 	(gnus-kill-set-kill-buffer))
 (unless dont-move
 	(goto-char (point-max)))
 (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
 (gnus-kill-file-apply-string string))))
 (defun gnus-kill-file-kill-by-subject ()
 "Kill by subject."
 (interactive)
 (gnus-kill-file-enter-kill
 "Subject"
 (if (vectorp gnus-current-headers)
 (regexp-quote
 	(gnus-simplify-subject (mail-header-subject gnus-current-headers)))
 "")
 t))
 (defun gnus-kill-file-kill-by-author ()
 "Kill by author."
 (interactive)
 (gnus-kill-file-enter-kill
 "From"
 (if (vectorp gnus-current-headers)
 (regexp-quote (mail-header-from gnus-current-headers))
 "") t))
 (defun gnus-kill-file-kill-by-thread ()
 "Kill by author."
 (interactive)
 (gnus-kill-file-enter-kill
 "References"
 (if (vectorp gnus-current-headers)
 (regexp-quote (mail-header-id gnus-current-headers))
 "")))
 (defun gnus-kill-file-kill-by-xref ()
 "Kill by Xref."
 (interactive)
 (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))
 	  (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)
 "Raise score for all followups to the current author."
 (gnus-kill-set-kill-buffer)
 (goto-char (point-min))
 (setq name (read-string (concat "Add " level
 				      " to followup articles to: ")
 			      (regexp-quote name)))
 (setq
 string
 (format
 	"(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
 	"From" name level))
 (insert string)
 (gnus-kill-file-apply-string string))
 (gnus-message
 6 "Added temporary score file entry for followups to %s." name)))
 (defun gnus-kill-file-apply-buffer ()
 "Apply current buffer to current newsgroup."
 (interactive)
 	      (if gnus-kill-killed
 		  (setq gnus-newsgroup-kill-headers
 			(mapcar (lambda (header) (mail-header-number header))
 				headers))
 		(while 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))))
 	      (goto-char (point-min))
 	      (if (consp (ignore-errors (read (current-buffer))))
 		  (gnus-kill-parse-gnus-kill-file)
 		(gnus-kill-parse-rn-kill-file))
 	      (gnus-message
 	       6 "Processing kill file %s...done" (car kill-files)))
 	    (setq kill-files (cdr kill-files)))))
 (gnus-set-mode-line 'summary)
 (defun gnus-kill-parse-gnus-kill-file ()
 (goto-char (point-min))
 (gnus-kill-file-mode)
 (let (beg form)
 (while (progn
 	     (setq beg (point))
 	     (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)
 			 ?s))
 	(setq commands (buffer-substring (match-beginning 3) (match-end 3)))
 	;; The "f:+" command marks everything *but* the matches as read,
 	;; so we simply first match everything as read, and then unmark
 	;; PATTERN later.
 	(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)
 	     '(gnus-summary-mark-as-unread nil " ")
 	   '(gnus-summary-mark-as-read nil "X"))
 	 nil t))
 (forward-line 1))))
 ;; Kill changes and new format by suggested by JWZ and Sudish Joseph
 ;; <joseph@cis.ohio-state.edu>.
 (defun gnus-kill (field regexp &optional exe-command all silent)
 "If FIELD of an article matches REGEXP, execute COMMAND.
 Optional 1st argument COMMAND is default to
 	(gnus-summary-mark-as-read nil \"X\").
 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
 	;; macros correctly.  See command_loop_1.
 	(switch-to-buffer gnus-summary-buffer 'norecord)
 	(goto-char (point-min))		;From the beginning.
 	(let ((kill-list regexp)
 	      (date (current-time-string))
 	      (command (or exe-command '(gnus-summary-mark-as-read
 					 nil gnus-kill-file-mark)))
 	      kill kdate prev)
 	  (if (listp kill-list)
 	      ;; It is a list.
 	      (if (not (consp (cdr kill-list)))
 		(while (setq kill (car kill-list))
 		  (if (consp kill)
 		      ;; It's a temporary kill.
 		      (progn
 			(setq kdate (cdr kill))
 			(if (zerop (gnus-execute
 				    field (car kill) command nil (not all)))
 			    (when (> (gnus-days-between date kdate)
 				     gnus-kill-expiry-days)
 			      ;; Time limit has been exceeded, so we
 			      ;; remove the match.
 		  (setq kill-list (cdr kill-list))))
 	    (gnus-execute field kill-list command nil (not all))))))
 (switch-to-buffer old-buffer)
 (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))))))
 	  (insert (if first (progn (setq first nil) "")  "\n    ")
 		  (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)))))
 		       "'" "")
 		   (gnus-prin1-to-string (nth 3 object))))
 (when (nth 4 object)
 	  ;; Search article body.
 	  (let ((gnus-current-article nil) ;Save article pointer.
 		(gnus-last-article nil)
 		(gnus-break-pages nil)	;No need to break pages.
 		(gnus-mark-article-hook nil)) ;Inhibit marking as read.
 	    (gnus-message
 	     6 "Searching for article: %d..." (mail-header-number header))
 	    (gnus-article-setup-buffer)
 	    (gnus-article-prepare (mail-header-number header) t)
 	    (when (save-excursion
 		    (set-buffer gnus-article-buffer)
 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)
 	    (string-equal field ""))
 	(setq function nil))
 ;; Get access function of header field.
 ((fboundp
 	 (setq function
 	       (intern-soft
 		(concat "mail-header-" (downcase field)))))
 	(setq function `(lambda (h) (,function h))))
 ;; Signal error.
 (t
 	(error "Unknown header field: \"%s\"" field)))
 (while (or
 	      ;; First article.
 	      (and (not article)
 		   (setq article (gnus-summary-article-number)))
 	      ;; Find later articles.
 	      (setq article
 		    (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)))
 	     (gnus-execute-1 function regexp form header)
 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)

Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-kill.el @ 108:360340f9fd5f r20-1b6