lisp/mail/pmaildesc.el

   1 ;;; pmaildesc.el --- Low level message descriptor library for Pmail.
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2006, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Maintainer: FSF
   7 ;; Keywords: mail
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  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
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; This package provides low level functions for tracking messages in Pmail.
  27
  28 ;;; Code:
  29
  30 (require 'pmailhdr)
  31
  32 ;; External function declarations
  33 (declare-function pmail-narrow-to-header "pmail" (msg))
  34
  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
 356 (defun pmail-desc-get-previous (n attr-index &optional sense)
 357   "Return the message index for the previous matching descriptor.
 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))
 363       (if (listp (aref pmail-desc-vector (1- index)))
 364           (setq result (pmail-desc-get-match-index index attr-index sense)))
 365       (setq index (1- index)))
 366     (or result 0)))
 367
 368 (defun pmail-desc-get-match-index (n attr-index sense)
 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."
 372   (let ((flag (pmail-desc-attr-p attr-index n)))
 373     (if (or (and flag (not sense)) (and (not flag) sense))
 374         n
 375       nil)))
 376
 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
 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.
 421   (setq pmail-desc-delete-callback callback)
 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
 428 (defun pmail-desc-set-attribute (n attr-index state)
 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
 454 ;; Local Variables:
 455 ;; change-log-default-name: "ChangeLog.pmail"
 456 ;; End:
 457
 458 ;; arch-tag: 9f70b890-ad54-414e-abb2-0845e3e4eb1a
 459 ;;; pmaildesc.el ends here