1;;; gnus-kill.el --- kill commands for Gnus 2 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 7;; Lars Magne Ingebrigtsen <larsi@gnus.org> 8;; Keywords: news 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;;; Code: 30 31(eval-when-compile (require 'cl)) 32 33(require 'gnus) 34(require 'gnus-art) 35(require 'gnus-range) 36 37(defcustom gnus-kill-file-mode-hook nil 38 "Hook for Gnus kill file mode." 39 :group 'gnus-score-kill 40 :type 'hook) 41 42(defcustom gnus-kill-expiry-days 7 43 "*Number of days before expiring unused kill file entries." 44 :group 'gnus-score-kill 45 :group 'gnus-score-expire 46 :type 'integer) 47 48(defcustom gnus-kill-save-kill-file nil 49 "*If non-nil, will save kill files after processing them." 50 :group 'gnus-score-kill 51 :type 'boolean) 52 53(defcustom gnus-winconf-kill-file nil 54 "What does this do, Lars? 55I don't know, Per." 56 :group 'gnus-score-kill 57 :type 'sexp) 58 59(defcustom gnus-kill-killed t 60 "*If non-nil, Gnus will apply kill files to already killed articles. 61If it is nil, Gnus will never apply kill files to articles that have 62already been through the scoring process, which might very well save lots 63of time." 64 :group 'gnus-score-kill 65 :type 'boolean) 66 67 68 69(defmacro gnus-raise (field expression level) 70 `(gnus-kill ,field ,expression 71 (function (gnus-summary-raise-score ,level)) t)) 72 73(defmacro gnus-lower (field expression level) 74 `(gnus-kill ,field ,expression 75 (function (gnus-summary-raise-score (- ,level))) t)) 76 77;;; 78;;; Gnus Kill File Mode 79;;; 80 81(defvar gnus-kill-file-mode-map nil) 82 83(unless gnus-kill-file-mode-map 84 (gnus-define-keymap (setq gnus-kill-file-mode-map 85 (copy-keymap emacs-lisp-mode-map)) 86 "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject 87 "\C-c\C-k\C-a" gnus-kill-file-kill-by-author 88 "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread 89 "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref 90 "\C-c\C-a" gnus-kill-file-apply-buffer 91 "\C-c\C-e" gnus-kill-file-apply-last-sexp 92 "\C-c\C-c" gnus-kill-file-exit)) 93 94(defun gnus-kill-file-mode () 95 "Major mode for editing kill files. 96 97If you are using this mode - you probably shouldn't. Kill files 98perform badly and paint with a pretty broad brush. Score files, on 99the other hand, are vastly faster (40x speedup) and give you more 100control over what to do. 101 102In addition to Emacs-Lisp Mode, the following commands are available: 103 104\\{gnus-kill-file-mode-map} 105 106 A kill file contains Lisp expressions to be applied to a selected 107newsgroup. The purpose is to mark articles as read on the basis of 108some set of regexps. A global kill file is applied to every newsgroup, 109and a local kill file is applied to a specified newsgroup. Since a 110global kill file is applied to every newsgroup, for better performance 111use a local one. 112 113 A kill file can contain any kind of Emacs Lisp expressions expected 114to be evaluated in the Summary buffer. Writing Lisp programs for this 115purpose is not so easy because the internal working of Gnus must be 116well-known. For this reason, Gnus provides a general function which 117does this easily for non-Lisp programmers. 118 119 The `gnus-kill' function executes commands available in Summary Mode 120by their key sequences. `gnus-kill' should be called with FIELD, 121REGEXP and optional COMMAND and ALL. FIELD is a string representing 122the header field or an empty string. If FIELD is an empty string, the 123entire article body is searched for. REGEXP is a string which is 124compared with FIELD value. COMMAND is a string representing a valid 125key sequence in Summary mode or Lisp expression. COMMAND defaults to 126'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is 127executed in the Summary buffer. If the second optional argument ALL 128is non-nil, the COMMAND is applied to articles which are already 129marked as read or unread. Articles which are marked are skipped over 130by default. 131 132 For example, if you want to mark articles of which subjects contain 133the string `AI' as read, a possible kill file may look like: 134 135 (gnus-kill \"Subject\" \"AI\") 136 137 If you want to mark articles with `D' instead of `X', you can use 138the following expression: 139 140 (gnus-kill \"Subject\" \"AI\" \"d\") 141 142In this example it is assumed that the command 143`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. 144 145 It is possible to delete unnecessary headers which are marked with 146`X' in a kill file as follows: 147 148 (gnus-expunge \"X\") 149 150 If the Summary buffer is empty after applying kill files, Gnus will 151exit the selected newsgroup normally. If headers which are marked 152with `D' are deleted in a kill file, it is impossible to read articles 153which are marked as read in the previous Gnus sessions. Marks other 154than `D' should be used for articles which should really be deleted. 155 156Entry to this mode calls emacs-lisp-mode-hook and 157gnus-kill-file-mode-hook with no arguments, if that value is non-nil." 158 (interactive) 159 (kill-all-local-variables) 160 (use-local-map gnus-kill-file-mode-map) 161 (set-syntax-table emacs-lisp-mode-syntax-table) 162 (setq major-mode 'gnus-kill-file-mode) 163 (setq mode-name "Kill") 164 (lisp-mode-variables nil) 165 (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) 166 167(defun gnus-kill-file-edit-file (newsgroup) 168 "Begin editing a kill file for NEWSGROUP. 169If NEWSGROUP is nil, the global kill file is selected." 170 (interactive "sNewsgroup: ") 171 (let ((file (gnus-newsgroup-kill-file newsgroup))) 172 (gnus-make-directory (file-name-directory file)) 173 ;; Save current window configuration if this is first invocation. 174 (or (and (get-file-buffer file) 175 (get-buffer-window (get-file-buffer file))) 176 (setq gnus-winconf-kill-file (current-window-configuration))) 177 ;; Hack windows. 178 (let ((buffer (find-file-noselect file))) 179 (cond ((get-buffer-window buffer) 180 (pop-to-buffer buffer)) 181 ((eq major-mode 'gnus-group-mode) 182 (gnus-configure-windows 'group) ;Take all windows. 183 (pop-to-buffer buffer)) 184 ((eq major-mode 'gnus-summary-mode) 185 (gnus-configure-windows 'article) 186 (pop-to-buffer gnus-article-buffer) 187 (bury-buffer gnus-article-buffer) 188 (switch-to-buffer buffer)) 189 (t ;No good rules. 190 (find-file-other-window file)))) 191 (gnus-kill-file-mode))) 192 193;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>. 194(defun gnus-kill-set-kill-buffer () 195 (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)) 196 (buffer (find-file-noselect file))) 197 (set-buffer buffer) 198 (gnus-kill-file-mode) 199 (bury-buffer buffer))) 200 201(defun gnus-kill-file-enter-kill (field regexp &optional dont-move) 202 ;; Enter kill file entry. 203 ;; FIELD: String containing the name of the header field to kill. 204 ;; REGEXP: The string to kill. 205 (save-excursion 206 (let (string) 207 (unless (eq major-mode 'gnus-kill-file-mode) 208 (gnus-kill-set-kill-buffer)) 209 (unless dont-move 210 (goto-char (point-max))) 211 (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) 212 (gnus-kill-file-apply-string string)))) 213 214(defun gnus-kill-file-kill-by-subject () 215 "Kill by subject." 216 (interactive) 217 (gnus-kill-file-enter-kill 218 "Subject" 219 (if (vectorp gnus-current-headers) 220 (regexp-quote 221 (gnus-simplify-subject (mail-header-subject gnus-current-headers))) 222 "") 223 t)) 224 225(defun gnus-kill-file-kill-by-author () 226 "Kill by author." 227 (interactive) 228 (gnus-kill-file-enter-kill 229 "From" 230 (if (vectorp gnus-current-headers) 231 (regexp-quote (mail-header-from gnus-current-headers)) 232 "") t)) 233 234(defun gnus-kill-file-kill-by-thread () 235 "Kill by author." 236 (interactive) 237 (gnus-kill-file-enter-kill 238 "References" 239 (if (vectorp gnus-current-headers) 240 (regexp-quote (mail-header-id gnus-current-headers)) 241 ""))) 242 243(defun gnus-kill-file-kill-by-xref () 244 "Kill by Xref." 245 (interactive) 246 (let ((xref (and (vectorp gnus-current-headers) 247 (mail-header-xref gnus-current-headers))) 248 (start 0) 249 group) 250 (if xref 251 (while (string-match " \\([^ \t]+\\):" xref start) 252 (setq start (match-end 0)) 253 (when (not (string= 254 (setq group 255 (substring xref (match-beginning 1) (match-end 1))) 256 gnus-newsgroup-name)) 257 (gnus-kill-file-enter-kill 258 "Xref" (concat " " (regexp-quote group) ":") t))) 259 (gnus-kill-file-enter-kill "Xref" "" t)))) 260 261(defun gnus-kill-file-raise-followups-to-author (level) 262 "Raise score for all followups to the current author." 263 (interactive "p") 264 (let ((name (mail-header-from gnus-current-headers)) 265 string) 266 (save-excursion 267 (gnus-kill-set-kill-buffer) 268 (goto-char (point-min)) 269 (setq name (read-string (concat "Add " level 270 " to followup articles to: ") 271 (regexp-quote name))) 272 (setq 273 string 274 (format 275 "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" 276 "From" name level)) 277 (insert string) 278 (gnus-kill-file-apply-string string)) 279 (gnus-message 280 6 "Added temporary score file entry for followups to %s." name))) 281 282(defun gnus-kill-file-apply-buffer () 283 "Apply current buffer to current newsgroup." 284 (interactive) 285 (if (and gnus-current-kill-article 286 (get-buffer gnus-summary-buffer)) 287 ;; Assume newsgroup is selected. 288 (gnus-kill-file-apply-string (buffer-string)) 289 (ding) (gnus-message 2 "No newsgroup is selected."))) 290 291(defun gnus-kill-file-apply-string (string) 292 "Apply STRING to current newsgroup." 293 (interactive) 294 (let ((string (concat "(progn \n" string "\n)"))) 295 (save-excursion 296 (save-window-excursion 297 (pop-to-buffer gnus-summary-buffer) 298 (eval (car (read-from-string string))))))) 299 300(defun gnus-kill-file-apply-last-sexp () 301 "Apply sexp before point in current buffer to current newsgroup." 302 (interactive) 303 (if (and gnus-current-kill-article 304 (get-buffer gnus-summary-buffer)) 305 ;; Assume newsgroup is selected. 306 (let ((string 307 (buffer-substring 308 (save-excursion (forward-sexp -1) (point)) (point)))) 309 (save-excursion 310 (save-window-excursion 311 (pop-to-buffer gnus-summary-buffer) 312 (eval (car (read-from-string string)))))) 313 (ding) (gnus-message 2 "No newsgroup is selected."))) 314 315(defun gnus-kill-file-exit () 316 "Save a kill file, then return to the previous buffer." 317 (interactive) 318 (save-buffer) 319 (let ((killbuf (current-buffer))) 320 ;; We don't want to return to article buffer. 321 (when (get-buffer gnus-article-buffer) 322 (bury-buffer gnus-article-buffer)) 323 ;; Delete the KILL file windows. 324 (delete-windows-on killbuf) 325 ;; Restore last window configuration if available. 326 (when gnus-winconf-kill-file 327 (set-window-configuration gnus-winconf-kill-file)) 328 (setq gnus-winconf-kill-file nil) 329 ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. 330 (kill-buffer killbuf))) 331 332;; For kill files 333 334(defun gnus-Newsgroup-kill-file (newsgroup) 335 "Return the name of a kill file for NEWSGROUP. 336If NEWSGROUP is nil, return the global kill file instead." 337 (cond ((or (null newsgroup) 338 (string-equal newsgroup "")) 339 ;; The global kill file is placed at top of the directory. 340 (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) 341 (gnus-use-long-file-name 342 ;; Append ".KILL" to capitalized newsgroup name. 343 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) 344 "." gnus-kill-file-name) 345 gnus-kill-files-directory)) 346 (t 347 ;; Place "KILL" under the hierarchical directory. 348 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) 349 "/" gnus-kill-file-name) 350 gnus-kill-files-directory)))) 351 352(defun gnus-expunge (marks) 353 "Remove lines marked with MARKS." 354 (save-excursion 355 (set-buffer gnus-summary-buffer) 356 (gnus-summary-limit-to-marks marks 'reverse))) 357 358(defun gnus-apply-kill-file-unless-scored () 359 "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." 360 (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) 361 ;; Ignores global KILL. 362 (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) 363 (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" 364 gnus-newsgroup-name)) 365 0) 366 ((or (file-exists-p (gnus-newsgroup-kill-file nil)) 367 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) 368 (gnus-apply-kill-file-internal)) 369 (t 370 0))) 371 372(defun gnus-apply-kill-file-internal () 373 "Apply a kill file to the current newsgroup. 374Returns the number of articles marked as read." 375 (let* ((kill-files (list (gnus-newsgroup-kill-file nil) 376 (gnus-newsgroup-kill-file gnus-newsgroup-name))) 377 (unreads (length gnus-newsgroup-unreads)) 378 (gnus-summary-inhibit-highlight t) 379 beg) 380 (setq gnus-newsgroup-kill-headers nil) 381 ;; If there are any previously scored articles, we remove these 382 ;; from the `gnus-newsgroup-headers' list that the score functions 383 ;; will see. This is probably pretty wasteful when it comes to 384 ;; conses, but is, I think, faster than having to assq in every 385 ;; single score function. 386 (let ((files kill-files)) 387 (while files 388 (if (file-exists-p (car files)) 389 (let ((headers gnus-newsgroup-headers)) 390 (if gnus-kill-killed 391 (setq gnus-newsgroup-kill-headers 392 (mapcar (lambda (header) (mail-header-number header)) 393 headers)) 394 (while headers 395 (unless (gnus-member-of-range 396 (mail-header-number (car headers)) 397 gnus-newsgroup-killed) 398 (push (mail-header-number (car headers)) 399 gnus-newsgroup-kill-headers)) 400 (setq headers (cdr headers)))) 401 (setq files nil)) 402 (setq files (cdr files))))) 403 (if (not gnus-newsgroup-kill-headers) 404 () 405 (save-window-excursion 406 (save-excursion 407 (while kill-files 408 (if (not (file-exists-p (car kill-files))) 409 () 410 (gnus-message 6 "Processing kill file %s..." (car kill-files)) 411 (find-file (car kill-files)) 412 (goto-char (point-min)) 413 414 (if (consp (ignore-errors (read (current-buffer)))) 415 (gnus-kill-parse-gnus-kill-file) 416 (gnus-kill-parse-rn-kill-file)) 417 418 (gnus-message 419 6 "Processing kill file %s...done" (car kill-files))) 420 (setq kill-files (cdr kill-files))))) 421 422 (gnus-set-mode-line 'summary) 423 424 (if beg 425 (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) 426 (or (eq nunreads 0) 427 (gnus-message 6 "Marked %d articles as read" nunreads)) 428 nunreads) 429 0)))) 430 431;; Parse a Gnus killfile. 432(defun gnus-kill-parse-gnus-kill-file () 433 (goto-char (point-min)) 434 (gnus-kill-file-mode) 435 (let (beg form) 436 (while (progn 437 (setq beg (point)) 438 (setq form (ignore-errors (read (current-buffer))))) 439 (unless (listp form) 440 (error "Invalid kill entry (possibly rn kill file?): %s" form)) 441 (if (or (eq (car form) 'gnus-kill) 442 (eq (car form) 'gnus-raise) 443 (eq (car form) 'gnus-lower)) 444 (progn 445 (delete-region beg (point)) 446 (insert (or (eval form) ""))) 447 (save-excursion 448 (set-buffer gnus-summary-buffer) 449 (ignore-errors (eval form))))) 450 (and (buffer-modified-p) 451 gnus-kill-save-kill-file 452 (save-buffer)) 453 (set-buffer-modified-p nil))) 454 455;; Parse an rn killfile. 456(defun gnus-kill-parse-rn-kill-file () 457 (goto-char (point-min)) 458 (gnus-kill-file-mode) 459 (let ((mod-to-header 460 '((?a . "") 461 (?h . "") 462 (?f . "from") 463 (?: . "subject"))) 464 ;;(com-to-com 465 ;; '((?m . " ") 466 ;; (?j . "X"))) 467 pattern modifier commands) 468 (while (not (eobp)) 469 (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) 470 () 471 (setq pattern (buffer-substring (match-beginning 1) (match-end 1))) 472 (setq modifier (if (match-beginning 2) (char-after (match-beginning 2)) 473 ?s)) 474 (setq commands (buffer-substring (match-beginning 3) (match-end 3))) 475 476 ;; The "f:+" command marks everything *but* the matches as read, 477 ;; so we simply first match everything as read, and then unmark 478 ;; PATTERN later. 479 (when (string-match "\\+" commands) 480 (gnus-kill "from" ".") 481 (setq commands "m")) 482 483 (gnus-kill 484 (or (cdr (assq modifier mod-to-header)) "subject") 485 pattern 486 (if (string-match "m" commands) 487 '(gnus-summary-mark-as-unread nil " ") 488 '(gnus-summary-mark-as-read nil "X")) 489 nil t)) 490 (forward-line 1)))) 491 492;; Kill changes and new format by suggested by JWZ and Sudish Joseph 493;; <joseph@cis.ohio-state.edu>. 494(defun gnus-kill (field regexp &optional exe-command all silent) 495 "If FIELD of an article matches REGEXP, execute COMMAND. 496Optional 1st argument COMMAND is default to 497 (gnus-summary-mark-as-read nil \"X\"). 498If optional 2nd argument ALL is non-nil, articles marked are also applied to. 499If FIELD is an empty string (or nil), entire article body is searched for. 500COMMAND must be a lisp expression or a string representing a key sequence." 501 ;; We don't want to change current point nor window configuration. 502 (let ((old-buffer (current-buffer))) 503 (save-excursion 504 (save-window-excursion 505 ;; Selected window must be summary buffer to execute keyboard 506 ;; macros correctly. See command_loop_1. 507 (switch-to-buffer gnus-summary-buffer 'norecord) 508 (goto-char (point-min)) ;From the beginning. 509 (let ((kill-list regexp) 510 (date (current-time-string)) 511 (command (or exe-command '(gnus-summary-mark-as-read 512 nil gnus-kill-file-mark))) 513 kill kdate prev) 514 (if (listp kill-list) 515 ;; It is a list. 516 (if (not (consp (cdr kill-list))) 517 ;; It's of the form (regexp . date). 518 (if (zerop (gnus-execute field (car kill-list) 519 command nil (not all))) 520 (when (> (days-between date (cdr kill-list)) 521 gnus-kill-expiry-days) 522 (setq regexp nil)) 523 (setcdr kill-list date)) 524 (while (setq kill (car kill-list)) 525 (if (consp kill) 526 ;; It's a temporary kill. 527 (progn 528 (setq kdate (cdr kill)) 529 (if (zerop (gnus-execute 530 field (car kill) command nil (not all))) 531 (when (> (days-between date kdate) 532 gnus-kill-expiry-days) 533 ;; Time limit has been exceeded, so we 534 ;; remove the match. 535 (if prev 536 (setcdr prev (cdr kill-list)) 537 (setq regexp (cdr regexp)))) 538 ;; Successful kill. Set the date to today. 539 (setcdr kill date))) 540 ;; It's a permanent kill. 541 (gnus-execute field kill command nil (not all))) 542 (setq prev kill-list) 543 (setq kill-list (cdr kill-list)))) 544 (gnus-execute field kill-list command nil (not all)))))) 545 (switch-to-buffer old-buffer) 546 (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) 547 (gnus-pp-gnus-kill 548 (nconc (list 'gnus-kill field 549 (if (consp regexp) (list 'quote regexp) regexp)) 550 (when (or exe-command all) 551 (list (list 'quote exe-command))) 552 (if all (list t) nil)))))) 553 554(defun gnus-pp-gnus-kill (object) 555 (if (or (not (consp (nth 2 object))) 556 (not (consp (cdr (nth 2 object)))) 557 (and (eq 'quote (car (nth 2 object))) 558 (not (consp (cdadr (nth 2 object)))))) 559 (concat "\n" (gnus-prin1-to-string object)) 560 (save-excursion 561 (set-buffer (gnus-get-buffer-create "*Gnus PP*")) 562 (buffer-disable-undo) 563 (erase-buffer) 564 (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) 565 (let ((klist (cadr (nth 2 object))) 566 (first t)) 567 (while klist 568 (insert (if first (progn (setq first nil) "") "\n ") 569 (gnus-prin1-to-string (car klist))) 570 (setq klist (cdr klist)))) 571 (insert ")") 572 (and (nth 3 object) 573 (insert "\n " 574 (if (and (consp (nth 3 object)) 575 (not (eq 'quote (car (nth 3 object))))) 576 "'" "") 577 (gnus-prin1-to-string (nth 3 object)))) 578 (when (nth 4 object) 579 (insert "\n t")) 580 (insert ")") 581 (prog1 582 (buffer-string) 583 (kill-buffer (current-buffer)))))) 584 585(defun gnus-execute-1 (function regexp form header) 586 (save-excursion 587 (let (did-kill) 588 (if (null header) 589 nil ;Nothing to do. 590 (if function 591 ;; Compare with header field. 592 (let (value) 593 (and header 594 (progn 595 (setq value (funcall function header)) 596 ;; Number (Lines:) or symbol must be converted to string. 597 (unless (stringp value) 598 (setq value (gnus-prin1-to-string value))) 599 (setq did-kill (string-match regexp value))) 600 (cond ((stringp form) ;Keyboard macro. 601 (execute-kbd-macro form)) 602 ((functionp form) 603 (funcall form)) 604 (t 605 (eval form))))) 606 ;; Search article body. 607 (let ((gnus-current-article nil) ;Save article pointer. 608 (gnus-last-article nil) 609 (gnus-break-pages nil) ;No need to break pages. 610 (gnus-mark-article-hook nil)) ;Inhibit marking as read. 611 (gnus-message 612 6 "Searching for article: %d..." (mail-header-number header)) 613 (gnus-article-setup-buffer) 614 (gnus-article-prepare (mail-header-number header) t) 615 (when (save-excursion 616 (set-buffer gnus-article-buffer) 617 (goto-char (point-min)) 618 (setq did-kill (re-search-forward regexp nil t))) 619 (cond ((stringp form) ;Keyboard macro. 620 (execute-kbd-macro form)) 621 ((functionp form) 622 (funcall form)) 623 (t 624 (eval form))))))) 625 did-kill))) 626 627(defun gnus-execute (field regexp form &optional backward unread) 628 "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). 629If FIELD is an empty string (or nil), entire article body is searched for. 630If optional 1st argument BACKWARD is non-nil, do backward instead. 631If optional 2nd argument UNREAD is non-nil, articles which are 632marked as read or ticked are ignored." 633 (save-excursion 634 (let ((killed-no 0) 635 function article header extras) 636 (cond 637 ;; Search body. 638 ((or (null field) 639 (string-equal field "")) 640 (setq function nil)) 641 ;; Get access function of header field. 642 ((cond ((fboundp 643 (setq function 644 (intern-soft 645 (concat "mail-header-" (downcase field))))) 646 (setq function `(lambda (h) (,function h)))) 647 ((when (setq extras 648 (member (downcase field) 649 (mapcar (lambda (header) 650 (downcase (symbol-name header))) 651 gnus-extra-headers))) 652 (setq function 653 `(lambda (h) 654 (gnus-extra-header 655 (quote ,(nth (- (length gnus-extra-headers) 656 (length extras)) 657 gnus-extra-headers)) 658 h))))))) 659 ;; Signal error. 660 (t 661 (error "Unknown header field: \"%s\"" field))) 662 ;; Starting from the current article. 663 (while (or 664 ;; First article. 665 (and (not article) 666 (setq article (gnus-summary-article-number))) 667 ;; Find later articles. 668 (setq article 669 (gnus-summary-search-forward unread nil backward))) 670 (and (or (null gnus-newsgroup-kill-headers) 671 (memq article gnus-newsgroup-kill-headers)) 672 (vectorp (setq header (gnus-summary-article-header article))) 673 (gnus-execute-1 function regexp form header) 674 (setq killed-no (1+ killed-no)))) 675 ;; Return the number of killed articles. 676 killed-no))) 677 678;;;###autoload 679(defalias 'gnus-batch-kill 'gnus-batch-score) 680;;;###autoload 681(defun gnus-batch-score () 682 "Run batched scoring. 683Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" 684 (interactive) 685 (let* ((gnus-newsrc-options-n 686 (gnus-newsrc-parse-options 687 (concat "options -n " 688 (mapconcat 'identity command-line-args-left " ")))) 689 (gnus-expert-user t) 690 (nnmail-spool-file nil) 691 (mail-sources nil) 692 (gnus-use-dribble-file nil) 693 (gnus-batch-mode t) 694 info group newsrc entry 695 ;; Disable verbose message. 696 gnus-novice-user gnus-large-newsgroup 697 gnus-options-subscribe gnus-auto-subscribed-groups 698 gnus-options-not-subscribe) 699 ;; Eat all arguments. 700 (setq command-line-args-left nil) 701 (gnus-slave) 702 ;; Apply kills to specified newsgroups in command line arguments. 703 (setq newsrc (cdr gnus-newsrc-alist)) 704 (while (setq info (pop newsrc)) 705 (setq group (gnus-info-group info) 706 entry (gnus-gethash group gnus-newsrc-hashtb)) 707 (when (and (<= (gnus-info-level info) gnus-level-subscribed) 708 (and (car entry) 709 (or (eq (car entry) t) 710 (not (zerop (car entry)))))) 711 (ignore-errors 712 (gnus-summary-read-group group nil t nil t)) 713 (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) 714 (gnus-summary-exit)))) 715 ;; Exit Emacs. 716 (switch-to-buffer gnus-group-buffer) 717 (gnus-group-save-newsrc))) 718 719(provide 'gnus-kill) 720 721;;; arch-tag: b30c0f53-df1a-490b-b81e-17b13474f395 722;;; gnus-kill.el ends here 723