Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-logic.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents 0293115a14e9
children
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
27 27
28 (require 'gnus) 28 (require 'gnus)
29 (require 'gnus-score) 29 (require 'gnus-score)
30 (require 'gnus-util) 30 (require 'gnus-util)
31 31
32 ;;; Internal variables. 32 ;;; Internal variables.
33 33
34 (defvar gnus-advanced-headers nil) 34 (defvar gnus-advanced-headers nil)
35 35
36 ;; To avoid having 8-bit characters in the source file. 36 ;; To avoid having 8-bit characters in the source file.
37 (defvar gnus-advanced-not (intern (format "%c" 172))) 37 (defvar gnus-advanced-not (intern (format "%c" 172)))
51 ("body" nil gnus-advanced-body) 51 ("body" nil gnus-advanced-body)
52 ("all" nil gnus-advanced-body))) 52 ("all" nil gnus-advanced-body)))
53 53
54 (eval-and-compile 54 (eval-and-compile
55 (autoload 'parse-time-string "parse-time")) 55 (autoload 'parse-time-string "parse-time"))
56 56
57 (defun gnus-score-advanced (rule &optional trace) 57 (defun gnus-score-advanced (rule &optional trace)
58 "Apply advanced scoring RULE to all the articles in the current group." 58 "Apply advanced scoring RULE to all the articles in the current group."
59 (let ((headers gnus-newsgroup-headers) 59 (let ((headers gnus-newsgroup-headers)
60 gnus-advanced-headers score) 60 gnus-advanced-headers score)
61 (while (setq gnus-advanced-headers (pop headers)) 61 (while (setq gnus-advanced-headers (pop headers))
77 gnus-score-trace))))))) 77 gnus-score-trace)))))))
78 78
79 (defun gnus-advanced-score-rule (rule) 79 (defun gnus-advanced-score-rule (rule)
80 "Apply RULE to `gnus-advanced-headers'." 80 "Apply RULE to `gnus-advanced-headers'."
81 (let ((type (car rule))) 81 (let ((type (car rule)))
82 (cond 82 (cond
83 ;; "And" rule. 83 ;; "And" rule.
84 ((or (eq type '&) (eq type 'and)) 84 ((or (eq type '&) (eq type 'and))
85 (pop rule) 85 (pop rule)
86 (if (not rule) 86 (if (not rule)
87 t ; Empty rule is true. 87 t ; Empty rule is true.
104 ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not)) 104 ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not))
105 (not (gnus-advanced-score-rule (nth 1 rule)))) 105 (not (gnus-advanced-score-rule (nth 1 rule))))
106 ;; This is a `1-'-type redirection rule. 106 ;; This is a `1-'-type redirection rule.
107 ((and (symbolp type) 107 ((and (symbolp type)
108 (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) 108 (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
109 (let ((gnus-advanced-headers 109 (let ((gnus-advanced-headers
110 (gnus-parent-headers 110 (gnus-parent-headers
111 gnus-advanced-headers 111 gnus-advanced-headers
112 (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) 112 (if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
113 ;; 1- type redirection. 113 ;; 1- type redirection.
114 (string-to-number 114 (string-to-number
163 163
164 (defun gnus-advanced-date (index match type) 164 (defun gnus-advanced-date (index match type)
165 (let ((date (encode-time (parse-time-string 165 (let ((date (encode-time (parse-time-string
166 (aref gnus-advanced-headers index)))) 166 (aref gnus-advanced-headers index))))
167 (match (encode-time (parse-time-string match)))) 167 (match (encode-time (parse-time-string match))))
168 (cond 168 (cond
169 ((eq type 'at) 169 ((eq type 'at)
170 (equal date match)) 170 (equal date match))
171 ((eq type 'before) 171 ((eq type 'before)
172 (gnus-time-less match date)) 172 (gnus-time-less match date))
173 ((eq type 'after) 173 ((eq type 'after)
186 'gnus-request-body) 186 'gnus-request-body)
187 (t 'gnus-request-article))) 187 (t 'gnus-request-article)))
188 ofunc article) 188 ofunc article)
189 ;; Not all backends support partial fetching. In that case, 189 ;; Not all backends support partial fetching. In that case,
190 ;; we just fetch the entire article. 190 ;; we just fetch the entire article.
191 (unless (gnus-check-backend-function 191 (unless (gnus-check-backend-function
192 (intern (concat "request-" header)) 192 (intern (concat "request-" header))
193 gnus-newsgroup-name) 193 gnus-newsgroup-name)
194 (setq ofunc request-func) 194 (setq ofunc request-func)
195 (setq request-func 'gnus-request-article)) 195 (setq request-func 'gnus-request-article))
196 (setq article (mail-header-number gnus-advanced-headers)) 196 (setq article (mail-header-number gnus-advanced-headers))
208 (narrow-to-region 208 (narrow-to-region
209 (or (search-forward "\n\n" nil t) (point)) 209 (or (search-forward "\n\n" nil t) (point))
210 (point-max)))) 210 (point-max))))
211 (let* ((case-fold-search (not (eq (downcase (symbol-name type)) 211 (let* ((case-fold-search (not (eq (downcase (symbol-name type))
212 (symbol-name type)))) 212 (symbol-name type))))
213 (search-func 213 (search-func
214 (cond ((memq type '(r R regexp Regexp)) 214 (cond ((memq type '(r R regexp Regexp))
215 're-search-forward) 215 're-search-forward)
216 ((memq type '(s S string String)) 216 ((memq type '(s S string String))
217 'search-forward) 217 'search-forward)
218 (t 218 (t