- function article header)
- (if (or (null field)
- (string-equal field "")
- (not (fboundp
- (setq function
- (intern-soft
- (concat "mail-header-" (downcase field)))))))
- (error "Unknown header field: \"%s\"" field)
- ;; Get access function of header filed.
- (setq function `(lambda (h) (,function h)))
- ;; Starting from the current article.
- (while (or (and (not article)
- (setq article (gnus-summary-article-number))
- t)
- (setq article
- (gnus-summary-search-forward
- (not ignore-marked) 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)
- (setq killed-no (1+ killed-no))))
- killed-no))))
-
+ function article header extras)
+ (cond
+ ;; Search body.
+ ((or (null field)
+ (string-equal field ""))
+ (setq function nil))
+ ;; Get access function of header field.
+ ((cond ((fboundp
+ (setq function
+ (intern-soft
+ (concat "mail-header-" (downcase field)))))
+ (setq function `(lambda (h) (,function h))))
+ ((when (setq extras
+ (member (downcase field)
+ (mapcar (lambda (header)
+ (downcase (symbol-name header)))
+ gnus-extra-headers)))
+ (setq function
+ `(lambda (h)
+ (gnus-extra-header
+ (quote ,(nth (- (length gnus-extra-headers)
+ (length extras))
+ gnus-extra-headers))
+ h)))))))
+ ;; Signal error.
+ (t
+ (error "Unknown header field: \"%s\"" field)))
+ ;; Starting from the current article.
+ (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)
+ (setq killed-no (1+ killed-no))))
+ ;; 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 ~/.emacs -l gnus -f gnus-batch-score"
+ (interactive)
+ (let* ((gnus-newsrc-options-n
+ (gnus-newsrc-parse-options
+ (concat "options -n "
+ (mapconcat 'identity command-line-args-left " "))))
+ (gnus-expert-user t)
+ (mail-sources nil)
+ (gnus-use-dribble-file nil)
+ (gnus-batch-mode t)
+ info group newsrc unread
+ ;; 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 info (pop newsrc))
+ (setq group (gnus-info-group info)
+ unread (gnus-group-unread group))
+ (when (and (<= (gnus-info-level info) gnus-level-subscribed)
+ (and unread
+ (or (eq unread t)
+ (not (zerop unread)))))
+ (ignore-errors
+ (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