X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-kill.el;h=0e02ca3d2d39b279d39029a917a4e12231285aff;hb=1a96d7bf660263f25557962103bc0ec2495d1d07;hp=838c07736c7da7ed926507f2996cb1d3cafb7773;hpb=d3253b83da7765a4d47aed9483ba605f3a753577;p=gnus diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index 838c07736..0e02ca3d2 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -26,8 +26,9 @@ ;;; Code: -(require 'gnus) -(eval-when-compile (require 'cl)) +(require 'gnus-load) +(require 'gnus-art) +(require 'gnus-range) (defvar gnus-kill-file-mode-hook nil "*A hook for Gnus kill file mode.") @@ -40,6 +41,12 @@ (defvar gnus-winconf-kill-file nil) +(defvar 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.") + (defmacro gnus-raise (field expression level) @@ -145,7 +152,7 @@ gnus-kill-file-mode-hook with no arguments, if that value is non-nil." If NEWSGROUP is nil, the global kill file is selected." (interactive "sNewsgroup: ") (let ((file (gnus-newsgroup-kill-file newsgroup))) - (gnus-make-directory (file-name-directory file)) + (make-directory (file-name-directory file) t) ;; Save current window configuration if this is first invocation. (or (and (get-file-buffer file) (get-buffer-window (get-file-buffer file))) @@ -312,18 +319,17 @@ If NEWSGROUP is nil, return the global kill file instead." (cond ((or (null newsgroup) (string-equal newsgroup "")) ;; The global kill file is placed at top of the directory. - (expand-file-name gnus-kill-file-name - (or gnus-kill-files-directory "~/News"))) + (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) (gnus-use-long-file-name ;; Append ".KILL" to capitalized newsgroup name. (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) "." gnus-kill-file-name) - (or gnus-kill-files-directory "~/News"))) + gnus-kill-files-directory)) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) - (or gnus-kill-files-directory "~/News"))))) + gnus-kill-files-directory)))) (defun gnus-expunge (marks) "Remove lines marked with MARKS." @@ -336,8 +342,8 @@ If NEWSGROUP is nil, return the global kill file instead." (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)) - (message "Note: Ignoring %s.KILL; preferring .SCORE" - 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))) @@ -546,7 +552,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (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)) @@ -556,7 +562,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (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) @@ -564,7 +570,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (if (and (consp (nth 3 object)) (not (eq 'quote (car (nth 3 object))))) "'" "") - (prin1-to-string (nth 3 object)))) + (gnus-prin1-to-string (nth 3 object)))) (and (nth 4 object) (insert "\n t")) (insert ")") @@ -585,7 +591,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (setq value (funcall function header)) ;; Number (Lines:) or symbol must be converted to string. (or (stringp value) - (setq value (prin1-to-string value))) + (setq value (gnus-prin1-to-string value))) (setq did-kill (string-match regexp value))) (cond ((stringp form) ;Keyboard macro. (execute-kbd-macro form)) @@ -642,7 +648,7 @@ marked as read or ticked are ignored." ;; Find later articles. (setq article (gnus-summary-search-forward - (not ignore-marked) nil backward))) + 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))) @@ -651,6 +657,53 @@ marked as read or ticked are ignored." ;; 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 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* ((yes-and-no + (gnus-newsrc-parse-options + (apply (function concat) + (mapcar (lambda (g) (concat g " ")) + command-line-args-left)))) + (gnus-expert-user t) + (nnmail-spool-file nil) + (gnus-use-dribble-file nil) + (yes (car yes-and-no)) + (no (cdr yes-and-no)) + group newsrc entry + ;; Disable verbose message. + gnus-novice-user gnus-large-newsgroup) + ;; Eat all arguments. + (setq command-line-args-left nil) + ;; Start Gnus. + (gnus) + ;; Apply kills to specified newsgroups in command line arguments. + (setq newsrc (cdr gnus-newsrc-alist)) + (while newsrc + (setq group (caar newsrc)) + (setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) + (and (car entry) + (or (eq (car entry) t) + (not (zerop (car entry))))) + (if yes (string-match yes group) t) + (or (null no) (not (string-match no group)))) + (progn + (gnus-summary-read-group group nil t nil t) + (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) + (gnus-summary-exit)))) + (setq newsrc (cdr newsrc))) + ;; Exit Emacs. + (switch-to-buffer gnus-group-buffer) + (gnus-group-save-newsrc))) + (provide 'gnus-kill) ;;; gnus-kill.el ends here