Mercurial > emacs

comparison lisp/gnus/gnus-kill.el @ 31716:9968f55ad26e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Update to emacs-21-branch of the Gnus CVS repository.
author Gerd Moellmann <gerd@gnu.org>
date Tue, 19 Sep 2000 13:37:09 +0000
parents 15fc6acbae7a
children 56f0edca838c
comparison
equal deleted inserted replaced
31715:7c896543d225 31716:9968f55ad26e
1 ;;; gnus-kill.el --- kill commands for Gnus 1 ;;; gnus-kill.el --- kill commands for Gnus
2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
3 ;; Free Software Foundation, Inc.
3 4
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news 7 ;; Keywords: news
7 8
23 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
24 25
25 ;;; Commentary: 26 ;;; Commentary:
26 27
27 ;;; Code: 28 ;;; Code:
28
29 (eval-when-compile (require 'cl))
30 29
31 (eval-when-compile (require 'cl)) 30 (eval-when-compile (require 'cl))
32 31
33 (require 'gnus) 32 (require 'gnus)
34 (require 'gnus-art) 33 (require 'gnus-art)
49 "*If non-nil, will save kill files after processing them." 48 "*If non-nil, will save kill files after processing them."
50 :group 'gnus-score-kill 49 :group 'gnus-score-kill
51 :type 'boolean) 50 :type 'boolean)
52 51
53 (defcustom gnus-winconf-kill-file nil 52 (defcustom gnus-winconf-kill-file nil
54 "What does this do, Lars?" 53 "What does this do, Lars?
54 I don't know, Per."
55 :group 'gnus-score-kill 55 :group 'gnus-score-kill
56 :type 'sexp) 56 :type 'sexp)
57 57
58 (defcustom gnus-kill-killed t 58 (defcustom gnus-kill-killed t
59 "*If non-nil, Gnus will apply kill files to already killed articles. 59 "*If non-nil, Gnus will apply kill files to already killed articles.
429 429
430 ;; Parse a Gnus killfile. 430 ;; Parse a Gnus killfile.
431 (defun gnus-score-insert-help (string alist idx) 431 (defun gnus-score-insert-help (string alist idx)
432 (save-excursion 432 (save-excursion
433 (pop-to-buffer "*Score Help*") 433 (pop-to-buffer "*Score Help*")
434 (buffer-disable-undo (current-buffer)) 434 (buffer-disable-undo)
435 (erase-buffer) 435 (erase-buffer)
436 (insert string ":\n\n") 436 (insert string ":\n\n")
437 (while alist 437 (while alist
438 (insert (format " %c: %s\n" (caar alist) (nth idx (car alist)))) 438 (insert (format " %c: %s\n" (caar alist) (nth idx (car alist))))
439 (setq alist (cdr alist))))) 439 (setq alist (cdr alist)))))
444 (let (beg form) 444 (let (beg form)
445 (while (progn 445 (while (progn
446 (setq beg (point)) 446 (setq beg (point))
447 (setq form (ignore-errors (read (current-buffer))))) 447 (setq form (ignore-errors (read (current-buffer)))))
448 (unless (listp form) 448 (unless (listp form)
449 (error "Illegal kill entry (possibly rn kill file?): %s" form)) 449 (error "Invalid kill entry (possibly rn kill file?): %s" form))
450 (if (or (eq (car form) 'gnus-kill) 450 (if (or (eq (car form) 'gnus-kill)
451 (eq (car form) 'gnus-raise) 451 (eq (car form) 'gnus-raise)
452 (eq (car form) 'gnus-lower)) 452 (eq (car form) 'gnus-lower))
453 (progn 453 (progn
454 (delete-region beg (point)) 454 (delete-region beg (point))
524 ;; It is a list. 524 ;; It is a list.
525 (if (not (consp (cdr kill-list))) 525 (if (not (consp (cdr kill-list)))
526 ;; It's on the form (regexp . date). 526 ;; It's on the form (regexp . date).
527 (if (zerop (gnus-execute field (car kill-list) 527 (if (zerop (gnus-execute field (car kill-list)
528 command nil (not all))) 528 command nil (not all)))
529 (when (> (gnus-days-between date (cdr kill-list)) 529 (when (> (days-between date (cdr kill-list))
530 gnus-kill-expiry-days) 530 gnus-kill-expiry-days)
531 (setq regexp nil)) 531 (setq regexp nil))
532 (setcdr kill-list date)) 532 (setcdr kill-list date))
533 (while (setq kill (car kill-list)) 533 (while (setq kill (car kill-list))
534 (if (consp kill) 534 (if (consp kill)
535 ;; It's a temporary kill. 535 ;; It's a temporary kill.
536 (progn 536 (progn
537 (setq kdate (cdr kill)) 537 (setq kdate (cdr kill))
538 (if (zerop (gnus-execute 538 (if (zerop (gnus-execute
539 field (car kill) command nil (not all))) 539 field (car kill) command nil (not all)))
540 (when (> (gnus-days-between date kdate) 540 (when (> (days-between date kdate)
541 gnus-kill-expiry-days) 541 gnus-kill-expiry-days)
542 ;; Time limit has been exceeded, so we 542 ;; Time limit has been exceeded, so we
543 ;; remove the match. 543 ;; remove the match.
544 (if prev 544 (if prev
545 (setcdr prev (cdr kill-list)) 545 (setcdr prev (cdr kill-list))
566 (and (eq 'quote (car (nth 2 object))) 566 (and (eq 'quote (car (nth 2 object)))
567 (not (consp (cdadr (nth 2 object)))))) 567 (not (consp (cdadr (nth 2 object))))))
568 (concat "\n" (gnus-prin1-to-string object)) 568 (concat "\n" (gnus-prin1-to-string object))
569 (save-excursion 569 (save-excursion
570 (set-buffer (gnus-get-buffer-create "*Gnus PP*")) 570 (set-buffer (gnus-get-buffer-create "*Gnus PP*"))
571 (buffer-disable-undo (current-buffer)) 571 (buffer-disable-undo)
572 (erase-buffer) 572 (erase-buffer)
573 (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) 573 (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object)))
574 (let ((klist (cadr (nth 2 object))) 574 (let ((klist (cadr (nth 2 object)))
575 (first t)) 575 (first t))
576 (while klist 576 (while klist
683 (gnus-newsrc-parse-options 683 (gnus-newsrc-parse-options
684 (concat "options -n " 684 (concat "options -n "
685 (mapconcat 'identity command-line-args-left " ")))) 685 (mapconcat 'identity command-line-args-left " "))))
686 (gnus-expert-user t) 686 (gnus-expert-user t)
687 (nnmail-spool-file nil) 687 (nnmail-spool-file nil)
688 (mail-sources nil)
688 (gnus-use-dribble-file nil) 689 (gnus-use-dribble-file nil)
689 (gnus-batch-mode t) 690 (gnus-batch-mode t)
690 info group newsrc entry 691 info group newsrc entry
691 ;; Disable verbose message. 692 ;; Disable verbose message.
692 gnus-novice-user gnus-large-newsgroup 693 gnus-novice-user gnus-large-newsgroup
702 entry (gnus-gethash group gnus-newsrc-hashtb)) 703 entry (gnus-gethash group gnus-newsrc-hashtb))
703 (when (and (<= (gnus-info-level info) gnus-level-subscribed) 704 (when (and (<= (gnus-info-level info) gnus-level-subscribed)
704 (and (car entry) 705 (and (car entry)
705 (or (eq (car entry) t) 706 (or (eq (car entry) t)
706 (not (zerop (car entry)))))) 707 (not (zerop (car entry))))))
707 (gnus-summary-read-group group nil t nil t) 708 (ignore-errors
709 (gnus-summary-read-group group nil t nil t))
708 (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) 710 (when (eq (current-buffer) (get-buffer gnus-summary-buffer))
709 (gnus-summary-exit)))) 711 (gnus-summary-exit))))
710 ;; Exit Emacs. 712 ;; Exit Emacs.
711 (switch-to-buffer gnus-group-buffer) 713 (switch-to-buffer gnus-group-buffer)
712 (gnus-group-save-newsrc))) 714 (gnus-group-save-newsrc)))