Lines Matching +defs:gnus +defs:apply +defs:kill +defs:hook
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
38 "Hook for Gnus kill file mode."
39 :group 'gnus-score-kill
40 :type 'hook)
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
48 (defcustom gnus-kill-save-kill-file nil
49 "*If non-nil, will save kill files after processing them."
50 :group 'gnus-score-kill
53 (defcustom gnus-winconf-kill-file nil
56 :group 'gnus-score-kill
59 (defcustom gnus-kill-killed t
60 "*If non-nil, Gnus will apply kill files to already killed articles.
61 If it is nil, Gnus will never apply kill files to articles that have
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 ()
96 "Major mode for editing kill files.
105 \\{gnus-kill-file-mode-map}
107 A kill file contains Lisp expressions to be applied to a selected
109 some set of regexps. A global kill file is applied to every newsgroup,
110 and a local kill file is applied to a specified newsgroup. Since a
111 global kill file is applied to every newsgroup, for better performance
114 A kill file can contain any kind of Emacs Lisp expressions expected
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
134 the string `AI' as read, a possible kill file may look like:
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.
147 `X' in a kill file as follows:
149 (gnus-expunge \"X\")
151 If the Summary buffer is empty after applying kill files, Gnus will
153 with `D' are deleted in a kill file, it is impossible to read articles
157 Entry to this mode calls emacs-lisp-mode-hook and
158 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
160 (kill-all-local-variables)
161 (use-local-map gnus-kill-file-mode-map)
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)
169 "Begin editing a kill file for NEWSGROUP.
170 If NEWSGROUP is nil, the global kill file is selected."
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))
199 (gnus-kill-file-mode)
202 (defun gnus-kill-file-enter-kill (field regexp &optional dont-move)
203 ;; Enter kill file entry.
204 ;; FIELD: String containing the name of the header field to kill.
205 ;; REGEXP: The string to kill.
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)
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
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 ()
317 "Save a kill file, then return to the previous buffer."
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)
331 (kill-buffer killbuf)))
333 ;; For kill files
335 (defun gnus-Newsgroup-kill-file (newsgroup)
336 "Return the name of a kill file for NEWSGROUP.
337 If NEWSGROUP is nil, return the global kill file instead."
340 ;; The global kill file is placed at top of the directory.
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 ()
374 "Apply a kill file to the current newsgroup.
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
387 (let ((files kill-files))
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)
408 (while kill-files
409 (if (not (file-exists-p (car kill-files)))
411 (gnus-message 6 "Processing kill file %s..." (car kill-files))
412 (find-file (car kill-files))
416 (gnus-kill-parse-gnus-kill-file)
417 (gnus-kill-parse-rn-kill-file))
419 (gnus-message
420 6 "Processing kill file %s...done" (car kill-files)))
421 (setq kill-files (cdr kill-files)))))
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)
441 (error "Invalid kill entry (possibly rn kill file?): %s" form))
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
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)
510 (let ((kill-list regexp)
512 (command (or exe-command '(gnus-summary-mark-as-read
513 nil gnus-kill-file-mark)))
514 kill kdate prev)
515 (if (listp kill-list)
517 (if (not (consp (cdr kill-list)))
519 (if (zerop (gnus-execute field (car kill-list)
521 (when (> (days-between date (cdr kill-list))
522 gnus-kill-expiry-days)
524 (setcdr kill-list date))
525 (while (setq kill (car kill-list))
526 (if (consp kill)
527 ;; It's a temporary kill.
529 (setq kdate (cdr kill))
530 (if (zerop (gnus-execute
531 field (car kill) command nil (not all)))
533 gnus-kill-expiry-days)
537 (setcdr prev (cdr kill-list))
539 ;; Successful kill. Set the date to today.
540 (setcdr kill date)))
541 ;; It's a permanent kill.
542 (gnus-execute field kill command nil (not all)))
543 (setq prev kill-list)
544 (setq kill-list (cdr kill-list))))
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))))
584 (kill-buffer (current-buffer))))))
586 (defun gnus-execute-1 (function regexp form header)
588 (let (did-kill)
599 (setq value (gnus-prin1-to-string value)))
600 (setq did-kill (string-match regexp 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)
619 (setq did-kill (re-search-forward regexp nil t)))
626 did-kill)))
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