;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-art)
(require 'gnus-range)
(defcustom gnus-kill-file-mode-hook nil
- "Hook for Gnus kill file mode."
- :group 'gnus-score
+ "*Hook for Gnus kill file mode."
+ :group 'gnus-score-kill
:type 'hook)
(defcustom gnus-kill-expiry-days 7
"*Number of days before expiring unused kill file entries."
- :group 'gnus-score
+ :group 'gnus-score-kill
+ :group 'gnus-score-expire
:type 'integer)
(defcustom gnus-kill-save-kill-file nil
"*If non-nil, will save kill files after processing them."
- :group 'gnus-score
+ :group 'gnus-score-kill
:type 'boolean)
(defcustom gnus-winconf-kill-file nil
- "What does this do, Lars?"
- :group 'gnus-score
+ "*What does this do, Lars?"
+ :group 'gnus-score-kill
:type 'sexp)
(defcustom gnus-kill-killed t
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
+ :group 'gnus-score-kill
:type 'boolean)
\f
(setq major-mode 'gnus-kill-file-mode)
(setq mode-name "Kill")
(lisp-mode-variables nil)
- (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
+ (gnus-run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
(defun gnus-kill-file-edit-file (newsgroup)
"Begin editing a kill file for NEWSGROUP.
(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"
+ "Subject"
(if (vectorp gnus-current-headers)
- (regexp-quote
+ (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"
+ "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"
+ "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)
(if xref
(while (string-match " \\([^ \t]+\\):" xref start)
(setq start (match-end 0))
- (when (not (string=
- (setq group
+ (when (not (string=
+ (setq group
(substring xref (match-beginning 1) (match-end 1)))
gnus-newsgroup-name))
- (gnus-kill-file-enter-kill
+ (gnus-kill-file-enter-kill
"Xref" (concat " " (regexp-quote group) ":") t)))
(gnus-kill-file-enter-kill "Xref" "" t))))
(setq name (read-string (concat "Add " level
" to followup articles to: ")
(regexp-quote name)))
- (setq
+ (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
+ (gnus-message
6 "Added temporary score file entry for followups to %s." name)))
(defun gnus-kill-file-apply-buffer ()
(mapcar (lambda (header) (mail-header-number header))
headers))
(while headers
- (unless (gnus-member-of-range
+ (unless (gnus-member-of-range
(mail-header-number (car headers))
gnus-newsgroup-killed)
(push (mail-header-number (car headers))
(if (consp (ignore-errors (read (current-buffer))))
(gnus-kill-parse-gnus-kill-file)
(gnus-kill-parse-rn-kill-file))
-
- (gnus-message
+
+ (gnus-message
6 "Processing kill file %s...done" (car kill-files)))
(setq kill-files (cdr kill-files)))))
(goto-char (point-min))
(gnus-kill-file-mode)
(let (beg form)
- (while (progn
+ (while (progn
(setq beg (point))
(setq form (ignore-errors (read (current-buffer)))))
(unless (listp form)
;; The "f:+" command marks everything *but* the matches as read,
;; so we simply first match everything as read, and then unmark
- ;; PATTERN later.
+ ;; PATTERN later.
(when (string-match "\\+" commands)
(gnus-kill "from" ".")
(setq commands "m"))
- (gnus-kill
+ (gnus-kill
(or (cdr (assq modifier mod-to-header)) "subject")
- pattern
+ pattern
(if (string-match "m" commands)
'(gnus-summary-mark-as-unread nil " ")
'(gnus-summary-mark-as-read nil "X"))
(forward-line 1))))
;; Kill changes and new format by suggested by JWZ and Sudish Joseph
-;; <joseph@cis.ohio-state.edu>.
+;; <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
(goto-char (point-min)) ;From the beginning.
(let ((kill-list regexp)
(date (current-time-string))
- (command (or exe-command '(gnus-summary-mark-as-read
+ (command (or exe-command '(gnus-summary-mark-as-read
nil gnus-kill-file-mark)))
kill kdate prev)
(if (listp kill-list)
;; It's a temporary kill.
(progn
(setq kdate (cdr kill))
- (if (zerop (gnus-execute
+ (if (zerop (gnus-execute
field (car kill) command nil (not all)))
(when (> (gnus-days-between date kdate)
gnus-kill-expiry-days)
(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
+ (nconc (list 'gnus-kill field
(if (consp regexp) (list 'quote regexp) regexp))
(when (or exe-command all)
(list (list 'quote exe-command)))
(setq klist (cdr klist))))
(insert ")")
(and (nth 3 object)
- (insert "\n "
+ (insert "\n "
(if (and (consp (nth 3 object))
(not (eq 'quote (car (nth 3 object)))))
"'" "")
(gnus-last-article nil)
(gnus-break-pages nil) ;No need to break pages.
(gnus-mark-article-hook nil)) ;Inhibit marking as read.
- (gnus-message
+ (gnus-message
6 "Searching for article: %d..." (mail-header-number header))
(gnus-article-setup-buffer)
(gnus-article-prepare (mail-header-number header) t)
(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))))))
+ (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 unread)
(save-excursion
(let ((killed-no 0)
function article header)
- (cond
+ (cond
;; Search body.
((or (null field)
(string-equal field ""))
(setq function nil))
;; Get access function of header field.
((fboundp
- (setq function
- (intern-soft
+ (setq function
+ (intern-soft
(concat "mail-header-" (downcase field)))))
(setq function `(lambda (h) (,function h))))
;; Signal error.
(and (not article)
(setq article (gnus-summary-article-number)))
;; Find later articles.
- (setq article
+ (setq article
(gnus-summary-search-forward unread nil backward)))
(and (or (null gnus-newsgroup-kill-headers)
(memq article gnus-newsgroup-kill-headers))
;;;###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\"."
+Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
(interactive)
- (let* ((gnus-newsrc-options-n
+ (let* ((gnus-newsrc-options-n
(gnus-newsrc-parse-options
(concat "options -n "
(mapconcat 'identity command-line-args-left " "))))
(nnmail-spool-file nil)
(gnus-use-dribble-file nil)
(gnus-batch-mode t)
- group newsrc entry
+ info group newsrc entry
;; Disable verbose message.
gnus-novice-user gnus-large-newsgroup
gnus-options-subscribe gnus-auto-subscribed-groups
(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)
+ (while (setq info (pop newsrc))
+ (setq group (gnus-info-group info)
+ entry (gnus-gethash group gnus-newsrc-hashtb))
+ (when (and (<= (gnus-info-level info) gnus-level-subscribed)
(and (car entry)
(or (eq (car entry) t)
- (not (zerop (car entry)))))
- ;;(eq (gnus-matches-options-n group) 'subscribe)
- )
+ (not (zerop (car entry))))))
(gnus-summary-read-group group nil t nil t)
(when (eq (current-buffer) (get-buffer gnus-summary-buffer))
(gnus-summary-exit))))
projects / gnus / blobdiff