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