Mercurial > emacs

comparison lisp/gnus/gnus-sum.el @ 41494:933ab100fb4a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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