Mercurial > emacs

comparison lisp/gnus/gnus-kill.el @ 82951:0fde48feb604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
56503:8bbd2323fbf2 82951:0fde48feb604
1 ;;; gnus-kill.el --- kill commands for Gnus 1 ;;; gnus-kill.el --- kill commands for Gnus
2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003
3 ;; Free Software Foundation, Inc. 3 ;; Free Software Foundation, Inc.
4 4
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news 7 ;; Keywords: news
355 (gnus-summary-limit-to-marks marks 'reverse))) 355 (gnus-summary-limit-to-marks marks 'reverse)))
356 356
357 (defun gnus-apply-kill-file-unless-scored () 357 (defun gnus-apply-kill-file-unless-scored ()
358 "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." 358 "Apply .KILL file, unless a .SCORE file for the same newsgroup exists."
359 (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) 359 (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
360 ;; Ignores global KILL. 360 ;; Ignores global KILL.
361 (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) 361 (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
362 (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" 362 (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
363 gnus-newsgroup-name)) 363 gnus-newsgroup-name))
364 0) 364 0)
365 ((or (file-exists-p (gnus-newsgroup-kill-file nil)) 365 ((or (file-exists-p (gnus-newsgroup-kill-file nil))
366 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) 366 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
367 (gnus-apply-kill-file-internal)) 367 (gnus-apply-kill-file-internal))
368 (t 368 (t
369 0))) 369 0)))
370 370
371 (defun gnus-apply-kill-file-internal () 371 (defun gnus-apply-kill-file-internal ()
372 "Apply a kill file to the current newsgroup. 372 "Apply a kill file to the current newsgroup.
373 Returns the number of articles marked as read." 373 Returns the number of articles marked as read."
374 (let* ((kill-files (list (gnus-newsgroup-kill-file nil) 374 (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
396 gnus-newsgroup-killed) 396 gnus-newsgroup-killed)
397 (push (mail-header-number (car headers)) 397 (push (mail-header-number (car headers))
398 gnus-newsgroup-kill-headers)) 398 gnus-newsgroup-kill-headers))
399 (setq headers (cdr headers)))) 399 (setq headers (cdr headers))))
400 (setq files nil)) 400 (setq files nil))
401 (setq files (cdr files))))) 401 (setq files (cdr files)))))
402 (if (not gnus-newsgroup-kill-headers) 402 (if (not gnus-newsgroup-kill-headers)
403 () 403 ()
404 (save-window-excursion 404 (save-window-excursion
405 (save-excursion 405 (save-excursion
406 (while kill-files 406 (while kill-files
426 (gnus-message 6 "Marked %d articles as read" nunreads)) 426 (gnus-message 6 "Marked %d articles as read" nunreads))
427 nunreads) 427 nunreads)
428 0)))) 428 0))))
429 429
430 ;; Parse a Gnus killfile. 430 ;; Parse a Gnus killfile.
431 (defun gnus-score-insert-help (string alist idx)
432 (save-excursion
433 (pop-to-buffer "*Score Help*")
434 (buffer-disable-undo)
435 (erase-buffer)
436 (insert string ":\n\n")
437 (while alist
438 (insert (format " %c: %s\n" (caar alist) (nth idx (car alist))))
439 (setq alist (cdr alist)))))
440
441 (defun gnus-kill-parse-gnus-kill-file () 431 (defun gnus-kill-parse-gnus-kill-file ()
442 (goto-char (point-min)) 432 (goto-char (point-min))
443 (gnus-kill-file-mode) 433 (gnus-kill-file-mode)
444 (let (beg form) 434 (let (beg form)
445 (while (progn 435 (while (progn
586 (gnus-prin1-to-string (nth 3 object)))) 576 (gnus-prin1-to-string (nth 3 object))))
587 (when (nth 4 object) 577 (when (nth 4 object)
588 (insert "\n t")) 578 (insert "\n t"))
589 (insert ")") 579 (insert ")")
590 (prog1 580 (prog1
591 (buffer-substring (point-min) (point-max)) 581 (buffer-string)
592 (kill-buffer (current-buffer)))))) 582 (kill-buffer (current-buffer))))))
593 583
594 (defun gnus-execute-1 (function regexp form header) 584 (defun gnus-execute-1 (function regexp form header)
595 (save-excursion 585 (save-excursion
596 (let (did-kill) 586 (let (did-kill)
606 (unless (stringp value) 596 (unless (stringp value)
607 (setq value (gnus-prin1-to-string value))) 597 (setq value (gnus-prin1-to-string value)))
608 (setq did-kill (string-match regexp value))) 598 (setq did-kill (string-match regexp value)))
609 (cond ((stringp form) ;Keyboard macro. 599 (cond ((stringp form) ;Keyboard macro.
610 (execute-kbd-macro form)) 600 (execute-kbd-macro form))
611 ((gnus-functionp form) 601 ((functionp form)
612 (funcall form)) 602 (funcall form))
613 (t 603 (t
614 (eval form))))) 604 (eval form)))))
615 ;; Search article body. 605 ;; Search article body.
616 (let ((gnus-current-article nil) ;Save article pointer. 606 (let ((gnus-current-article nil) ;Save article pointer.
625 (set-buffer gnus-article-buffer) 615 (set-buffer gnus-article-buffer)
626 (goto-char (point-min)) 616 (goto-char (point-min))
627 (setq did-kill (re-search-forward regexp nil t))) 617 (setq did-kill (re-search-forward regexp nil t)))
628 (cond ((stringp form) ;Keyboard macro. 618 (cond ((stringp form) ;Keyboard macro.
629 (execute-kbd-macro form)) 619 (execute-kbd-macro form))
630 ((gnus-functionp form) 620 ((functionp form)
631 (funcall form)) 621 (funcall form))
632 (t 622 (t
633 (eval form))))))) 623 (eval form)))))))
634 did-kill))) 624 did-kill)))
635 625
639 If optional 1st argument BACKWARD is non-nil, do backward instead. 629 If optional 1st argument BACKWARD is non-nil, do backward instead.
640 If optional 2nd argument UNREAD is non-nil, articles which are 630 If optional 2nd argument UNREAD is non-nil, articles which are
641 marked as read or ticked are ignored." 631 marked as read or ticked are ignored."
642 (save-excursion 632 (save-excursion
643 (let ((killed-no 0) 633 (let ((killed-no 0)
644 function article header) 634 function article header extras)
645 (cond 635 (cond
646 ;; Search body. 636 ;; Search body.
647 ((or (null field) 637 ((or (null field)
648 (string-equal field "")) 638 (string-equal field ""))
649 (setq function nil)) 639 (setq function nil))
650 ;; Get access function of header field. 640 ;; Get access function of header field.
651 ((fboundp 641 ((cond ((fboundp
652 (setq function 642 (setq function
653 (intern-soft 643 (intern-soft
654 (concat "mail-header-" (downcase field))))) 644 (concat "mail-header-" (downcase field)))))
655 (setq function `(lambda (h) (,function h)))) 645 (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)))))))
656 ;; Signal error. 658 ;; Signal error.
657 (t 659 (t
658 (error "Unknown header field: \"%s\"" field))) 660 (error "Unknown header field: \"%s\"" field)))
659 ;; Starting from the current article. 661 ;; Starting from the current article.
660 (while (or 662 (while (or