Mercurial > emacs
diff lisp/gnus/gnus-kill.el @ 82951:0fde48feb604
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author | Andreas Schwab <schwab@suse.de> |
---|---|
date | Thu, 22 Jul 2004 16:45:51 +0000 |
parents | 695cf19ef79e |
children | 4b7fa3ee8e9e cce1c0ee76ee |
line wrap: on
line diff
--- a/lisp/gnus/gnus-kill.el Thu Jul 22 14:26:26 2004 +0000 +++ b/lisp/gnus/gnus-kill.el Thu Jul 22 16:45:51 2004 +0000 @@ -1,5 +1,5 @@ ;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -357,16 +357,16 @@ (defun gnus-apply-kill-file-unless-scored () "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) - ;; Ignores global KILL. - (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) + ;; Ignores global KILL. + (when (file-exists-p (gnus-newsgroup-kill-file 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))) - (gnus-apply-kill-file-internal)) - (t - 0))) + 0) + ((or (file-exists-p (gnus-newsgroup-kill-file nil)) + (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) + (gnus-apply-kill-file-internal)) + (t + 0))) (defun gnus-apply-kill-file-internal () "Apply a kill file to the current newsgroup. @@ -398,7 +398,7 @@ gnus-newsgroup-kill-headers)) (setq headers (cdr headers)))) (setq files nil)) - (setq files (cdr files))))) + (setq files (cdr files))))) (if (not gnus-newsgroup-kill-headers) () (save-window-excursion @@ -428,16 +428,6 @@ 0)))) ;; 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))))) - (defun gnus-kill-parse-gnus-kill-file () (goto-char (point-min)) (gnus-kill-file-mode) @@ -588,7 +578,7 @@ (insert "\n t")) (insert ")") (prog1 - (buffer-substring (point-min) (point-max)) + (buffer-string) (kill-buffer (current-buffer)))))) (defun gnus-execute-1 (function regexp form header) @@ -608,7 +598,7 @@ (setq did-kill (string-match regexp value))) (cond ((stringp form) ;Keyboard macro. (execute-kbd-macro form)) - ((gnus-functionp form) + ((functionp form) (funcall form)) (t (eval form))))) @@ -627,7 +617,7 @@ (setq did-kill (re-search-forward regexp nil t))) (cond ((stringp form) ;Keyboard macro. (execute-kbd-macro form)) - ((gnus-functionp form) + ((functionp form) (funcall form)) (t (eval form))))))) @@ -641,18 +631,30 @@ marked as read or ticked are ignored." (save-excursion (let ((killed-no 0) - function article header) + function article header extras) (cond ;; Search body. ((or (null field) (string-equal field "")) (setq function nil)) ;; Get access function of header field. - ((fboundp - (setq function - (intern-soft - (concat "mail-header-" (downcase field))))) - (setq function `(lambda (h) (,function h)))) + ((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)))