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) |
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)) |
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) |
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) |