;;; gnus-logic.el --- advanced scoring code for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(defun gnus-advanced-body (header match type)
(when (string= header "all")
(setq header "article"))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let* ((request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- ofunc article)
+ 'gnus-request-head)
+ ((string= "body" header)
+ 'gnus-request-body)
+ (t 'gnus-request-article)))
+ ofunc article handles)
;; Not all backends support partial fetching. In that case, we
;; just fetch the entire article.
- (unless (gnus-check-backend-function
- (intern (concat "request-" header))
- gnus-newsgroup-name)
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
+ ;; When scoring by body, we need to peek at the headers to detect the
+ ;; content encoding
+ (unless (or (gnus-check-backend-function
+ (intern (concat "request-" header))
+ gnus-newsgroup-name)
+ (string= "body" header))
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
(setq article (mail-header-number gnus-advanced-headers))
(gnus-message 7 "Scoring article %s..." article)
(when (funcall request-func article gnus-newsgroup-name)
- (goto-char (point-min))
- ;; If just parts of the article is to be searched and the
- ;; backend didn't support partial fetching, we just narrow to
- ;; the relevant parts.
- (when ofunc
- (if (eq ofunc 'gnus-request-head)
- (narrow-to-region
- (point)
- (or (search-forward "\n\n" nil t) (point-max)))
- (narrow-to-region
- (or (search-forward "\n\n" nil t) (point))
- (point-max))))
- (let* ((case-fold-search (not (eq (downcase (symbol-name type))
- (symbol-name type))))
- (search-func
- (cond ((memq type '(r R regexp Regexp))
- 're-search-forward)
- ((memq type '(s S string String))
- 'search-forward)
- (t
- (error "Invalid match type: %s" type)))))
- (goto-char (point-min))
- (prog1
- (funcall search-func match nil t)
- (widen)))))))
+ (when (string= "body" header)
+ (setq handles (gnus-score-decode-text-parts)))
+ (goto-char (point-min))
+ ;; If just parts of the article is to be searched and the
+ ;; backend didn't support partial fetching, we just narrow to
+ ;; the relevant parts.
+ (when ofunc
+ (if (eq ofunc 'gnus-request-head)
+ (narrow-to-region
+ (point)
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (narrow-to-region
+ (or (search-forward "\n\n" nil t) (point))
+ (point-max))))
+ (let* ((case-fold-search (not (eq (downcase (symbol-name type))
+ (symbol-name type))))
+ (search-func
+ (cond ((memq type '(r R regexp Regexp))
+ 're-search-forward)
+ ((memq type '(s S string String))
+ 'search-forward)
+ (t
+ (error "Invalid match type: %s" type)))))
+ (goto-char (point-min))
+ (prog1
+ (funcall search-func match nil t)
+ (widen)))
+ (when handles (mm-destroy-parts handles))))))
(provide 'gnus-logic)