Commit | Line | Data |
---|---|---|
e131541f PR |
1 | ;;; pmailkwd.el --- part of the "PMAIL" mail reader for Emacs |
2 | ||
8c1ded96 GM |
3 | ;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, |
4 | ;; 2007, 2008 Free Software Foundation, Inc. | |
e131541f PR |
5 | |
6 | ;; Maintainer: FSF | |
7 | ;; Keywords: mail | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
8c1ded96 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
e131541f | 12 | ;; it under the terms of the GNU General Public License as published by |
8c1ded96 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
e131541f PR |
15 | |
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. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
8c1ded96 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
e131541f PR |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; This library manages keywords (labels). Labels are stored in the | |
27 | ;; variable `pmail-keywords'. | |
28 | ||
29 | ;;; Code: | |
30 | ||
31 | (defvar pmail-buffer) | |
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) | |
37 | ||
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. | |
41 | ||
e131541f PR |
42 | (eval-when-compile |
43 | (require 'mail-utils)) | |
44 | ||
45 | ;; Named list of symbols representing valid message attributes in PMAIL. | |
46 | ||
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.") | |
51 | ||
52 | (defconst pmail-deleted-label 'deleted) | |
53 | ||
54 | ;; Named list of symbols representing valid message keywords in PMAIL. | |
55 | ||
56 | (defvar pmail-keywords nil | |
57 | "Keywords used to label messages. | |
58 | These are all user-defined, unlike `pmail-attributes'.") | |
59 | \f | |
acdc2006 PR |
60 | |
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" ()) | |
acdc2006 PR |
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)) | |
acdc2006 PR |
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)) | |
76 | ||
e131541f PR |
77 | ;;;; Low-level functions. |
78 | ||
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))) | |
84 | ||
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))) | |
90 | ||
91 | (defun pmail-make-label (s &optional forcep) | |
92 | (cond ((symbolp s) s) | |
93 | (forcep (intern (downcase s))) | |
94 | (t (intern-soft (downcase s))))) | |
95 | ||
96 | (defun pmail-quote-label-name (label) | |
97 | (regexp-quote (symbol-name (pmail-make-label label t)))) | |
98 | ||
99 | ;;;###autoload | |
100 | (defun pmail-register-keywords (words) | |
101 | "Add the strings in WORDS to `pmail-keywords'." | |
102 | (dolist (word words) | |
103 | (pmail-register-keyword word))) | |
104 | ||
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))))) | |
112 | \f | |
113 | ;;;; Adding and removing message keywords. | |
114 | ||
115 | ;;;###autoload | |
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)) | |
121 | ||
122 | ;;;###autoload | |
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)) | |
127 | ||
128 | ;;;###autoload | |
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 | |
132 | message." | |
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) | |
141 | last | |
142 | (car keywords)))) | |
143 | (unless keywords | |
144 | (error "No labels for the current message")) | |
145 | (completing-read | |
146 | (concat prompt " (default " default "): ") | |
147 | keywords nil t nil nil default)) | |
148 | (let ((default (symbol-name pmail-last-label))) | |
149 | (completing-read | |
150 | (concat prompt (if pmail-last-label | |
151 | (concat " (default " default "): ") | |
152 | ": ")) | |
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 | |
157 | result))) | |
158 | ||
e131541f PR |
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)) | |
168 | (save-restriction | |
169 | (widen) | |
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) | |
177 | (if state | |
178 | (pmail-desc-add-keyword str n) | |
179 | (pmail-desc-remove-keyword str n)))))) | |
180 | (pmail-display-labels) | |
181 | ;; Deal with the summary buffer. | |
acdc2006 | 182 | (when (pmail-summary-exists) |
e131541f PR |
183 | (pmail-summary-update n))) |
184 | \f | |
185 | ;; Motion on messages with keywords. | |
186 | ||
187 | ;;;###autoload | |
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)) | |
195 | ||
196 | ;;;###autoload | |
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)) | |
205 | (unless 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) | |
213 | "\\),"))) | |
214 | (save-restriction | |
215 | (widen) | |
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) | |
225 | (when (< n 0) | |
226 | (message "No previous message with labels %s" labels)) | |
227 | (when (> n 0) | |
228 | (message "No following message with labels %s" labels))))) | |
229 | ||
acdc2006 PR |
230 | (provide 'pmailkwd) |
231 | ||
51a5d095 GM |
232 | ;; Local Variables: |
233 | ;; change-log-default-name: "ChangeLog.pmail" | |
234 | ;; End: | |
235 | ||
0faeefbb | 236 | ;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7 |
e131541f | 237 | ;;; pmailkwd.el ends here |