annotate lisp/gnus/gnus-logic.el @ 77901:a794fbd6b0c9

(sregexq): Fix doc string quoting.
author Chong Yidong <cyd@stupidchicken.com>
date Mon, 04 Jun 2007 23:51:01 +0000
parents e3694f1cb928
children 24202b793a08 95d0cdf160ea
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,
75347
e3694f1cb928 Add 2007 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 68633
diff changeset
4 ;; 2005, 2006, 2007 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
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
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
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
14 ;; any later version.
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
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64085
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 56927
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 56927
diff changeset
24 ;; Boston, MA 02110-1301, USA.
17493
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 ;;; Commentary:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
28 ;;; Code:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
29
19521
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
30 (eval-when-compile (require 'cl))
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
31
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 (require 'gnus)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33 (require 'gnus-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
34 (require 'gnus-util)
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 ;;; Internal variables.
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 (defvar gnus-advanced-headers nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40 ;; To avoid having 8-bit characters in the source file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41 (defvar gnus-advanced-not (intern (format "%c" 172)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 (defconst gnus-advanced-index
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 ;; Name to index alist.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45 '(("number" 0 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46 ("subject" 1 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 ("from" 2 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48 ("date" 3 gnus-advanced-date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
49 ("message-id" 4 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50 ("references" 5 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51 ("chars" 6 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52 ("lines" 7 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 ("xref" 8 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 ("head" nil gnus-advanced-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 ("body" nil gnus-advanced-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56 ("all" nil gnus-advanced-body)))
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 (eval-and-compile
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59 (autoload 'parse-time-string "parse-time"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61 (defun gnus-score-advanced (rule &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62 "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
63 (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
64 (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
65 (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
66 (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
67 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
68 (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
69 (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
70 ;; 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
71 ;; article.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72 (if (setq score (assq (mail-header-number gnus-advanced-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 gnus-newsgroup-scored))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74 (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
75 (+ (cdr score) new-score))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 (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
77 new-score)
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 gnus-newsgroup-scored)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79 (when trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80 (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
81 ;; Must be synced with `gnus-score-edit-file-at-point'.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82 gnus-score-trace)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84 (defun gnus-advanced-score-rule (rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 "Apply RULE to `gnus-advanced-headers'."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 (let ((type (car rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 ;; "And" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 ((or (eq type '&) (eq type 'and))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90 (pop rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 (if (not rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 t ; Empty rule is true.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93 (while (and rule
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 (gnus-advanced-score-rule (car rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95 (pop rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 ;; If all the rules were true, then `rule' should be nil.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 (not rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 ;; "Or" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99 ((or (eq type '|) (eq type 'or))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 (pop rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101 (if (not rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 (while (and rule
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 (not (gnus-advanced-score-rule (car rule))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105 (pop rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 ;; 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
107 rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 ;; "Not" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 (not (gnus-advanced-score-rule (nth 1 rule))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
111 ;; This is a `1-'-type redirection rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 ((and (symbolp type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114 (let ((gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115 (gnus-parent-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 (if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 ;; 1- type redirection.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119 (string-to-number
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 (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
121 (match-beginning 1) (match-end 1)))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 ;; ^^^ type redirection.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 (length (symbol-name type))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 (when gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 (gnus-advanced-score-rule (nth 1 rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 ;; Plain scoring rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127 ((stringp type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128 (gnus-advanced-score-article rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129 ;; Bug-out time!
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 (error "Unknown advanced score type: %s" rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 (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
134 ;; `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
135 ;; that's supposed to do the actual processing.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 (let* ((header (car rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 (func (assoc (downcase header) gnus-advanced-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 (if (not func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 (error "No such header: %s" rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140 ;; Call the score function.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141 (funcall (caddr func) (or (cadr func) header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142 (cadr rule) (caddr rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 (defun gnus-advanced-string (index match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 (let* ((type (or type 's))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 (case-fold-search (not (eq (downcase (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
148 (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
149 (header (or (aref gnus-advanced-headers index) "")))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 ((memq type '(r R regexp Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152 (string-match match header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
153 ((memq type '(s S string String))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
154 (string-match (regexp-quote match) header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
155 ((memq type '(e E exact Exact))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
156 (string= match header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
157 ((memq type '(f F fuzzy Fuzzy))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
158 (string-match (regexp-quote (gnus-simplify-subject-fuzzy match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
159 header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
160 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
161 (error "No such string match type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
162
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
163 (defun gnus-advanced-integer (index match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
164 (if (not (memq type '(< > <= >= =)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
165 (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
166 (funcall type (or (aref gnus-advanced-headers index) 0) match)))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
167
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
168 (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
169 (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
170 (aref gnus-advanced-headers index))))
15fc6acbae7a Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
171 (match (apply 'encode-time (parse-time-string match))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173 ((eq type 'at)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174 (equal date match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
175 ((eq type 'before)
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
176 (time-less-p match date))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177 ((eq type 'after)
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
178 (time-less-p date match))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 (error "No such date score type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 (defun gnus-advanced-body (header match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183 (when (string= header "all")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 (setq header "article"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 (set-buffer nntp-server-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 (let* ((request-func (cond ((string= "head" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188 'gnus-request-head)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
189 ((string= "body" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190 'gnus-request-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191 (t 'gnus-request-article)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 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
193 ;; 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
194 ;; just fetch the entire article.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
195 (unless (gnus-check-backend-function
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
196 (intern (concat "request-" header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
197 gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
198 (setq ofunc request-func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
199 (setq request-func 'gnus-request-article))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
200 (setq article (mail-header-number gnus-advanced-headers))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
201 (gnus-message 7 "Scoring article %s..." article)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
202 (when (funcall request-func article gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
203 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
204 ;; 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
205 ;; 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
206 ;; the relevant parts.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
207 (when ofunc
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
208 (if (eq ofunc 'gnus-request-head)
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 (point)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
211 (or (search-forward "\n\n" nil t) (point-max)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
212 (narrow-to-region
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
213 (or (search-forward "\n\n" nil t) (point))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
214 (point-max))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
215 (let* ((case-fold-search (not (eq (downcase (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
216 (symbol-name type))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
217 (search-func
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
218 (cond ((memq type '(r R regexp Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
219 're-search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
220 ((memq type '(s S string String))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
221 'search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
222 (t
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
223 (error "Invalid match type: %s" type)))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
224 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
225 (prog1
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
226 (funcall search-func match nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
227 (widen)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
228
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
229 (provide 'gnus-logic)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
230
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 38413
diff changeset
231 ;;; 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
232 ;;; gnus-logic.el ends here