1 |
;;; gnus-kill.el --- kill commands for Gnus |
;;; gnus-kill.el --- kill commands for Gnus |
2 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
357 |
(defun gnus-apply-kill-file-unless-scored () |
(defun gnus-apply-kill-file-unless-scored () |
358 |
"Apply .KILL file, unless a .SCORE file for the same newsgroup exists." |
"Apply .KILL file, unless a .SCORE file for the same newsgroup exists." |
359 |
(cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) |
(cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) |
360 |
;; Ignores global KILL. |
;; Ignores global KILL. |
361 |
(when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) |
(when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) |
362 |
(gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" |
(gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" |
363 |
gnus-newsgroup-name)) |
gnus-newsgroup-name)) |
364 |
0) |
0) |
365 |
((or (file-exists-p (gnus-newsgroup-kill-file nil)) |
((or (file-exists-p (gnus-newsgroup-kill-file nil)) |
366 |
(file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) |
(file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) |
367 |
(gnus-apply-kill-file-internal)) |
(gnus-apply-kill-file-internal)) |
368 |
(t |
(t |
369 |
0))) |
0))) |
370 |
|
|
371 |
(defun gnus-apply-kill-file-internal () |
(defun gnus-apply-kill-file-internal () |
372 |
"Apply a kill file to the current newsgroup. |
"Apply a kill file to the current newsgroup. |
398 |
gnus-newsgroup-kill-headers)) |
gnus-newsgroup-kill-headers)) |
399 |
(setq headers (cdr headers)))) |
(setq headers (cdr headers)))) |
400 |
(setq files nil)) |
(setq files nil)) |
401 |
(setq files (cdr files))))) |
(setq files (cdr files))))) |
402 |
(if (not gnus-newsgroup-kill-headers) |
(if (not gnus-newsgroup-kill-headers) |
403 |
() |
() |
404 |
(save-window-excursion |
(save-window-excursion |
428 |
0)))) |
0)))) |
429 |
|
|
430 |
;; Parse a Gnus killfile. |
;; Parse a Gnus killfile. |
|
(defun gnus-score-insert-help (string alist idx) |
|
|
(save-excursion |
|
|
(pop-to-buffer "*Score Help*") |
|
|
(buffer-disable-undo) |
|
|
(erase-buffer) |
|
|
(insert string ":\n\n") |
|
|
(while alist |
|
|
(insert (format " %c: %s\n" (caar alist) (nth idx (car alist)))) |
|
|
(setq alist (cdr alist))))) |
|
|
|
|
431 |
(defun gnus-kill-parse-gnus-kill-file () |
(defun gnus-kill-parse-gnus-kill-file () |
432 |
(goto-char (point-min)) |
(goto-char (point-min)) |
433 |
(gnus-kill-file-mode) |
(gnus-kill-file-mode) |
578 |
(insert "\n t")) |
(insert "\n t")) |
579 |
(insert ")") |
(insert ")") |
580 |
(prog1 |
(prog1 |
581 |
(buffer-substring (point-min) (point-max)) |
(buffer-string) |
582 |
(kill-buffer (current-buffer)))))) |
(kill-buffer (current-buffer)))))) |
583 |
|
|
584 |
(defun gnus-execute-1 (function regexp form header) |
(defun gnus-execute-1 (function regexp form header) |
598 |
(setq did-kill (string-match regexp value))) |
(setq did-kill (string-match regexp value))) |
599 |
(cond ((stringp form) ;Keyboard macro. |
(cond ((stringp form) ;Keyboard macro. |
600 |
(execute-kbd-macro form)) |
(execute-kbd-macro form)) |
601 |
((gnus-functionp form) |
((functionp form) |
602 |
(funcall form)) |
(funcall form)) |
603 |
(t |
(t |
604 |
(eval form))))) |
(eval form))))) |
617 |
(setq did-kill (re-search-forward regexp nil t))) |
(setq did-kill (re-search-forward regexp nil t))) |
618 |
(cond ((stringp form) ;Keyboard macro. |
(cond ((stringp form) ;Keyboard macro. |
619 |
(execute-kbd-macro form)) |
(execute-kbd-macro form)) |
620 |
((gnus-functionp form) |
((functionp form) |
621 |
(funcall form)) |
(funcall form)) |
622 |
(t |
(t |
623 |
(eval form))))))) |
(eval form))))))) |
631 |
marked as read or ticked are ignored." |
marked as read or ticked are ignored." |
632 |
(save-excursion |
(save-excursion |
633 |
(let ((killed-no 0) |
(let ((killed-no 0) |
634 |
function article header) |
function article header extras) |
635 |
(cond |
(cond |
636 |
;; Search body. |
;; Search body. |
637 |
((or (null field) |
((or (null field) |
638 |
(string-equal field "")) |
(string-equal field "")) |
639 |
(setq function nil)) |
(setq function nil)) |
640 |
;; Get access function of header field. |
;; Get access function of header field. |
641 |
((fboundp |
((cond ((fboundp |
642 |
(setq function |
(setq function |
643 |
(intern-soft |
(intern-soft |
644 |
(concat "mail-header-" (downcase field))))) |
(concat "mail-header-" (downcase field))))) |
645 |
(setq function `(lambda (h) (,function h)))) |
(setq function `(lambda (h) (,function h)))) |
646 |
|
((when (setq extras |
647 |
|
(member (downcase field) |
648 |
|
(mapcar (lambda (header) |
649 |
|
(downcase (symbol-name header))) |
650 |
|
gnus-extra-headers))) |
651 |
|
(setq function |
652 |
|
`(lambda (h) |
653 |
|
(gnus-extra-header |
654 |
|
(quote ,(nth (- (length gnus-extra-headers) |
655 |
|
(length extras)) |
656 |
|
gnus-extra-headers)) |
657 |
|
h))))))) |
658 |
;; Signal error. |
;; Signal error. |
659 |
(t |
(t |
660 |
(error "Unknown header field: \"%s\"" field))) |
(error "Unknown header field: \"%s\"" field))) |