/[emacs]/emacs/lisp/gnus/gnus-sum.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-sum.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by gerd, Tue Sep 18 12:25:20 2001 UTC revision 1.25 by zsh, Sun Nov 25 15:17:24 2001 UTC
# Line 6393  If given a prefix, remove all limits." Line 6393  If given a prefix, remove all limits."
6393        (gnus-summary-limit nil 'pop)        (gnus-summary-limit nil 'pop)
6394      (gnus-summary-position-point)))      (gnus-summary-position-point)))
6395    
6396  (defun gnus-summary-limit-to-subject (subject &optional header)  (defun gnus-summary-limit-to-subject (subject &optional header not-matching)
6397    "Limit the summary buffer to articles that have subjects that match a regexp."    "Limit the summary buffer to articles that have subjects that match a regexp.
6398    (interactive "sLimit to subject (regexp): ")  If NOT-MATCHING, excluding articles that have subjects that match a regexp."
6399      (interactive
6400       (list (read-string (if current-prefix-arg
6401                              "Exclude subject (regexp): "
6402                            "Limit to subject (regexp): "))
6403             nil current-prefix-arg))
6404    (unless header    (unless header
6405      (setq header "subject"))      (setq header "subject"))
6406    (when (not (equal "" subject))    (when (not (equal "" subject))
6407      (prog1      (prog1
6408          (let ((articles (gnus-summary-find-matching          (let ((articles (gnus-summary-find-matching
6409                           (or header "subject") subject 'all)))                           (or header "subject") subject 'all nil nil
6410                             not-matching)))
6411            (unless articles            (unless articles
6412              (error "Found no matches for \"%s\"" subject))              (error "Found no matches for \"%s\"" subject))
6413            (gnus-summary-limit articles))            (gnus-summary-limit articles))
6414        (gnus-summary-position-point))))        (gnus-summary-position-point))))
6415    
6416  (defun gnus-summary-limit-to-author (from)  (defun gnus-summary-limit-to-author (from)
6417    "Limit the summary buffer to articles that have authors that match a regexp."    "Limit the summary buffer to articles that have authors that match a regexp.
6418    (interactive "sLimit to author (regexp): ")  If NOT-MATCHING, excluding articles that have authors that match a regexp."
6419      (interactive
6420       (list (read-string (if current-prefix-arg
6421                              "Exclude author (regexp): "
6422                            "Limit to author (regexp): "))
6423             nil current-prefix-arg))
6424    (gnus-summary-limit-to-subject from "from"))    (gnus-summary-limit-to-subject from "from"))
6425    
6426  (defun gnus-summary-limit-to-age (age &optional younger-p)  (defun gnus-summary-limit-to-age (age &optional younger-p)
# Line 6450  articles that are younger than AGE days. Line 6461  articles that are younger than AGE days.
6461          (gnus-summary-limit (nreverse articles)))          (gnus-summary-limit (nreverse articles)))
6462      (gnus-summary-position-point)))      (gnus-summary-position-point)))
6463    
6464  (defun gnus-summary-limit-to-extra (header regexp)  (defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
6465    "Limit the summary buffer to articles that match an 'extra' header."    "Limit the summary buffer to articles that match an 'extra' header."
6466    (interactive    (interactive
6467     (let ((header     (let ((header
6468            (intern            (intern
6469             (gnus-completing-read             (gnus-completing-read
6470              (symbol-name (car gnus-extra-headers))              (symbol-name (car gnus-extra-headers))
6471              "Limit extra header:"              (if current-prefix-arg
6472                    "Exclude extra header:"
6473                  "Limit extra header:")
6474              (mapcar (lambda (x)              (mapcar (lambda (x)
6475                        (cons (symbol-name x) x))                        (cons (symbol-name x) x))
6476                      gnus-extra-headers)                      gnus-extra-headers)
6477              nil              nil
6478              t))))              t))))
6479       (list header       (list header
6480             (read-string (format "Limit to header %s (regexp): " header)))))             (read-string (format "%s header %s (regexp): "
6481                                    (if current-prefix-arg "Exclude" "Limit to")
6482                                    header))
6483               current-prefix-arg)))
6484    (when (not (equal "" regexp))    (when (not (equal "" regexp))
6485      (prog1      (prog1
6486          (let ((articles (gnus-summary-find-matching          (let ((articles (gnus-summary-find-matching
6487                           (cons 'extra header) regexp 'all)))                           (cons 'extra header) regexp 'all nil nil
6488                             not-matching)))
6489            (unless articles            (unless articles
6490              (error "Found no matches for \"%s\"" regexp))              (error "Found no matches for \"%s\"" regexp))
6491            (gnus-summary-limit articles))            (gnus-summary-limit articles))
# Line 7215  Optional argument BACKWARD means do sear Line 7232  Optional argument BACKWARD means do sear
7232        t)))        t)))
7233    
7234  (defun gnus-summary-find-matching (header regexp &optional backward unread  (defun gnus-summary-find-matching (header regexp &optional backward unread
7235                                            not-case-fold)                                            not-case-fold not-matching)
7236    "Return a list of all articles that match REGEXP on HEADER.    "Return a list of all articles that match REGEXP on HEADER.
7237  The search stars on the current article and goes forwards unless  The search stars on the current article and goes forwards unless
7238  BACKWARD is non-nil.  If BACKWARD is `all', do all articles.  BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
7239  If UNREAD is non-nil, only unread articles will  If UNREAD is non-nil, only unread articles will
7240  be taken into consideration.  If NOT-CASE-FOLD, case won't be folded  be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
7241  in the comparisons."  in the comparisons. If NOT-MATCHING, return a list of all articles that
7242    (let ((data (if (eq backward 'all) gnus-newsgroup-data  not match REGEXP on HEADER."
7243                  (gnus-data-find-list    (let ((case-fold-search (not not-case-fold))
                  (gnus-summary-article-number) (gnus-data-list backward))))  
         (case-fold-search (not not-case-fold))  
7244          articles d func)          articles d func)
7245      (if (consp header)      (if (consp header)
7246          (if (eq (car header) 'extra)          (if (eq (car header) 'extra)
# Line 7237  in the comparisons." Line 7252  in the comparisons."
7252        (unless (fboundp (intern (concat "mail-header-" header)))        (unless (fboundp (intern (concat "mail-header-" header)))
7253          (error "%s is not a valid header" header))          (error "%s is not a valid header" header))
7254        (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))        (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
7255      (while data      (dolist (d (if (eq backward 'all)
7256        (setq d (car data))                     gnus-newsgroup-data
7257        (and (or (not unread)             ; We want all articles...                   (gnus-data-find-list
7258                 (gnus-data-unread-p d))  ; Or just unreads.                    (gnus-summary-article-number)
7259             (vectorp (gnus-data-header d)) ; It's not a pseudo.                    (gnus-data-list backward))))
7260             (string-match regexp (funcall func (gnus-data-header d))) ; Match.        (when (and (or (not unread)       ; We want all articles...
7261             (push (gnus-data-number d) articles)) ; Success!                       (gnus-data-unread-p d)) ; Or just unreads.
7262        (setq data (cdr data)))                   (vectorp (gnus-data-header d)) ; It's not a pseudo.
7263                     (if not-matching
7264                         (not (string-match
7265                               regexp
7266                               (funcall func (gnus-data-header d))))
7267                       (string-match regexp
7268                                     (funcall func (gnus-data-header d)))))
7269            (push (gnus-data-number d) articles))) ; Success!
7270      (nreverse articles)))      (nreverse articles)))
7271    
7272  (defun gnus-summary-execute-command (header regexp command &optional backward)  (defun gnus-summary-execute-command (header regexp command &optional backward)

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26