Lines Matching +defs:gnus +defs:score +defs:set
0 ;;; gnus-kill.el --- kill commands for Gnus
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
33 (require 'gnus)
34 (require 'gnus-art)
35 (require 'gnus-range)
37 (defcustom gnus-kill-file-mode-hook nil
39 :group 'gnus-score-kill
42 (defcustom gnus-kill-expiry-days 7
44 :group 'gnus-score-kill
45 :group 'gnus-score-expire
48 (defcustom gnus-kill-save-kill-file nil
50 :group 'gnus-score-kill
53 (defcustom gnus-winconf-kill-file nil
56 :group 'gnus-score-kill
59 (defcustom gnus-kill-killed t
64 :group 'gnus-score-kill
70 (defmacro gnus-raise (field expression level)
71 `(gnus-kill ,field ,expression
72 (function (gnus-summary-raise-score ,level)) t))
74 (defmacro gnus-lower (field expression level)
75 `(gnus-kill ,field ,expression
76 (function (gnus-summary-raise-score (- ,level))) t))
82 (defvar gnus-kill-file-mode-map nil)
84 (unless gnus-kill-file-mode-map
85 (gnus-define-keymap (setq gnus-kill-file-mode-map
87 "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
88 "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
89 "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
90 "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
91 "\C-c\C-a" gnus-kill-file-apply-buffer
92 "\C-c\C-e" gnus-kill-file-apply-last-sexp
93 "\C-c\C-c" gnus-kill-file-exit))
95 (defun gnus-kill-file-mode ()
105 \\{gnus-kill-file-mode-map}
109 some set of regexps. A global kill file is applied to every newsgroup,
120 The `gnus-kill' function executes commands available in Summary Mode
121 by their key sequences. `gnus-kill' should be called with FIELD,
127 '(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is
136 (gnus-kill \"Subject\" \"AI\")
141 (gnus-kill \"Subject\" \"AI\" \"d\")
144 `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
149 (gnus-expunge \"X\")
158 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
161 (use-local-map gnus-kill-file-mode-map)
162 (set-syntax-table emacs-lisp-mode-syntax-table)
163 (setq major-mode 'gnus-kill-file-mode)
166 (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
168 (defun gnus-kill-file-edit-file (newsgroup)
172 (let ((file (gnus-newsgroup-kill-file newsgroup)))
173 (gnus-make-directory (file-name-directory file))
177 (setq gnus-winconf-kill-file (current-window-configuration)))
182 ((eq major-mode 'gnus-group-mode)
183 (gnus-configure-windows 'group) ;Take all windows.
185 ((eq major-mode 'gnus-summary-mode)
186 (gnus-configure-windows 'article)
187 (pop-to-buffer gnus-article-buffer)
188 (bury-buffer gnus-article-buffer)
192 (gnus-kill-file-mode)))
195 (defun gnus-kill-set-kill-buffer ()
196 (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
198 (set-buffer buffer)
199 (gnus-kill-file-mode)
202 (defun gnus-kill-file-enter-kill (field regexp &optional dont-move)
208 (unless (eq major-mode 'gnus-kill-file-mode)
209 (gnus-kill-set-kill-buffer))
212 (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
213 (gnus-kill-file-apply-string string))))
215 (defun gnus-kill-file-kill-by-subject ()
218 (gnus-kill-file-enter-kill
220 (if (vectorp gnus-current-headers)
222 (gnus-simplify-subject (mail-header-subject gnus-current-headers)))
226 (defun gnus-kill-file-kill-by-author ()
229 (gnus-kill-file-enter-kill
231 (if (vectorp gnus-current-headers)
232 (regexp-quote (mail-header-from gnus-current-headers))
235 (defun gnus-kill-file-kill-by-thread ()
238 (gnus-kill-file-enter-kill
240 (if (vectorp gnus-current-headers)
241 (regexp-quote (mail-header-id gnus-current-headers))
244 (defun gnus-kill-file-kill-by-xref ()
247 (let ((xref (and (vectorp gnus-current-headers)
248 (mail-header-xref gnus-current-headers)))
257 gnus-newsgroup-name))
258 (gnus-kill-file-enter-kill
260 (gnus-kill-file-enter-kill "Xref" "" t))))
262 (defun gnus-kill-file-raise-followups-to-author (level)
263 "Raise score for all followups to the current author."
265 (let ((name (mail-header-from gnus-current-headers))
268 (gnus-kill-set-kill-buffer)
276 "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
279 (gnus-kill-file-apply-string string))
280 (gnus-message
281 6 "Added temporary score file entry for followups to %s." name)))
283 (defun gnus-kill-file-apply-buffer ()
286 (if (and gnus-current-kill-article
287 (get-buffer gnus-summary-buffer))
289 (gnus-kill-file-apply-string (buffer-string))
290 (ding) (gnus-message 2 "No newsgroup is selected.")))
292 (defun gnus-kill-file-apply-string (string)
298 (pop-to-buffer gnus-summary-buffer)
301 (defun gnus-kill-file-apply-last-sexp ()
304 (if (and gnus-current-kill-article
305 (get-buffer gnus-summary-buffer))
312 (pop-to-buffer gnus-summary-buffer)
314 (ding) (gnus-message 2 "No newsgroup is selected.")))
316 (defun gnus-kill-file-exit ()
322 (when (get-buffer gnus-article-buffer)
323 (bury-buffer gnus-article-buffer))
327 (when gnus-winconf-kill-file
328 (set-window-configuration gnus-winconf-kill-file))
329 (setq gnus-winconf-kill-file nil)
335 (defun gnus-Newsgroup-kill-file (newsgroup)
341 (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
342 (gnus-use-long-file-name
344 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
345 "." gnus-kill-file-name)
346 gnus-kill-files-directory))
349 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
350 "/" gnus-kill-file-name)
351 gnus-kill-files-directory))))
353 (defun gnus-expunge (marks)
356 (set-buffer gnus-summary-buffer)
357 (gnus-summary-limit-to-marks marks 'reverse)))
359 (defun gnus-apply-kill-file-unless-scored ()
361 (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
363 (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
364 (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
365 gnus-newsgroup-name))
367 ((or (file-exists-p (gnus-newsgroup-kill-file nil))
368 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
369 (gnus-apply-kill-file-internal))
373 (defun gnus-apply-kill-file-internal ()
376 (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
377 (gnus-newsgroup-kill-file gnus-newsgroup-name)))
378 (unreads (length gnus-newsgroup-unreads))
379 (gnus-summary-inhibit-highlight t)
381 (setq gnus-newsgroup-kill-headers nil)
383 ;; from the `gnus-newsgroup-headers' list that the score functions
386 ;; single score function.
390 (let ((headers gnus-newsgroup-headers))
391 (if gnus-kill-killed
392 (setq gnus-newsgroup-kill-headers
396 (unless (gnus-member-of-range
398 gnus-newsgroup-killed)
400 gnus-newsgroup-kill-headers))
404 (if (not gnus-newsgroup-kill-headers)
411 (gnus-message 6 "Processing kill file %s..." (car kill-files))
416 (gnus-kill-parse-gnus-kill-file)
417 (gnus-kill-parse-rn-kill-file))
419 (gnus-message
423 (gnus-set-mode-line 'summary)
426 (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
428 (gnus-message 6 "Marked %d articles as read" nunreads))
433 (defun gnus-kill-parse-gnus-kill-file ()
435 (gnus-kill-file-mode)
442 (if (or (eq (car form) 'gnus-kill)
443 (eq (car form) 'gnus-raise)
444 (eq (car form) 'gnus-lower))
449 (set-buffer gnus-summary-buffer)
452 gnus-kill-save-kill-file
454 (set-buffer-modified-p nil)))
457 (defun gnus-kill-parse-rn-kill-file ()
459 (gnus-kill-file-mode)
481 (gnus-kill "from" ".")
484 (gnus-kill
488 '(gnus-summary-mark-as-unread nil " ")
489 '(gnus-summary-mark-as-read nil "X"))
495 (defun gnus-kill (field regexp &optional exe-command all silent)
498 (gnus-summary-mark-as-read nil \"X\").
508 (switch-to-buffer gnus-summary-buffer 'norecord)
512 (command (or exe-command '(gnus-summary-mark-as-read
513 nil gnus-kill-file-mark)))
519 (if (zerop (gnus-execute field (car kill-list)
522 gnus-kill-expiry-days)
530 (if (zerop (gnus-execute
533 gnus-kill-expiry-days)
542 (gnus-execute field kill command nil (not all)))
545 (gnus-execute field kill-list command nil (not all))))))
547 (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
548 (gnus-pp-gnus-kill
549 (nconc (list 'gnus-kill field
555 (defun gnus-pp-gnus-kill (object)
560 (concat "\n" (gnus-prin1-to-string object))
562 (set-buffer (gnus-get-buffer-create "*Gnus PP*"))
570 (gnus-prin1-to-string (car klist)))
578 (gnus-prin1-to-string (nth 3 object))))
586 (defun gnus-execute-1 (function regexp form header)
599 (setq value (gnus-prin1-to-string value)))
608 (let ((gnus-current-article nil) ;Save article pointer.
609 (gnus-last-article nil)
610 (gnus-break-pages nil) ;No need to break pages.
611 (gnus-mark-article-hook nil)) ;Inhibit marking as read.
612 (gnus-message
614 (gnus-article-setup-buffer)
615 (gnus-article-prepare (mail-header-number header) t)
617 (set-buffer gnus-article-buffer)
628 (defun gnus-execute (field regexp form &optional backward unread)
652 gnus-extra-headers)))
655 (gnus-extra-header
656 (quote ,(nth (- (length gnus-extra-headers)
658 gnus-extra-headers))
667 (setq article (gnus-summary-article-number)))
670 (gnus-summary-search-forward unread nil backward)))
671 (and (or (null gnus-newsgroup-kill-headers)
672 (memq article gnus-newsgroup-kill-headers))
673 (vectorp (setq header (gnus-summary-article-header article)))
674 (gnus-execute-1 function regexp form header)
680 (defalias 'gnus-batch-kill 'gnus-batch-score)
682 (defun gnus-batch-score ()
684 Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
686 (let* ((gnus-newsrc-options-n
687 (gnus-newsrc-parse-options
690 (gnus-expert-user t)
693 (gnus-use-dribble-file nil)
694 (gnus-batch-mode t)
697 gnus-novice-user gnus-large-newsgroup
698 gnus-options-subscribe gnus-auto-subscribed-groups
699 gnus-options-not-subscribe)
702 (gnus-slave)
704 (setq newsrc (cdr gnus-newsrc-alist))
706 (setq group (gnus-info-group info)
707 entry (gnus-gethash group gnus-newsrc-hashtb))
708 (when (and (<= (gnus-info-level info) gnus-level-subscribed)
713 (gnus-summary-read-group group nil t nil t))
714 (when (eq (current-buffer) (get-buffer gnus-summary-buffer))
715 (gnus-summary-exit))))
717 (switch-to-buffer gnus-group-buffer)
718 (gnus-group-save-newsrc)))
720 (provide 'gnus-kill)
723 ;;; gnus-kill.el ends here