1 ;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
3 ;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009 Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 ;; Global to all RMAIL buffers. It exists primarily for the sake of
31 ;; completion. It is better to use strings with the label functions
32 ;; and let them worry about making the label.
34 (defvar rmail-label-obarray
(make-vector 47 0))
36 (mapc (function (lambda (s) (intern s rmail-label-obarray
)))
37 '("deleted" "answered" "filed" "forwarded" "unseen" "edited"
40 (defun rmail-make-label (s)
41 (intern (downcase s
) rmail-label-obarray
))
44 (defun rmail-add-label (string)
45 "Add LABEL to labels associated with current RMAIL message.
46 Performs completion over known labels when reading."
47 (interactive (list (rmail-read-label "Add label")))
48 (rmail-set-label string t
))
51 (defun rmail-kill-label (string)
52 "Remove LABEL from labels associated with current RMAIL message.
53 Performs completion over known labels when reading."
54 (interactive (list (rmail-read-label "Remove label")))
55 (rmail-set-label string nil
))
58 (defun rmail-read-label (prompt)
60 (completing-read (concat prompt
63 (symbol-name rmail-last-label
)
69 (if (string= result
"")
71 (setq rmail-last-label
(rmail-make-label result
)))))
73 (declare-function rmail-summary-update-line
"rmailsum" (n))
75 (defun rmail-set-label (label state
&optional msg
)
76 "Set LABEL as present or absent according to STATE in message MSG."
77 (with-current-buffer rmail-buffer
78 (rmail-maybe-set-message-counters)
79 (if (not msg
) (setq msg rmail-current-message
))
80 ;; Force recalculation of summary for this message.
81 (aset rmail-summary-vector
(1- msg
) nil
)
83 ;; Is this label an attribute?
84 (dotimes (i (length rmail-attr-array
))
85 (if (string= (cadr (aref rmail-attr-array i
)) label
)
88 ;; If so, set it as an attribute.
89 (rmail-set-attribute attr-index state msg
)
90 ;; Is this keyword already present in msg's keyword list?
91 (let* ((header (rmail-get-header rmail-keyword-header msg
))
92 (regexp (concat ", " (regexp-quote (symbol-name label
)) ","))
93 (present (string-match regexp
(concat ", " header
","))))
94 ;; If current state is not correct,
95 (unless (eq present state
)
96 ;; either add it or delete it.
98 rmail-keyword-header msg
100 ;; Add this keyword at the end.
101 (if (and header
(not (string= header
"")))
102 (concat header
", " (symbol-name label
))
104 ;; Delete this keyword.
105 (let ((before (substring header
0
106 (max 0 (- (match-beginning 0) 2))))
107 (after (substring header
109 (- (match-end 0) 1)))))
110 (cond ((string= before
"")
114 (t (concat before
", " after
))))))
115 (if (rmail-summary-exists)
116 (rmail-select-summary
117 (rmail-summary-update-line msg
))))))
118 (if (= msg rmail-current-message
)
119 (rmail-display-labels)))))
121 ;; Motion on messages with keywords.
124 (defun rmail-previous-labeled-message (n labels
)
125 "Show previous message with one of the labels LABELS.
126 LABELS should be a comma-separated list of label names.
127 If LABELS is empty, the last set of labels specified is used.
128 With prefix argument N moves backward N messages with these labels."
129 (interactive "p\nsMove to previous msg with labels: ")
130 (rmail-next-labeled-message (- n
) labels
))
132 (declare-function mail-comma-list-regexp
"mail-utils" (labels))
135 (defun rmail-next-labeled-message (n labels
)
136 "Show next message with one of the labels LABELS.
137 LABELS should be a comma-separated list of label names.
138 If LABELS is empty, the last set of labels specified is used.
139 With prefix argument N moves forward N messages with these labels."
140 (interactive "p\nsMove to next msg with labels: ")
141 (if (string= labels
"")
142 (setq labels rmail-last-multi-labels
))
144 (error "No labels to find have been specified previously"))
145 (set-buffer rmail-buffer
)
146 (setq rmail-last-multi-labels labels
)
147 (rmail-maybe-set-message-counters)
148 (let ((lastwin rmail-current-message
)
149 (current rmail-current-message
)
150 (regexp (concat " \\("
151 (mail-comma-list-regexp labels
)
152 "\\)\\(,\\|\\'\\)")))
153 (while (and (> n
0) (< current rmail-total-messages
))
154 (setq current
(1+ current
))
155 (if (string-match regexp
(rmail-get-labels current
))
156 (setq lastwin current n
(1- n
))))
157 (while (and (< n
0) (> current
1))
158 (setq current
(1- current
))
159 (if (string-match regexp
(rmail-get-labels current
))
160 (setq lastwin current n
(1+ n
))))
162 (error "No previous message with labels %s" labels
)
164 (error "No following message with labels %s" labels
)
165 (rmail-show-message lastwin
)))))
169 ;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7
170 ;;; rmailkwd.el ends here