annotate lisp/gnus/gnus-logic.el @ 89640:99303f55a1b8

(store_in_keymap): Pay attention to the case that idx is a cons specifying a character range.
author Kenichi Handa <handa@m17n.org>
date Sat, 22 Nov 2003 11:04:01 +0000
parents 375f2633d815
children 561b856c5b1f
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
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
3 ;; Free Software Foundation, Inc.
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
4
24357
15fc6acbae7a Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
6 ;; Keywords: news
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
11 ;; 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
12 ;; the Free Software Foundation; either version 2, or (at your option)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
13 ;; any later version.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
14
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
24
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25 ;;; Commentary:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27 ;;; Code:
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
28
19521
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
29 (eval-when-compile (require 'cl))
6f6cf9184e93 Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents: 17493
diff changeset
30
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31 (require 'gnus)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 (require 'gnus-score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33 (require 'gnus-util)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
34
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35 ;;; Internal variables.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
37 (defvar gnus-advanced-headers nil)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
38
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39 ;; To avoid having 8-bit characters in the source file.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40 (defvar gnus-advanced-not (intern (format "%c" 172)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42 (defconst gnus-advanced-index
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 ;; Name to index alist.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 '(("number" 0 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45 ("subject" 1 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46 ("from" 2 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 ("date" 3 gnus-advanced-date)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48 ("message-id" 4 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
49 ("references" 5 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50 ("chars" 6 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51 ("lines" 7 gnus-advanced-integer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52 ("xref" 8 gnus-advanced-string)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 ("head" nil gnus-advanced-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 ("body" nil gnus-advanced-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 ("all" nil gnus-advanced-body)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57 (eval-and-compile
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
58 (autoload 'parse-time-string "parse-time"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60 (defun gnus-score-advanced (rule &optional trace)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61 "Apply advanced scoring RULE to all the articles in the current group."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62 (let ((headers gnus-newsgroup-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
63 gnus-advanced-headers score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
64 (while (setq gnus-advanced-headers (pop headers))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
65 (when (gnus-advanced-score-rule (car rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
66 ;; This rule was successful, so we add the score to
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
67 ;; this article.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
68 (if (setq score (assq (mail-header-number gnus-advanced-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 gnus-newsgroup-scored))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 (setcdr score
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71 (+ (cdr score)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72 (or (nth 1 rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 gnus-score-interactive-default-score)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74 (push (cons (mail-header-number gnus-advanced-headers)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75 (or (nth 1 rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 gnus-score-interactive-default-score))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77 gnus-newsgroup-scored)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 (when trace
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79 (push (cons "A file" rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80 gnus-score-trace)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82 (defun gnus-advanced-score-rule (rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 "Apply RULE to `gnus-advanced-headers'."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84 (let ((type (car rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 ;; "And" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 ((or (eq type '&) (eq type 'and))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 (pop rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 (if (not rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90 t ; Empty rule is true.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 (while (and rule
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 (gnus-advanced-score-rule (car rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93 (pop rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 ;; If all the rules were true, then `rule' should be nil.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95 (not rule)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 ;; "Or" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 ((or (eq type '|) (eq type 'or))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 (pop rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99 (if (not rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 nil
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101 (while (and rule
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 (not (gnus-advanced-score-rule (car rule))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 (pop rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 ;; 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
105 rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 ;; "Not" rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107 ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 (not (gnus-advanced-score-rule (nth 1 rule))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 ;; This is a `1-'-type redirection rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 ((and (symbolp type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
111 (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 (let ((gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 (gnus-parent-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114 gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115 (if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 ;; 1- type redirection.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 (string-to-number
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 (substring (symbol-name type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119 (match-beginning 0) (match-end 0)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 ;; ^^^ type redirection.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121 (length (symbol-name type))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 (when gnus-advanced-headers
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 (gnus-advanced-score-rule (nth 1 rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 ;; Plain scoring rule.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 ((stringp type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 (gnus-advanced-score-article rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127 ;; Bug-out time!
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129 (error "Unknown advanced score type: %s" rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 (defun gnus-advanced-score-article (rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132 ;; `rule' is a semi-normal score rule, so we find out
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 ;; what function that's supposed to do the actual
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
134 ;; processing.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
135 (let* ((header (car rule))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 (func (assoc (downcase header) gnus-advanced-index)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 (if (not func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 (error "No such header: %s" rule)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 ;; Call the score function.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140 (funcall (caddr func) (or (cadr func) header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141 (cadr rule) (caddr rule)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143 (defun gnus-advanced-string (index match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX."
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 (let* ((type (or type 's))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 (case-fold-search (not (eq (downcase (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 (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
148 (header (or (aref gnus-advanced-headers index) "")))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 ((memq type '(r R regexp Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 (string-match match header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152 ((memq type '(s S string String))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
153 (string-match (regexp-quote match) header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
154 ((memq type '(e E exact Exact))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
155 (string= match header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
156 ((memq type '(f F fuzzy Fuzzy))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
157 (string-match (regexp-quote (gnus-simplify-subject-fuzzy match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
158 header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
159 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
160 (error "No such string match type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
161
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
162 (defun gnus-advanced-integer (index match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
163 (if (not (memq type '(< > <= >= =)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
164 (error "No such integer score type: %s" type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
165 (funcall type match (or (aref gnus-advanced-headers index) 0))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
166
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
167 (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
168 (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
169 (aref gnus-advanced-headers index))))
15fc6acbae7a Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents: 19521
diff changeset
170 (match (apply 'encode-time (parse-time-string match))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 (cond
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 ((eq type 'at)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173 (equal date match))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174 ((eq type 'before)
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 match date))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
176 ((eq type 'after)
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
177 (time-less-p date match))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178 (t
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 (error "No such date score type: %s" type)))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 (defun gnus-advanced-body (header match type)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 (when (string= header "all")
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183 (setq header "article"))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 (save-excursion
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 (set-buffer nntp-server-buffer)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 (let* ((request-func (cond ((string= "head" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 'gnus-request-head)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188 ((string= "body" header)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
189 'gnus-request-body)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190 (t 'gnus-request-article)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191 ofunc article)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 ;; Not all backends support partial fetching. In that case,
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
193 ;; we just fetch the entire article.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
194 (unless (gnus-check-backend-function
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
195 (intern (concat "request-" header))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
196 gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
197 (setq ofunc request-func)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
198 (setq request-func 'gnus-request-article))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
199 (setq article (mail-header-number gnus-advanced-headers))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
200 (gnus-message 7 "Scoring article %s..." article)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
201 (when (funcall request-func article gnus-newsgroup-name)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
202 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
203 ;; If just parts of the article is to be searched and the
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
204 ;; backend didn't support partial fetching, we just narrow
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
205 ;; to the relevant parts.
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
206 (when ofunc
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
207 (if (eq ofunc 'gnus-request-head)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
208 (narrow-to-region
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
209 (point)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
210 (or (search-forward "\n\n" nil t) (point-max)))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
211 (narrow-to-region
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
212 (or (search-forward "\n\n" nil t) (point))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
213 (point-max))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
214 (let* ((case-fold-search (not (eq (downcase (symbol-name type))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
215 (symbol-name type))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
216 (search-func
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
217 (cond ((memq type '(r R regexp Regexp))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
218 're-search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
219 ((memq type '(s S string String))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
220 'search-forward)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
221 (t
31716
9968f55ad26e Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents: 24357
diff changeset
222 (error "Invalid match type: %s" type)))))
17493
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
223 (goto-char (point-min))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
224 (prog1
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
225 (funcall search-func match nil t)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
226 (widen)))))))
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
227
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
228 (provide 'gnus-logic)
e6935c08cf0b Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
229
38413
a26d9b55abb6 Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents: 33342
diff changeset
230 ;;; gnus-logic.el ends here