Function: gnus-advanced-body

gnus-advanced-body is a byte-compiled function defined in gnus-logic.el.gz.

Signature

(gnus-advanced-body HEADER MATCH TYPE)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-logic.el.gz
(defun gnus-advanced-body (header match type)
  (when (string= header "all")
    (setq header "article"))
  (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 handles)
      ;; Not all backends support partial fetching.  In that case, we
      ;; just fetch the entire 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)
        (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))))))))