Commit | Line | Data |
---|---|---|
e131541f PR |
1 | ;;; pmaildesc.el --- Low level message descriptor library for Pmail. |
2 | ||
8c1ded96 GM |
3 | ;; Copyright (C) 2002, 2003, 2004, 2006, 2006, 2007, 2008 |
4 | ;; 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 package provides low level functions for tracking messages in Pmail. | |
27 | ||
28 | ;;; Code: | |
29 | ||
30 | (require 'pmailhdr) | |
31 | ||
acdc2006 PR |
32 | ;; External function declarations |
33 | (declare-function pmail-narrow-to-header "pmail" (msg)) | |
34 | ||
e131541f PR |
35 | (defvar pmail-desc-attributes nil |
36 | "A private variable providing temporary access to message attributes.") | |
37 | ||
38 | (defvar pmail-desc-delete-callback nil | |
39 | "A function pointer called after a message has been deleted. | |
40 | It expects one argument --- the message number.") | |
41 | ||
42 | (defvar pmail-desc-vector nil | |
43 | "A vector of message descriptors. | |
44 | A message descriptor contains data formatted as follows: | |
45 | ||
46 | (START ATTRIBUTES KEYWORDS DATE LINE-COUNT SENDER SUBJECT) | |
47 | ||
48 | where | |
49 | ||
50 | START is a marker at the beginning of the header | |
51 | ||
52 | ATTRIBUTES is a string where each character encodes an | |
53 | attribute. A hyphen (-) indicates that the attribute is not | |
54 | set: | |
55 | ||
56 | ANSWERED The message has been replied to (A). | |
57 | DELETED The message has been marked for deletion (D). | |
58 | EDITED The message has been edited (E). | |
59 | FILED The message has been filed (F). | |
60 | RESENT The message has been resent (R). | |
61 | STORED The message has been saved to a file (S). | |
62 | UNSEEN The message has not been read (-). | |
63 | ||
64 | KEYWORDS is a list of User defined label strings. | |
65 | ||
66 | DATE is a list of strings describing the message date: | |
67 | ||
68 | DAY-OF-WEEK Mon, Sun, etc. | |
69 | DAY-NUMBER 9, 13, 15, etc. | |
70 | MONTH Feb, Jun, etc. | |
71 | YEAR 2001, 2002, etc. | |
72 | TIME 12:03:25, etc. | |
73 | ||
74 | LINE-COUNT is the number of lines in the message. | |
75 | ||
76 | SENDER is the name of the User sending the message. | |
77 | ||
78 | SUBJECT is the subject header, cached to support fast summary line generation. | |
79 | ") | |
80 | (put 'pmail-desc-vector 'permanent-local t) | |
81 | ||
82 | ;;;; Constants supporting message vector processing. | |
83 | ||
84 | (defconst pmail-desc-default-attrs "------U" | |
85 | "The default attributes for a new message.") | |
86 | ||
87 | ;;; Message component indexes. | |
88 | ||
89 | (defconst pmail-desc-beg-index 0 | |
90 | "The message descriptor element index for the start of the message text.") | |
91 | ||
92 | (defconst pmail-desc-attrs-index 1 | |
93 | "The message descriptor element index for the attributes string.") | |
94 | ||
95 | (defconst pmail-desc-keywords-index 2 | |
96 | "The message descriptor element index for the User defined labels.") | |
97 | ||
98 | (defconst pmail-desc-date-index 3 | |
99 | "The message descriptor element index for the message date information.") | |
100 | ||
101 | (defconst pmail-desc-line-count-index 4 | |
102 | "The message descriptor element index for the message line count.") | |
103 | ||
104 | (defconst pmail-desc-sender-index 5 | |
105 | "The message descriptor element index for the message line count.") | |
106 | ||
107 | (defconst pmail-desc-subject-index 6 | |
108 | "The message descriptor element index for the message line count.") | |
109 | ||
110 | ;;; Attribute indexes | |
111 | ||
112 | (defconst pmail-desc-answered-index 0 | |
113 | "The index for the `answered' attribute.") | |
114 | ||
115 | (defconst pmail-desc-deleted-index 1 | |
116 | "The index for the `deleted' attribute.") | |
117 | ||
118 | (defconst pmail-desc-edited-index 2 | |
119 | "The index for the `edited' attribute.") | |
120 | ||
121 | (defconst pmail-desc-filed-index 3 | |
122 | "The index for the `filed' attribute.") | |
123 | ||
124 | (defconst pmail-desc-resent-index 4 | |
125 | "The index for the `resent' attribute.") | |
126 | ||
127 | (defconst pmail-desc-stored-index 5 | |
128 | "The index for the `stored' attribute.") | |
129 | ||
130 | (defconst pmail-desc-unseen-index 6 | |
131 | "The index for the `unseen' attribute.") | |
132 | ||
133 | (defconst pmail-desc-attr-code-index 0 | |
134 | "The index for the attibute code.") | |
135 | ||
136 | (defconst pmail-desc-attr-keyword-index 1 | |
137 | "The index for the attribute keyword.") | |
138 | ||
139 | (defconst pmail-desc-attr-summary-offset-index 2 | |
140 | "The index for the attribute offset in a summary buffer.") | |
141 | ||
142 | (defconst pmail-desc-attr-alist | |
143 | (list (cons pmail-desc-answered-index (list ?A "answered" 1)) | |
144 | (cons pmail-desc-deleted-index (list ?D "deleted" 0)) | |
145 | (cons pmail-desc-edited-index (list ?E "edited" 3)) | |
146 | (cons pmail-desc-filed-index (list ?F "filed" 2)) | |
147 | (cons pmail-desc-resent-index (list ?R "resent" nil)) | |
148 | (cons pmail-desc-stored-index (list ?S "stored" 4)) | |
149 | (cons pmail-desc-unseen-index (list ? "unseen" 0))) | |
150 | "An alist mapping an attribute to a keycode, keyword and summary offset.") | |
151 | ||
152 | (defconst pmail-desc-attr-index-map | |
153 | (list (cons "answered" pmail-desc-answered-index) | |
154 | (cons "deleted" pmail-desc-deleted-index) | |
155 | (cons "edited" pmail-desc-edited-index) | |
156 | (cons "filed" pmail-desc-filed-index) | |
157 | (cons "resent" pmail-desc-resent-index) | |
158 | (cons "stored" pmail-desc-stored-index) | |
159 | (cons "unseen" pmail-desc-unseen-index))) | |
160 | ||
161 | ;;; Date indexes | |
162 | ||
163 | (defconst pmail-desc-date-day-of-week-index 0 | |
164 | "The DAY-OF-WEEK index into the list of date information.") | |
165 | ||
166 | (defconst pmail-desc-date-day-number-index 1 | |
167 | "The DAY-NUMBER index into the list of date information.") | |
168 | ||
169 | (defconst pmail-desc-date-month-index 2 | |
170 | "The MONTH index into the list of date information.") | |
171 | ||
172 | (defconst pmail-desc-date-year-index 3 | |
173 | "The YEAR index into the list of date information.") | |
174 | ||
175 | (defconst pmail-desc-date-time-index 4 | |
176 | "The TIME index into the list of date information.") | |
177 | ||
178 | (defsubst pmail-desc-get-descriptor (n) | |
179 | "Return a descriptor for message N. | |
180 | N is 1 based, i.e. the first message number is 1." | |
181 | (aref pmail-desc-vector (1- n))) | |
182 | ||
183 | (defsubst pmail-desc-get-start (n) | |
184 | "Return the position of the start of message N." | |
185 | (marker-position | |
186 | (nth pmail-desc-beg-index (pmail-desc-get-descriptor n)))) | |
187 | ||
188 | (defun pmail-desc-get-end (n) | |
189 | "Return the position of the end of message N." | |
190 | (if (= n (length pmail-desc-vector)) | |
191 | (save-restriction | |
192 | (widen) | |
193 | (point-max)) | |
194 | (pmail-desc-get-start (1+ n)))) | |
195 | ||
196 | (defun pmail-desc-add-descriptors (descriptor-list) | |
197 | "Append DESCRIPTOR-LIST to the Pmail message descriptor vector." | |
198 | (setq pmail-desc-vector | |
199 | (vconcat pmail-desc-vector descriptor-list))) | |
200 | ||
201 | (defun pmail-desc-add-keyword (keyword n) | |
202 | "Add KEYWORD to the list of keywords for message N. | |
203 | The current buffer must be narrowed to message N. Both | |
204 | `pmail-desc-vector' and the message headers are updated." | |
205 | (save-excursion | |
206 | (save-restriction | |
207 | (let ((keywords (pmail-desc-get-keywords n)) | |
208 | (display-state (pmail-desc-get-header-display-state n))) | |
209 | (unless (member keyword keywords) | |
210 | (setq keywords (cons keyword keywords)) | |
211 | (setcar (nthcdr pmail-desc-keywords-index (pmail-desc-get-descriptor n)) | |
212 | keywords) | |
213 | (pmail-header-show-headers) | |
214 | (pmail-header-add-header pmail-header-keyword-header | |
215 | (mapconcat 'identity keywords ",")) | |
216 | (pmail-header-toggle-visibility display-state)))))) | |
217 | ||
218 | (defun pmail-desc-remove-keyword (keyword n) | |
219 | "Remove KEYWORD from the list of keywords for message N. | |
220 | The current buffer must be narrowed to message N. Both | |
221 | `pmail-desc-vector' and the message headers are updated." | |
222 | (save-excursion | |
223 | (save-restriction | |
224 | (let ((keywords (pmail-desc-get-keywords n)) | |
225 | (display-state (pmail-desc-get-header-display-state n))) | |
226 | (when (member keyword keywords) | |
227 | (setq keywords (delete keyword keywords)) | |
228 | (setcar (nthcdr pmail-desc-keywords-index (pmail-desc-get-descriptor n)) | |
229 | keywords) | |
230 | (pmail-header-show-headers) | |
231 | (pmail-header-add-header pmail-header-keyword-header | |
232 | (mapconcat 'identity keywords ",")) | |
233 | (pmail-header-toggle-visibility display-state)))))) | |
234 | ||
235 | (defun pmail-desc-attr-p (attr-index n) | |
236 | "Return the state of the the attribute denoted by ATTR-INDEX in | |
237 | message N." | |
238 | (let ((attrs (nth pmail-desc-attrs-index | |
239 | (pmail-desc-get-descriptor n)))) | |
240 | (not (equal "-" (substring attrs attr-index (1+ attr-index)))))) | |
241 | ||
242 | (defun pmail-desc-clear-descriptors () | |
243 | "Clear the Pmail message vector of all messages." | |
244 | (setq pmail-desc-vector nil)) | |
245 | ||
246 | (defun pmail-desc-deleted-p (n) | |
247 | "Return non-nil if message N is marked for deletion." | |
248 | (pmail-desc-attr-p pmail-desc-deleted-index n)) | |
249 | (defalias 'pmail-message-deleted-p 'pmail-desc-deleted-p) | |
250 | ||
251 | (defun pmail-desc-delete-maybe (n) | |
252 | "Determine if message N is marked for deletion. If so then delete it. | |
253 | Return t if the message is deleted, nil if not." | |
254 | (if (pmail-desc-deleted-p n) | |
255 | (progn | |
256 | (pmail-desc-delete n) | |
257 | t))) | |
258 | ||
259 | (defun pmail-desc-delete (n) | |
260 | "Remove message N from the Pmail buffer and from the descriptor vector." | |
261 | (save-excursion | |
262 | (save-restriction | |
263 | ;; Enable the buffer to be written, ignore intangibility and do | |
264 | ;; not record these changes in the undo list. | |
265 | (let ((inhibit-read-only t) | |
266 | (inhibit-point-motion-hooks t) | |
267 | (buffer-undo-list t) | |
268 | start end) | |
269 | (widen) | |
270 | ||
271 | ;; Remove the message from the buffer and neutralize the | |
272 | ;; marker pointing to the start of the message. | |
273 | (delete-region (pmail-desc-get-start n) (pmail-desc-get-end n)) | |
274 | (move-marker (nth pmail-desc-beg-index (pmail-desc-get-descriptor n)) nil) | |
275 | ||
276 | ;; Remove the message descriptor from the Pmail message vector | |
277 | ;; and execute the callback indicating the message has been | |
278 | ;; deleted. | |
279 | (aset pmail-desc-vector (1- n) t) | |
280 | (funcall pmail-desc-delete-callback n))))) | |
281 | ||
282 | (defun pmail-desc-get-attr-code (attr-index n) | |
283 | "Return the attribute code for ATTR-INDEX in message N. | |
284 | If the attribute is not set, return nil." | |
285 | (if (pmail-desc-attr-p attr-index n) | |
286 | (string (nth pmail-desc-attr-code-index | |
287 | (cdr (assoc attr-index pmail-desc-attr-alist)))))) | |
288 | ||
289 | (defun pmail-desc-get-attr-index (attr) | |
290 | "Return the attribute index associated with attribute ATTR, a string." | |
291 | (cdr (assoc attr pmail-desc-attr-index-map))) | |
292 | ||
293 | (defun pmail-desc-get-attributes (n) | |
294 | "Return the attribute vector for message N." | |
295 | (nth pmail-desc-attrs-index (pmail-desc-get-descriptor n))) | |
296 | ||
297 | (defsubst pmail-desc-get-count () | |
298 | "Return the number of messages described in the Pmail descriptor vector." | |
299 | (length pmail-desc-vector)) | |
300 | ||
301 | (defun pmail-desc-get-date (n) | |
302 | "Return the date list generated when the messages were read in." | |
303 | (nth pmail-desc-date-index (pmail-desc-get-descriptor n))) | |
304 | ||
305 | (defun pmail-desc-get-day-number (n) | |
306 | "Return the day number (1..31) from the date associated with message N." | |
307 | (nth pmail-desc-date-day-number-index | |
308 | (nth pmail-desc-date-index (pmail-desc-get-descriptor n)))) | |
309 | ||
310 | (defun pmail-desc-get-day-of-week (n) | |
311 | "Return the day of week (Sun .. Sat) from the date associated with message N." | |
312 | (nth pmail-desc-date-day-of-week-index | |
313 | (nth pmail-desc-date-index (pmail-desc-get-descriptor n)))) | |
314 | ||
315 | (defun pmail-desc-get-header-display-state (n) | |
316 | "Return t if ignorable headers are being displayed, nil otherwise." | |
317 | (save-excursion | |
318 | (save-restriction | |
319 | (pmail-narrow-to-header n) | |
320 | (null (overlays-in (point-min) (point-max)))))) | |
321 | ||
322 | (defun pmail-desc-get-keyword (attr-index) | |
323 | "Return the keyword string associated with ATTR-INDEX." | |
324 | (nth pmail-desc-attr-keyword-index | |
325 | (cdr (assoc attr-index pmail-desc-attr-alist)))) | |
326 | ||
327 | (defun pmail-desc-get-keyword-list (n) | |
328 | "Return the list of user-defined labels for message N." | |
329 | (nth pmail-desc-keywords-index (pmail-desc-get-descriptor n))) | |
330 | ||
331 | (defun pmail-desc-get-keyword-maybe (attribute) | |
332 | "Return the keyword associated with ATTRIBUTE if it is set, nil otherwise. | |
333 | ATTRIBUTE is a cons cell associating an attribute index with a keyword string." | |
334 | (let ((index (car attribute))) | |
335 | (if (not (equal "-" (substring pmail-desc-attributes index (1+ index)))) | |
336 | (nth pmail-desc-attr-keyword-index (cdr attribute))))) | |
337 | ||
338 | (defun pmail-desc-get-keywords (n) | |
339 | "Return a list of keywords for message N. | |
340 | This includes the attributes." | |
341 | (setq pmail-desc-attributes (pmail-desc-get-attributes n)) | |
342 | (append (delq nil (mapcar | |
343 | 'pmail-desc-get-keyword-maybe | |
344 | pmail-desc-attr-alist)) | |
345 | (pmail-desc-get-keyword-list n))) | |
346 | ||
347 | (defun pmail-desc-get-line-count (n) | |
348 | "Return the message body line count." | |
349 | (nth pmail-desc-line-count-index (pmail-desc-get-descriptor n))) | |
350 | ||
351 | (defun pmail-desc-get-month (n) | |
352 | "Return the month (Jan .. Dec) from the date associated with message N." | |
353 | (nth pmail-desc-date-month-index | |
354 | (nth pmail-desc-date-index (pmail-desc-get-descriptor n)))) | |
355 | ||
e87ae05b | 356 | (defun pmail-desc-get-previous (n attr-index &optional sense) |
73ead349 | 357 | "Return the message index for the previous matching descriptor. |
e87ae05b PR |
358 | Starting with descriptor at index N locate the first previous |
359 | descriptor such that the attribute ATTR is set. SENSE, if | |
360 | non-null will reverse the sense of the attribute test." | |
361 | (let ((index (1- n)) flag result) | |
362 | (while (and (> index 0) (not result)) | |
73ead349 PR |
363 | (if (listp (aref pmail-desc-vector (1- index))) |
364 | (setq result (pmail-desc-get-match-index index attr-index sense))) | |
e87ae05b PR |
365 | (setq index (1- index))) |
366 | (or result 0))) | |
367 | ||
73ead349 | 368 | (defun pmail-desc-get-match-index (n attr-index sense) |
e87ae05b PR |
369 | "Return the index N if the associated descriptor has a matching |
370 | attribute, nil otherwise. The attribute value must be set if | |
371 | SENSE is nil, or unset if SENSE is non-nil." | |
2e2da3d5 | 372 | (let ((flag (pmail-desc-attr-p attr-index n))) |
e87ae05b PR |
373 | (if (or (and flag (not sense)) (and (not flag) sense)) |
374 | n | |
375 | nil))) | |
376 | ||
e131541f PR |
377 | (defun pmail-desc-get-sender (n) |
378 | "Return the User registered as the mail sender." | |
379 | (nth pmail-desc-sender-index (pmail-desc-get-descriptor n))) | |
380 | ||
381 | (defun pmail-desc-get-subject (n) | |
382 | "Return the cached subject header." | |
383 | (nth pmail-desc-subject-index (pmail-desc-get-descriptor n))) | |
384 | ||
385 | (defun pmail-desc-get-summary-offset (attr-index) | |
386 | "Return the summary buffer offset associated with ATTR-INDEX. | |
387 | This is the relative position where the attribute code letter is | |
388 | displayed in the Pmail summary buffer." | |
389 | (nth pmail-desc-attr-summary-offset-index | |
390 | (cdr (assoc attr-index pmail-desc-attr-alist)))) | |
391 | ||
392 | (defun pmail-desc-get-time (n) | |
393 | "Return the time (hh:mm:ss) from the date associated with message N." | |
394 | (nth pmail-desc-date-time-index | |
395 | (nth pmail-desc-date-index (pmail-desc-get-descriptor n)))) | |
396 | ||
397 | (defun pmail-desc-get-year (n) | |
398 | "Return the year (1969 ... 2###) from the date associated with message N." | |
399 | (nth pmail-desc-date-year-index | |
400 | (nth pmail-desc-date-index (pmail-desc-get-descriptor n)))) | |
401 | ||
402 | ;; This is a strange thing to use. | |
403 | ;; Why not write a simple loop instead? | |
404 | (defun pmail-desc-make-index-list () | |
405 | "Return a list of integers from 1 to the total number of messages." | |
406 | (let ((result (make-vector (length pmail-desc-vector) nil)) | |
407 | (index 0)) | |
408 | (while (< index (length result)) | |
409 | (aset result index (1+ index)) | |
410 | (setq index (1+ index))) | |
411 | (append result nil))) | |
412 | ||
413 | (defun pmail-desc-prune-deleted-messages (callback) | |
414 | "Remove all messages marked for marked for deletion. | |
415 | Return the number of messages removed. Invoke CALLBACK immediately | |
416 | after a message has been deleted.." | |
417 | ||
e87ae05b PR |
418 | ;; Set the callback and remove all messages marked for deletion from |
419 | ;; the Pmail buffer and their descriptors from the Pmail message | |
420 | ;; vector. | |
e131541f | 421 | (setq pmail-desc-delete-callback callback) |
e131541f PR |
422 | (let ((result (length (delq t (mapcar 'pmail-desc-delete-maybe |
423 | (pmail-desc-make-index-list)))))) | |
424 | (setq pmail-desc-vector | |
425 | (vconcat (delq t (append pmail-desc-vector nil)))) | |
426 | result)) | |
427 | ||
73ead349 | 428 | (defun pmail-desc-set-attribute (n attr-index state) |
e131541f PR |
429 | "Set the attribute denoted by ATTR-INDEX in message N according to STATE. |
430 | If STATE is non-nil the attribute will be set to the single character code | |
431 | associated with ATTR-INDEX in pmail-desc-attr-alist, otherwise the attribute is | |
432 | set to the hyphen character (-)." | |
433 | (let ((attributes (nth pmail-desc-attrs-index (pmail-desc-get-descriptor n))) | |
434 | code) | |
435 | (setq code (if state | |
436 | (car (cdr (assoc attr-index pmail-desc-attr-alist))) | |
437 | ?-)) | |
438 | (aset attributes attr-index code) | |
439 | (pmail-header-add-header pmail-header-attribute-header attributes))) | |
440 | ||
441 | (defun pmail-desc-set-start (n pos) | |
442 | "Set the start position for message N to POS." | |
443 | (set-marker (nth pmail-desc-beg-index (pmail-desc-get-descriptor n)) pos)) | |
444 | ||
445 | (defun pmail-desc-showing-message-p (n) | |
446 | "Return t if the current buffer is displaying message N, nil otherwise." | |
447 | (let ((beg (pmail-desc-get-start n)) | |
448 | (end (pmail-desc-get-end n)) | |
449 | (curpos (point))) | |
450 | (and (>= curpos beg) (< curpos end)))) | |
451 | ||
452 | (provide 'pmaildesc) | |
453 | ||
51a5d095 GM |
454 | ;; Local Variables: |
455 | ;; change-log-default-name: "ChangeLog.pmail" | |
456 | ;; End: | |
457 | ||
61520927 | 458 | ;; arch-tag: 9f70b890-ad54-414e-abb2-0845e3e4eb1a |
e131541f | 459 | ;;; pmaildesc.el ends here |