1 ;;; pmailkwd.el --- part of the "PMAIL" mail reader for Emacs
3 ;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008 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/>.
26 ;; This library manages keywords (labels). Labels are stored in the
27 ;; variable `pmail-keywords'.
32 (defvar pmail-current-message
)
33 (defvar pmail-last-label
)
34 (defvar pmail-last-multi-labels
)
35 (defvar pmail-summary-vector
)
36 (defvar pmail-total-messages
)
38 ;; Global to all PMAIL buffers. It exists primarily for the sake of
39 ;; completion. It is better to use strings with the label functions
40 ;; and let them worry about making the label.
43 (require 'mail-utils
))
45 ;; Named list of symbols representing valid message attributes in PMAIL.
47 (defconst pmail-attributes
48 '(deleted answered filed forwarded unseen edited resent
)
49 "Keywords with defined semantics used to label messages.
50 These have a well-defined meaning to the PMAIL system.")
52 (defconst pmail-deleted-label
'deleted
)
54 ;; Named list of symbols representing valid message keywords in PMAIL.
56 (defvar pmail-keywords nil
57 "Keywords used to label messages.
58 These are all user-defined, unlike `pmail-attributes'.")
61 ;; External library declarations.
62 (declare-function mail-comma-list-regexp
"mail-utils" (labels))
63 (declare-function mail-parse-comma-list
"mail-utils" ())
64 (declare-function pmail-desc-add-keyword
"pmaildesc" (keyword n
))
65 (declare-function pmail-desc-get-end
"pmaildesc" (n))
66 (declare-function pmail-desc-get-keywords
"pmaildesc" (n))
67 (declare-function pmail-desc-get-start
"pmaildesc" (n))
68 (declare-function pmail-desc-remove-keyword
"pmaildesc" (keyword n
))
69 (declare-function pmail-display-labels
"pmail" ())
70 (declare-function pmail-message-labels-p
"pmail" (msg labels
))
71 (declare-function pmail-msgbeg
"pmail" (n))
72 (declare-function pmail-set-attribute
"pmail" (attr state
&optional msgnum
))
73 (declare-function pmail-show-message
"pmail" (&optional n no-summary
))
74 (declare-function pmail-summary-exists
"pmail" ())
75 (declare-function pmail-summary-update
"pmailsum" (n))
77 ;;;; Low-level functions.
79 (defun pmail-attribute-p (s)
80 "Non-nil if S is a known attribute.
81 See `pmail-attributes'."
82 (let ((symbol (pmail-make-label s
)))
83 (memq symbol pmail-attributes
)))
85 (defun pmail-keyword-p (s)
86 "Non-nil if S is a known keyword for this Pmail file.
87 See `pmail-keywords'."
88 (let ((symbol (pmail-make-label s
)))
89 (memq symbol pmail-keywords
)))
91 (defun pmail-make-label (s &optional forcep
)
93 (forcep (intern (downcase s
)))
94 (t (intern-soft (downcase s
)))))
96 (defun pmail-quote-label-name (label)
97 (regexp-quote (symbol-name (pmail-make-label label t
))))
100 (defun pmail-register-keywords (words)
101 "Add the strings in WORDS to `pmail-keywords'."
103 (pmail-register-keyword word
)))
105 (defun pmail-register-keyword (word)
106 "Append the string WORD to `pmail-keywords',
107 unless it already is a keyword or an attribute."
108 (let ((keyword (pmail-make-label word t
)))
109 (unless (or (pmail-attribute-p keyword
)
110 (pmail-keyword-p keyword
))
111 (setq pmail-keywords
(cons keyword pmail-keywords
)))))
113 ;;;; Adding and removing message keywords.
116 (defun pmail-add-label (string)
117 "Add LABEL to labels associated with current PMAIL message."
118 (interactive (list (pmail-read-label "Add label")))
119 (pmail-set-label (pmail-make-label string
) t
)
120 (pmail-display-labels))
123 (defun pmail-kill-label (string)
124 "Remove LABEL from labels associated with current PMAIL message."
125 (interactive (list (pmail-read-label "Remove label" t
)))
126 (pmail-set-label (pmail-make-label string
) nil
))
129 (defun pmail-read-label (prompt &optional existing
)
130 "Ask for a label using PROMPT.
131 If EXISTING is non-nil, ask for one of the labels of the current
133 (when (= pmail-total-messages
0)
134 (error "No messages in this file"))
135 (with-current-buffer pmail-buffer
136 (let ((result (if existing
137 (let* ((keywords (pmail-desc-get-keywords
138 pmail-current-message
))
139 (last (symbol-name pmail-last-label
))
140 (default (if (member last keywords
)
144 (error "No labels for the current message"))
146 (concat prompt
" (default " default
"): ")
147 keywords nil t nil nil default
))
148 (let ((default (symbol-name pmail-last-label
)))
150 (concat prompt
(if pmail-last-label
151 (concat " (default " default
"): ")
153 (mapcar 'list pmail-keywords
)
154 nil nil nil nil default
)))))
155 (setq pmail-last-label
(pmail-make-label result t
))
156 ;; return the string, not the symbol
159 (defun pmail-set-label (l state
&optional n
)
160 "Add or remove label L in message N.
161 The label L is added when STATE is non-nil, otherwise it is
162 removed. If N is nil then use the current Pmail message. The
163 current buffer, possibly narrowed, displays a message."
164 (if (= pmail-total-messages
0)
165 (error "No messages in this file"))
166 (with-current-buffer pmail-buffer
167 (if (not n
) (setq n pmail-current-message
))
170 (narrow-to-region (pmail-desc-get-start n
) (pmail-desc-get-end n
))
171 ;; FIXME: we should move all string-using functions to symbols!
172 (let ((str (symbol-name l
)))
173 (if (pmail-attribute-p l
)
174 (pmail-set-attribute str state n
)
175 ;; Make sure the keyword is registered.
176 (pmail-register-keyword l
)
178 (pmail-desc-add-keyword str n
)
179 (pmail-desc-remove-keyword str n
))))))
180 (pmail-display-labels)
181 ;; Deal with the summary buffer.
182 (when (pmail-summary-exists)
183 (pmail-summary-update n
)))
185 ;; Motion on messages with keywords.
188 (defun pmail-previous-labeled-message (n labels
)
189 "Show previous message with one of the labels LABELS.
190 LABELS should be a comma-separated list of label names.
191 If LABELS is empty, the last set of labels specified is used.
192 With prefix argument N moves backward N messages with these labels."
193 (interactive "p\nsMove to previous msg with labels: ")
194 (pmail-next-labeled-message (- n
) labels
))
197 (defun pmail-next-labeled-message (n labels
)
198 "Show next message with one of the labels LABELS.
199 LABELS should be a comma-separated list of label names.
200 If LABELS is empty, the last set of labels specified is used.
201 With prefix argument N moves forward N messages with these labels."
202 (interactive "p\nsMove to next msg with labels: ")
203 (when (string= labels
"")
204 (setq labels pmail-last-multi-labels
))
206 (error "No labels to find have been specified previously"))
207 (with-current-buffer pmail-buffer
208 (setq pmail-last-multi-labels labels
)
209 (let ((lastwin pmail-current-message
)
210 (current pmail-current-message
)
211 (regexp (concat ", ?\\("
212 (mail-comma-list-regexp labels
)
216 (while (and (> n
0) (< current pmail-total-messages
))
217 (setq current
(1+ current
))
218 (when (pmail-message-labels-p current regexp
)
219 (setq lastwin current n
(1- n
))))
220 (while (and (< n
0) (> current
1))
221 (setq current
(1- current
))
222 (when (pmail-message-labels-p current regexp
)
223 (setq lastwin current n
(1+ n
)))))
224 (pmail-show-message lastwin
)
226 (message "No previous message with labels %s" labels
))
228 (message "No following message with labels %s" labels
)))))
233 ;; change-log-default-name: "ChangeLog.pmail"
236 ;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7
237 ;;; pmailkwd.el ends here