annotate lisp/gnus/gnus-logic.el @ 96543:404cde7e4828

* frame.c (Qinhibit_face_set_after_frame_default): Var deleted. (x_set_frame_parameters): Don't bind it.
author Chong Yidong <cyd@stupidchicken.com>
date Mon, 07 Jul 2008 20:37:37 +0000
parents 645fb33380d6
children a9dc0e7c3f2b
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1 ;;; gnus-logic.el --- advanced scoring code for Gnus
64754
fafd692d1e40 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64085
diff changeset
2
fafd692d1e40 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64085
diff changeset
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
79708
1cb31606209f Add 2008 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 78224
diff changeset
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
5
24357
15fc6acbae7a Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7 ;; Keywords: news
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
10
94662
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
94662
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
13 ;; the Free Software Foundation, either version 3 of the License, or
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
14 ;; (at your option) any later version.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
94662
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
23
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
24 ;;; Commentary:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26 ;;; Code:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27
19521
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
28 (eval-when-compile (require 'cl))
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
29
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
30 (require 'gnus)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31 (require 'gnus-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 (require 'gnus-util)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
34 ;;; Internal variables.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36 (defvar gnus-advanced-headers nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
37
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
38 ;; To avoid having 8-bit characters in the source file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39 (defvar gnus-advanced-not (intern (format "%c" 172)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41 (defconst gnus-advanced-index
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42 ;; Name to index alist.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 '(("number" 0 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 ("subject" 1 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45 ("from" 2 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46 ("date" 3 gnus-advanced-date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 ("message-id" 4 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48 ("references" 5 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
49 ("chars" 6 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50 ("lines" 7 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51 ("xref" 8 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52 ("head" nil gnus-advanced-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 ("body" nil gnus-advanced-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 ("all" nil gnus-advanced-body)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55
95820
645fb33380d6 Remove unnecessary eval-and-compile of autoloads.
Glenn Morris <rgm@gnu.org>
parents: 94662
diff changeset
56 (autoload 'parse-time-string "parse-time")
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
58 (defun gnus-score-advanced (rule &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59 "Apply advanced scoring RULE to all the articles in the current group."
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
60 (let (new-score score multiple)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
61 (dolist (gnus-advanced-headers gnus-newsgroup-headers)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
62 (when (setq multiple (gnus-advanced-score-rule (car rule)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
63 (setq new-score (or (nth 1 rule)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
64 gnus-score-interactive-default-score))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
65 (when (numberp multiple)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
66 (setq new-score (* multiple new-score)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
67 ;; This rule was successful, so we add the score to this
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
68 ;; article.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 (if (setq score (assq (mail-header-number gnus-advanced-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 gnus-newsgroup-scored))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71 (setcdr score
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
72 (+ (cdr score) new-score))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 (push (cons (mail-header-number gnus-advanced-headers)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
74 new-score)
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75 gnus-newsgroup-scored)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 (when trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77 (push (cons "A file" rule)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
78 ;; Must be synced with `gnus-score-edit-file-at-point'.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79 gnus-score-trace)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81 (defun gnus-advanced-score-rule (rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82 "Apply RULE to `gnus-advanced-headers'."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 (let ((type (car rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 ;; "And" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 ((or (eq type '&) (eq type 'and))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 (pop rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 (if (not rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 t ; Empty rule is true.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90 (while (and rule
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 (gnus-advanced-score-rule (car rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 (pop rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93 ;; If all the rules were true, then `rule' should be nil.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 (not rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95 ;; "Or" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 ((or (eq type '|) (eq type 'or))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 (pop rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 (if (not rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99 nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 (while (and rule
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101 (not (gnus-advanced-score-rule (car rule))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 (pop rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 ;; If one of the rules returned true, then `rule' should be non-nil.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105 ;; "Not" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107 (not (gnus-advanced-score-rule (nth 1 rule))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 ;; This is a `1-'-type redirection rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 ((and (symbolp type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
111 (let ((gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 (gnus-parent-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114 (if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115 ;; 1- type redirection.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 (string-to-number
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 (substring (symbol-name type)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
118 (match-beginning 1) (match-end 1)))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119 ;; ^^^ type redirection.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 (length (symbol-name type))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121 (when gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 (gnus-advanced-score-rule (nth 1 rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 ;; Plain scoring rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 ((stringp type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 (gnus-advanced-score-article rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 ;; Bug-out time!
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128 (error "Unknown advanced score type: %s" rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130 (defun gnus-advanced-score-article (rule)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
131 ;; `rule' is a semi-normal score rule, so we find out what function
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
132 ;; that's supposed to do the actual processing.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 (let* ((header (car rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
134 (func (assoc (downcase header) gnus-advanced-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
135 (if (not func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 (error "No such header: %s" rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 ;; Call the score function.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 (funcall (caddr func) (or (cadr func) header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 (cadr rule) (caddr rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141 (defun gnus-advanced-string (index match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142 "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143 (let* ((type (or type 's))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 (case-fold-search (not (eq (downcase (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 (symbol-name type))))
33268
88bece18cf0d 2000-10-07 15:42:59 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents: 31716
diff changeset
146 (header (or (aref gnus-advanced-headers index) "")))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
148 ((memq type '(r R regexp Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149 (string-match match header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 ((memq type '(s S string String))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 (string-match (regexp-quote match) header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152 ((memq type '(e E exact Exact))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
153 (string= match header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
154 ((memq type '(f F fuzzy Fuzzy))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
155 (string-match (regexp-quote (gnus-simplify-subject-fuzzy match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
156 header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
157 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
158 (error "No such string match type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
159
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
160 (defun gnus-advanced-integer (index match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
161 (if (not (memq type '(< > <= >= =)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
162 (error "No such integer score type: %s" type)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
163 (funcall type (or (aref gnus-advanced-headers index) 0) match)))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
164
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
165 (defun gnus-advanced-date (index match type)
24357
15fc6acbae7a Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
166 (let ((date (apply 'encode-time (parse-time-string
15fc6acbae7a Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
167 (aref gnus-advanced-headers index))))
15fc6acbae7a Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
168 (match (apply 'encode-time (parse-time-string match))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
169 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
170 ((eq type 'at)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 (equal date match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 ((eq type 'before)
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
173 (time-less-p match date))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174 ((eq type 'after)
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
175 (time-less-p date match))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
176 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177 (error "No such date score type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 (defun gnus-advanced-body (header match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 (when (string= header "all")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 (setq header "article"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183 (set-buffer nntp-server-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 (let* ((request-func (cond ((string= "head" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 'gnus-request-head)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 ((string= "body" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 'gnus-request-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188 (t 'gnus-request-article)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
189 ofunc article)
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
190 ;; Not all backends support partial fetching. In that case, we
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
191 ;; just fetch the entire article.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 (unless (gnus-check-backend-function
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
193 (intern (concat "request-" header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
194 gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
195 (setq ofunc request-func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
196 (setq request-func 'gnus-request-article))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
197 (setq article (mail-header-number gnus-advanced-headers))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
198 (gnus-message 7 "Scoring article %s..." article)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
199 (when (funcall request-func article gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
200 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
201 ;; If just parts of the article is to be searched and the
56927
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
202 ;; backend didn't support partial fetching, we just narrow to
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents: 52401
diff changeset
203 ;; the relevant parts.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
204 (when ofunc
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
205 (if (eq ofunc 'gnus-request-head)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
206 (narrow-to-region
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
207 (point)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
208 (or (search-forward "\n\n" nil t) (point-max)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
209 (narrow-to-region
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
210 (or (search-forward "\n\n" nil t) (point))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
211 (point-max))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
212 (let* ((case-fold-search (not (eq (downcase (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
213 (symbol-name type))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
214 (search-func
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
215 (cond ((memq type '(r R regexp Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
216 're-search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
217 ((memq type '(s S string String))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
218 'search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
219 (t
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
220 (error "Invalid match type: %s" type)))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
221 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
222 (prog1
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
223 (funcall search-func match nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
224 (widen)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
225
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
226 (provide 'gnus-logic)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
227
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 79708
diff changeset
228 ;; arch-tag: 9651a100-4a59-4b69-a55b-e511e67c0f8d
38413
a26d9b55abb6 Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents: 33342
diff changeset
229 ;;; gnus-logic.el ends here