/[emacs]/emacs/lisp/gnus/gnus-kill.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-kill.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5.18.1 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.5.18.2 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
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>
# Line 357  If NEWSGROUP is nil, return the global k Line 357  If NEWSGROUP is nil, return the global k
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.
# Line 398  Returns the number of articles marked as Line 398  Returns the number of articles marked as
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
# Line 428  Returns the number of articles marked as Line 428  Returns the number of articles marked as
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)
# Line 588  COMMAND must be a lisp expression or a s Line 578  COMMAND must be a lisp expression or a s
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)
# Line 608  COMMAND must be a lisp expression or a s Line 598  COMMAND must be a lisp expression or a s
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)))))
# Line 627  COMMAND must be a lisp expression or a s Line 617  COMMAND must be a lisp expression or a s
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)))))))
# Line 641  If optional 2nd argument UNREAD is non-n Line 631  If optional 2nd argument UNREAD is non-n
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)))

Legend:
Removed from v.1.5.18.1  
changed lines
  Added in v.1.5.18.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26