Mercurial > emacs
comparison lisp/gnus/gnus-sum.el @ 41494:933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-util.el (gnus-directory-sep-char-regexp): New.
* gnus-score.el (gnus-score-find-bnews): Sync with Gnus CVS.
* mm-util.el: Sync.
* gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version.
(gnus-summary-limit-to-author): Ditto.
(gnus-summary-limit-to-extra): Ditto.
(gnus-summary-find-matching): Support not-matching argument.
* message.el (message-wash-subject): Use `insert' rather than
`insert-string', which is deprecated.
From Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
author | ShengHuo ZHU <zsh@cs.rochester.edu> |
---|---|
date | Sun, 25 Nov 2001 15:17:24 +0000 |
parents | f8ce69d86eea |
children | b24292e7f5ad |
comparison
equal
deleted
inserted
replaced
41493:d85992144288 | 41494:933ab100fb4a |
---|---|
6391 (error "No limit to pop")) | 6391 (error "No limit to pop")) |
6392 (prog1 | 6392 (prog1 |
6393 (gnus-summary-limit nil 'pop) | 6393 (gnus-summary-limit nil 'pop) |
6394 (gnus-summary-position-point))) | 6394 (gnus-summary-position-point))) |
6395 | 6395 |
6396 (defun gnus-summary-limit-to-subject (subject &optional header) | 6396 (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." | 6397 "Limit the summary buffer to articles that have subjects that match a regexp. |
6398 (interactive "sLimit to subject (regexp): ") | 6398 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)) | |
6399 (unless header | 6404 (unless header |
6400 (setq header "subject")) | 6405 (setq header "subject")) |
6401 (when (not (equal "" subject)) | 6406 (when (not (equal "" subject)) |
6402 (prog1 | 6407 (prog1 |
6403 (let ((articles (gnus-summary-find-matching | 6408 (let ((articles (gnus-summary-find-matching |
6404 (or header "subject") subject 'all))) | 6409 (or header "subject") subject 'all nil nil |
6410 not-matching))) | |
6405 (unless articles | 6411 (unless articles |
6406 (error "Found no matches for \"%s\"" subject)) | 6412 (error "Found no matches for \"%s\"" subject)) |
6407 (gnus-summary-limit articles)) | 6413 (gnus-summary-limit articles)) |
6408 (gnus-summary-position-point)))) | 6414 (gnus-summary-position-point)))) |
6409 | 6415 |
6410 (defun gnus-summary-limit-to-author (from) | 6416 (defun gnus-summary-limit-to-author (from) |
6411 "Limit the summary buffer to articles that have authors that match a regexp." | 6417 "Limit the summary buffer to articles that have authors that match a regexp. |
6412 (interactive "sLimit to author (regexp): ") | 6418 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)) | |
6413 (gnus-summary-limit-to-subject from "from")) | 6424 (gnus-summary-limit-to-subject from "from")) |
6414 | 6425 |
6415 (defun gnus-summary-limit-to-age (age &optional younger-p) | 6426 (defun gnus-summary-limit-to-age (age &optional younger-p) |
6416 "Limit the summary buffer to articles that are older than (or equal) AGE days. | 6427 "Limit the summary buffer to articles that are older than (or equal) AGE days. |
6417 If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to | 6428 If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to |
6448 (not is-younger)) | 6459 (not is-younger)) |
6449 (push (gnus-data-number d) articles)))) | 6460 (push (gnus-data-number d) articles)))) |
6450 (gnus-summary-limit (nreverse articles))) | 6461 (gnus-summary-limit (nreverse articles))) |
6451 (gnus-summary-position-point))) | 6462 (gnus-summary-position-point))) |
6452 | 6463 |
6453 (defun gnus-summary-limit-to-extra (header regexp) | 6464 (defun gnus-summary-limit-to-extra (header regexp &optional not-matching) |
6454 "Limit the summary buffer to articles that match an 'extra' header." | 6465 "Limit the summary buffer to articles that match an 'extra' header." |
6455 (interactive | 6466 (interactive |
6456 (let ((header | 6467 (let ((header |
6457 (intern | 6468 (intern |
6458 (gnus-completing-read | 6469 (gnus-completing-read |
6459 (symbol-name (car gnus-extra-headers)) | 6470 (symbol-name (car gnus-extra-headers)) |
6460 "Limit extra header:" | 6471 (if current-prefix-arg |
6472 "Exclude extra header:" | |
6473 "Limit extra header:") | |
6461 (mapcar (lambda (x) | 6474 (mapcar (lambda (x) |
6462 (cons (symbol-name x) x)) | 6475 (cons (symbol-name x) x)) |
6463 gnus-extra-headers) | 6476 gnus-extra-headers) |
6464 nil | 6477 nil |
6465 t)))) | 6478 t)))) |
6466 (list header | 6479 (list header |
6467 (read-string (format "Limit to header %s (regexp): " header))))) | 6480 (read-string (format "%s header %s (regexp): " |
6481 (if current-prefix-arg "Exclude" "Limit to") | |
6482 header)) | |
6483 current-prefix-arg))) | |
6468 (when (not (equal "" regexp)) | 6484 (when (not (equal "" regexp)) |
6469 (prog1 | 6485 (prog1 |
6470 (let ((articles (gnus-summary-find-matching | 6486 (let ((articles (gnus-summary-find-matching |
6471 (cons 'extra header) regexp 'all))) | 6487 (cons 'extra header) regexp 'all nil nil |
6488 not-matching))) | |
6472 (unless articles | 6489 (unless articles |
6473 (error "Found no matches for \"%s\"" regexp)) | 6490 (error "Found no matches for \"%s\"" regexp)) |
6474 (gnus-summary-limit articles)) | 6491 (gnus-summary-limit articles)) |
6475 (gnus-summary-position-point)))) | 6492 (gnus-summary-position-point)))) |
6476 | 6493 |
7213 (gnus-summary-goto-subject gnus-current-article) | 7230 (gnus-summary-goto-subject gnus-current-article) |
7214 (gnus-summary-position-point) | 7231 (gnus-summary-position-point) |
7215 t))) | 7232 t))) |
7216 | 7233 |
7217 (defun gnus-summary-find-matching (header regexp &optional backward unread | 7234 (defun gnus-summary-find-matching (header regexp &optional backward unread |
7218 not-case-fold) | 7235 not-case-fold not-matching) |
7219 "Return a list of all articles that match REGEXP on HEADER. | 7236 "Return a list of all articles that match REGEXP on HEADER. |
7220 The search stars on the current article and goes forwards unless | 7237 The search stars on the current article and goes forwards unless |
7221 BACKWARD is non-nil. If BACKWARD is `all', do all articles. | 7238 BACKWARD is non-nil. If BACKWARD is `all', do all articles. |
7222 If UNREAD is non-nil, only unread articles will | 7239 If UNREAD is non-nil, only unread articles will |
7223 be taken into consideration. If NOT-CASE-FOLD, case won't be folded | 7240 be taken into consideration. If NOT-CASE-FOLD, case won't be folded |
7224 in the comparisons." | 7241 in the comparisons. If NOT-MATCHING, return a list of all articles that |
7225 (let ((data (if (eq backward 'all) gnus-newsgroup-data | 7242 not match REGEXP on HEADER." |
7226 (gnus-data-find-list | 7243 (let ((case-fold-search (not not-case-fold)) |
7227 (gnus-summary-article-number) (gnus-data-list backward)))) | |
7228 (case-fold-search (not not-case-fold)) | |
7229 articles d func) | 7244 articles d func) |
7230 (if (consp header) | 7245 (if (consp header) |
7231 (if (eq (car header) 'extra) | 7246 (if (eq (car header) 'extra) |
7232 (setq func | 7247 (setq func |
7233 `(lambda (h) | 7248 `(lambda (h) |
7235 ""))) | 7250 ""))) |
7236 (error "%s is an invalid header" header)) | 7251 (error "%s is an invalid header" header)) |
7237 (unless (fboundp (intern (concat "mail-header-" header))) | 7252 (unless (fboundp (intern (concat "mail-header-" header))) |
7238 (error "%s is not a valid header" header)) | 7253 (error "%s is not a valid header" header)) |
7239 (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) | 7254 (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) |
7240 (while data | 7255 (dolist (d (if (eq backward 'all) |
7241 (setq d (car data)) | 7256 gnus-newsgroup-data |
7242 (and (or (not unread) ; We want all articles... | 7257 (gnus-data-find-list |
7243 (gnus-data-unread-p d)) ; Or just unreads. | 7258 (gnus-summary-article-number) |
7244 (vectorp (gnus-data-header d)) ; It's not a pseudo. | 7259 (gnus-data-list backward)))) |
7245 (string-match regexp (funcall func (gnus-data-header d))) ; Match. | 7260 (when (and (or (not unread) ; We want all articles... |
7246 (push (gnus-data-number d) articles)) ; Success! | 7261 (gnus-data-unread-p d)) ; Or just unreads. |
7247 (setq data (cdr data))) | 7262 (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! | |
7248 (nreverse articles))) | 7270 (nreverse articles))) |
7249 | 7271 |
7250 (defun gnus-summary-execute-command (header regexp command &optional backward) | 7272 (defun gnus-summary-execute-command (header regexp command &optional backward) |
7251 "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. | 7273 "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. |
7252 If HEADER is an empty string (or nil), the match is done on the entire | 7274 If HEADER is an empty string (or nil), the match is done on the entire |