Mercurial > emacs
comparison lisp/gnus/gnus-registry.el @ 87454:0cbc451989a7
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-967
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Fri, 28 Dec 2007 22:26:31 +0000 |
| parents | 1cdfc94602cb |
| children | 107ccd98fa12 |
comparison
equal
deleted
inserted
replaced
| 87453:cdd30283527d | 87454:0cbc451989a7 |
|---|---|
| 584 (mapcar | 584 (mapcar |
| 585 (lambda (x) | 585 (lambda (x) |
| 586 (string-match word x)) | 586 (string-match word x)) |
| 587 list))))) | 587 list))))) |
| 588 | 588 |
| 589 (defun gnus-registry-mark-article (article &optional mark remove) | |
| 590 "Mark ARTICLE with MARK in the Gnus registry or remove MARK. | |
| 591 MARK can be any symbol. If ARTICLE is nil, then the | |
| 592 `gnus-current-article' will be marked. If MARK is nil, | |
| 593 `gnus-registry-flag-default' will be used." | |
| 594 (interactive "nArticle number: ") | |
| 595 (let ((article (or article gnus-current-article)) | |
| 596 (mark (or mark 'gnus-registry-flag-default)) | |
| 597 article-id) | |
| 598 (unless article | |
| 599 (error "No article on current line")) | |
| 600 (setq article-id | |
| 601 (gnus-registry-fetch-message-id-fast gnus-current-article)) | |
| 602 (unless article-id | |
| 603 (error "No article ID could be retrieved")) | |
| 604 (let* ( | |
| 605 ;; all the marks for this article | |
| 606 (marks (gnus-registry-fetch-extra-flags article-id)) | |
| 607 ;; the marks without the mark of interest | |
| 608 (cleaned-marks (delq mark marks)) | |
| 609 ;; the new marks we want to use | |
| 610 (new-marks (if remove | |
| 611 cleaned-marks | |
| 612 (cons mark cleaned-marks)))) | |
| 613 (apply 'gnus-registry-store-extra-flags ; set the extra flags | |
| 614 article-id ; for the message ID | |
| 615 new-marks) | |
| 616 (gnus-registry-fetch-extra-flags article-id)))) | |
| 617 | |
| 618 (defun gnus-registry-article-marks (article) | |
| 619 "Get the Gnus registry marks for ARTICLE. | |
| 620 If ARTICLE is nil, then the `gnus-current-article' will be | |
| 621 used." | |
| 622 (interactive "nArticle number: ") | |
| 623 (let ((article (or article gnus-current-article)) | |
| 624 article-id) | |
| 625 (unless article | |
| 626 (error "No article on current line")) | |
| 627 (setq article-id | |
| 628 (gnus-registry-fetch-message-id-fast gnus-current-article)) | |
| 629 (unless article-id | |
| 630 (error "No article ID could be retrieved")) | |
| 631 (gnus-message 1 | |
| 632 "Message ID %s, Registry flags: %s" | |
| 633 article-id | |
| 634 (concat (gnus-registry-fetch-extra-flags article-id))))) | |
| 635 | |
| 636 | |
| 589 ;;; if this extends to more than 'flags, it should be improved to be more generic. | 637 ;;; if this extends to more than 'flags, it should be improved to be more generic. |
| 590 (defun gnus-registry-fetch-extra-flags (id) | 638 (defun gnus-registry-fetch-extra-flags (id) |
| 591 "Get the flags of a message, based on the message ID. | 639 "Get the flags of a message, based on the message ID. |
| 592 Returns a list of symbol flags or nil." | 640 Returns a list of symbol flags or nil." |
| 593 (car-safe (cdr (gnus-registry-fetch-extra id 'flags)))) | 641 (car-safe (cdr (gnus-registry-fetch-extra id 'flags)))) |