Mercurial > emacs
comparison lisp/mail/rmailkwd.el @ 101765:119f13a715df
(rmail-label-obarray): Initialize using rmail-attr-array.
(rmail-make-label, rmail-read-label): Give it a doc string.
(rmail-add-label, rmail-kill-label): Change argument name to match the
doc. Doc fix.
(rmail-set-label): Doc fix. Also update summary in attr case.
Accept labels as a string or a symbol. (Bug#2165)
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Tue, 03 Feb 2009 04:07:02 +0000 |
| parents | 13338e3ca8a7 |
| children | e6f035f6e27e |
comparison
equal
deleted
inserted
replaced
| 101764:594205e8404b | 101765:119f13a715df |
|---|---|
| 25 | 25 |
| 26 ;;; Code: | 26 ;;; Code: |
| 27 | 27 |
| 28 (require 'rmail) | 28 (require 'rmail) |
| 29 | 29 |
| 30 ;; Global to all RMAIL buffers. It exists primarily for the sake of | 30 ;; Global to all RMAIL buffers. It exists for the sake of completion. |
| 31 ;; completion. It is better to use strings with the label functions | 31 ;; It is better to use strings with the label functions and let them |
| 32 ;; and let them worry about making the label. | 32 ;; worry about making the label. |
| 33 (defvar rmail-label-obarray (make-vector 47 0) | |
| 34 "Obarray of labels used by Rmail. | |
| 35 `rmail-read-label' uses this to offer completion.") | |
| 33 | 36 |
| 34 (defvar rmail-label-obarray (make-vector 47 0)) | 37 ;; Initialize with the standard labels. |
| 35 | 38 (mapc (lambda (s) (intern (cadr s) rmail-label-obarray)) |
| 36 (mapc (function (lambda (s) (intern s rmail-label-obarray))) | 39 rmail-attr-array) |
| 37 '("deleted" "answered" "filed" "forwarded" "unseen" "edited" | |
| 38 "resent")) | |
| 39 | 40 |
| 40 (defun rmail-make-label (s) | 41 (defun rmail-make-label (s) |
| 42 "Convert string S to a downcased symbol in `rmail-label-obarray'." | |
| 41 (intern (downcase s) rmail-label-obarray)) | 43 (intern (downcase s) rmail-label-obarray)) |
| 42 | 44 |
| 43 ;;;###autoload | 45 ;;;###autoload |
| 44 (defun rmail-add-label (string) | 46 (defun rmail-add-label (label) |
| 45 "Add LABEL to labels associated with current RMAIL message. | 47 "Add LABEL to labels associated with current RMAIL message. |
| 46 Performs completion over known labels when reading." | 48 Completes (see `rmail-read-label') over known labels when reading. |
| 49 LABEL may be a symbol or string." | |
| 47 (interactive (list (rmail-read-label "Add label"))) | 50 (interactive (list (rmail-read-label "Add label"))) |
| 48 (rmail-set-label string t)) | 51 (rmail-set-label label t)) |
| 49 | 52 |
| 50 ;;;###autoload | 53 ;;;###autoload |
| 51 (defun rmail-kill-label (string) | 54 (defun rmail-kill-label (label) |
| 52 "Remove LABEL from labels associated with current RMAIL message. | 55 "Remove LABEL from labels associated with current RMAIL message. |
| 53 Performs completion over known labels when reading." | 56 Completes (see `rmail-read-label') over known labels when reading. |
| 57 LABEL may be a symbol or string." | |
| 54 (interactive (list (rmail-read-label "Remove label"))) | 58 (interactive (list (rmail-read-label "Remove label"))) |
| 55 (rmail-set-label string nil)) | 59 (rmail-set-label label nil)) |
| 56 | 60 |
| 57 ;;;###autoload | 61 ;;;###autoload |
| 58 (defun rmail-read-label (prompt) | 62 (defun rmail-read-label (prompt) |
| 63 "Read a label with completion, prompting with PROMPT. | |
| 64 Completions are chosen from `rmail-label-obarray'. The default | |
| 65 is `rmail-last-label', if that is non-nil. Updates `rmail-last-label' | |
| 66 according to the choice made, and returns a symbol." | |
| 59 (let ((result | 67 (let ((result |
| 60 (completing-read (concat prompt | 68 (completing-read (concat prompt |
| 61 (if rmail-last-label | 69 (if rmail-last-label |
| 62 (concat " (default " | 70 (concat " (default " |
| 63 (symbol-name rmail-last-label) | 71 (symbol-name rmail-last-label) |
| 71 (setq rmail-last-label (rmail-make-label result))))) | 79 (setq rmail-last-label (rmail-make-label result))))) |
| 72 | 80 |
| 73 (declare-function rmail-summary-update-line "rmailsum" (n)) | 81 (declare-function rmail-summary-update-line "rmailsum" (n)) |
| 74 | 82 |
| 75 (defun rmail-set-label (label state &optional msg) | 83 (defun rmail-set-label (label state &optional msg) |
| 76 "Set LABEL as present or absent according to STATE in message MSG." | 84 "Set LABEL as present or absent according to STATE in message MSG. |
| 85 LABEL may be a symbol or string." | |
| 86 (or (stringp label) (setq label (symbol-name label))) | |
| 77 (with-current-buffer rmail-buffer | 87 (with-current-buffer rmail-buffer |
| 78 (rmail-maybe-set-message-counters) | 88 (rmail-maybe-set-message-counters) |
| 79 (if (not msg) (setq msg rmail-current-message)) | 89 (if (not msg) (setq msg rmail-current-message)) |
| 80 ;; Force recalculation of summary for this message. | 90 ;; Force recalculation of summary for this message. |
| 81 (aset rmail-summary-vector (1- msg) nil) | 91 (aset rmail-summary-vector (1- msg) nil) |
| 87 (if attr-index | 97 (if attr-index |
| 88 ;; If so, set it as an attribute. | 98 ;; If so, set it as an attribute. |
| 89 (rmail-set-attribute attr-index state msg) | 99 (rmail-set-attribute attr-index state msg) |
| 90 ;; Is this keyword already present in msg's keyword list? | 100 ;; Is this keyword already present in msg's keyword list? |
| 91 (let* ((header (rmail-get-header rmail-keyword-header msg)) | 101 (let* ((header (rmail-get-header rmail-keyword-header msg)) |
| 92 (regexp (concat ", " (regexp-quote (symbol-name label)) ",")) | 102 (regexp (concat ", " (regexp-quote label) ",")) |
| 93 (present (string-match regexp (concat ", " header ",")))) | 103 (present (string-match regexp (concat ", " header ",")))) |
| 94 ;; If current state is not correct, | 104 ;; If current state is not correct, |
| 95 (unless (eq present state) | 105 (unless (eq present state) |
| 96 ;; either add it or delete it. | 106 ;; either add it or delete it. |
| 97 (rmail-set-header | 107 (rmail-set-header |
| 98 rmail-keyword-header msg | 108 rmail-keyword-header msg |
| 99 (if state | 109 (if state |
| 100 ;; Add this keyword at the end. | 110 ;; Add this keyword at the end. |
| 101 (if (and header (not (string= header ""))) | 111 (if (and header (not (string= header ""))) |
| 102 (concat header ", " (symbol-name label)) | 112 (concat header ", " label) |
| 103 (symbol-name label)) | 113 label) |
| 104 ;; Delete this keyword. | 114 ;; Delete this keyword. |
| 105 (let ((before (substring header 0 | 115 (let ((before (substring header 0 |
| 106 (max 0 (- (match-beginning 0) 2)))) | 116 (max 0 (- (match-beginning 0) 2)))) |
| 107 (after (substring header | 117 (after (substring header |
| 108 (min (length header) | 118 (min (length header) |
| 109 (- (match-end 0) 1))))) | 119 (- (match-end 0) 1))))) |
| 110 (cond ((string= before "") | 120 (cond ((string= before "") |
| 111 after) | 121 after) |
| 112 ((string= after "") | 122 ((string= after "") |
| 113 before) | 123 before) |
| 114 (t (concat before ", " after)))))) | 124 (t (concat before ", " after)))))))))) |
| 115 (if (rmail-summary-exists) | 125 (if (rmail-summary-exists) |
| 116 (rmail-select-summary | 126 (rmail-select-summary |
| 117 (rmail-summary-update-line msg)))))) | 127 (rmail-summary-update-line msg))) |
| 118 (if (= msg rmail-current-message) | 128 (if (= msg rmail-current-message) |
| 119 (rmail-display-labels))))) | 129 (rmail-display-labels)))) |
| 120 | 130 |
| 121 ;; Motion on messages with keywords. | 131 ;; Motion on messages with keywords. |
| 122 | 132 |
| 123 ;;;###autoload | 133 ;;;###autoload |
| 124 (defun rmail-previous-labeled-message (n labels) | 134 (defun rmail-previous-labeled-message (n labels) |