Mercurial > emacs

comparison lisp/gnus/gnus-kill.el @ 24357:15fc6acbae7a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Upgrading to Gnus 5.7; see ChangeLog
author Lars Magne Ingebrigtsen <larsi@gnus.org>
date Sat, 20 Feb 1999 14:05:57 +0000
parents 6f6cf9184e93
children 9968f55ad26e
comparison
equal deleted inserted replaced
24356:a5a611ef40f6 24357:15fc6acbae7a
1 ;;; gnus-kill.el --- kill commands for Gnus 1 ;;; gnus-kill.el --- kill commands for Gnus
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
3 3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 5 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news 6 ;; Keywords: news
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
9 9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify 10 ;; GNU Emacs is free software; you can redistribute it and/or modify
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Commentary: 25 ;;; Commentary:
26 26
27 ;;; Code: 27 ;;; Code:
28
29 (eval-when-compile (require 'cl))
28 30
29 (eval-when-compile (require 'cl)) 31 (eval-when-compile (require 'cl))
30 32
31 (require 'gnus) 33 (require 'gnus)
32 (require 'gnus-art) 34 (require 'gnus-art)
157 (use-local-map gnus-kill-file-mode-map) 159 (use-local-map gnus-kill-file-mode-map)
158 (set-syntax-table emacs-lisp-mode-syntax-table) 160 (set-syntax-table emacs-lisp-mode-syntax-table)
159 (setq major-mode 'gnus-kill-file-mode) 161 (setq major-mode 'gnus-kill-file-mode)
160 (setq mode-name "Kill") 162 (setq mode-name "Kill")
161 (lisp-mode-variables nil) 163 (lisp-mode-variables nil)
162 (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) 164 (gnus-run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
163 165
164 (defun gnus-kill-file-edit-file (newsgroup) 166 (defun gnus-kill-file-edit-file (newsgroup)
165 "Begin editing a kill file for NEWSGROUP. 167 "Begin editing a kill file for NEWSGROUP.
166 If NEWSGROUP is nil, the global kill file is selected." 168 If NEWSGROUP is nil, the global kill file is selected."
167 (interactive "sNewsgroup: ") 169 (interactive "sNewsgroup: ")
404 (while kill-files 406 (while kill-files
405 (if (not (file-exists-p (car kill-files))) 407 (if (not (file-exists-p (car kill-files)))
406 () 408 ()
407 (gnus-message 6 "Processing kill file %s..." (car kill-files)) 409 (gnus-message 6 "Processing kill file %s..." (car kill-files))
408 (find-file (car kill-files)) 410 (find-file (car kill-files))
409 (gnus-add-current-to-buffer-list)
410 (goto-char (point-min)) 411 (goto-char (point-min))
411 412
412 (if (consp (ignore-errors (read (current-buffer)))) 413 (if (consp (ignore-errors (read (current-buffer))))
413 (gnus-kill-parse-gnus-kill-file) 414 (gnus-kill-parse-gnus-kill-file)
414 (gnus-kill-parse-rn-kill-file)) 415 (gnus-kill-parse-rn-kill-file))
467 (let ((mod-to-header 468 (let ((mod-to-header
468 '((?a . "") 469 '((?a . "")
469 (?h . "") 470 (?h . "")
470 (?f . "from") 471 (?f . "from")
471 (?: . "subject"))) 472 (?: . "subject")))
472 (com-to-com 473 ;;(com-to-com
473 '((?m . " ") 474 ;; '((?m . " ")
474 (?j . "X"))) 475 ;; (?j . "X")))
475 pattern modifier commands) 476 pattern modifier commands)
476 (while (not (eobp)) 477 (while (not (eobp))
477 (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) 478 (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)"))
478 () 479 ()
479 (setq pattern (buffer-substring (match-beginning 1) (match-end 1))) 480 (setq pattern (buffer-substring (match-beginning 1) (match-end 1)))
564 (not (consp (cdr (nth 2 object)))) 565 (not (consp (cdr (nth 2 object))))
565 (and (eq 'quote (car (nth 2 object))) 566 (and (eq 'quote (car (nth 2 object)))
566 (not (consp (cdadr (nth 2 object)))))) 567 (not (consp (cdadr (nth 2 object))))))
567 (concat "\n" (gnus-prin1-to-string object)) 568 (concat "\n" (gnus-prin1-to-string object))
568 (save-excursion 569 (save-excursion
569 (set-buffer (get-buffer-create "*Gnus PP*")) 570 (set-buffer (gnus-get-buffer-create "*Gnus PP*"))
570 (buffer-disable-undo (current-buffer)) 571 (buffer-disable-undo (current-buffer))
571 (erase-buffer) 572 (erase-buffer)
572 (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)))
573 (let ((klist (cadr (nth 2 object))) 574 (let ((klist (cadr (nth 2 object)))
574 (first t)) 575 (first t))
674 ;;;###autoload 675 ;;;###autoload
675 (defalias 'gnus-batch-kill 'gnus-batch-score) 676 (defalias 'gnus-batch-kill 'gnus-batch-score)
676 ;;;###autoload 677 ;;;###autoload
677 (defun gnus-batch-score () 678 (defun gnus-batch-score ()
678 "Run batched scoring. 679 "Run batched scoring.
679 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ... 680 Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
680 Newsgroups is a list of strings in Bnews format. If you want to score
681 the comp hierarchy, you'd say \"comp.all\". If you would not like to
682 score the alt hierarchy, you'd say \"!alt.all\"."
683 (interactive) 681 (interactive)
684 (let* ((gnus-newsrc-options-n 682 (let* ((gnus-newsrc-options-n
685 (gnus-newsrc-parse-options 683 (gnus-newsrc-parse-options
686 (concat "options -n " 684 (concat "options -n "
687 (mapconcat 'identity command-line-args-left " ")))) 685 (mapconcat 'identity command-line-args-left " "))))
688 (gnus-expert-user t) 686 (gnus-expert-user t)
689 (nnmail-spool-file nil) 687 (nnmail-spool-file nil)
690 (gnus-use-dribble-file nil) 688 (gnus-use-dribble-file nil)
691 (gnus-batch-mode t) 689 (gnus-batch-mode t)
692 group newsrc entry 690 info group newsrc entry
693 ;; Disable verbose message. 691 ;; Disable verbose message.
694 gnus-novice-user gnus-large-newsgroup 692 gnus-novice-user gnus-large-newsgroup
695 gnus-options-subscribe gnus-auto-subscribed-groups 693 gnus-options-subscribe gnus-auto-subscribed-groups
696 gnus-options-not-subscribe) 694 gnus-options-not-subscribe)
697 ;; Eat all arguments. 695 ;; Eat all arguments.
698 (setq command-line-args-left nil) 696 (setq command-line-args-left nil)
699 (gnus-slave) 697 (gnus-slave)
700 ;; Apply kills to specified newsgroups in command line arguments. 698 ;; Apply kills to specified newsgroups in command line arguments.
701 (setq newsrc (cdr gnus-newsrc-alist)) 699 (setq newsrc (cdr gnus-newsrc-alist))
702 (while (setq group (car (pop newsrc))) 700 (while (setq info (pop newsrc))
703 (setq entry (gnus-gethash group gnus-newsrc-hashtb)) 701 (setq group (gnus-info-group info)
704 (when (and (<= (gnus-info-level (car newsrc)) gnus-level-subscribed) 702 entry (gnus-gethash group gnus-newsrc-hashtb))
703 (when (and (<= (gnus-info-level info) gnus-level-subscribed)
705 (and (car entry) 704 (and (car entry)
706 (or (eq (car entry) t) 705 (or (eq (car entry) t)
707 (not (zerop (car entry))))) 706 (not (zerop (car entry))))))
708 ;;(eq (gnus-matches-options-n group) 'subscribe)
709 )
710 (gnus-summary-read-group group nil t nil t) 707 (gnus-summary-read-group group nil t nil t)
711 (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) 708 (when (eq (current-buffer) (get-buffer gnus-summary-buffer))
712 (gnus-summary-exit)))) 709 (gnus-summary-exit))))
713 ;; Exit Emacs. 710 ;; Exit Emacs.
714 (switch-to-buffer gnus-group-buffer) 711 (switch-to-buffer gnus-group-buffer)