lisp/mail/pmaildesc.el

   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
  33 ;; External function declarations
  34 (declare-function pmail-narrow-to-header "pmail" (msg))
  35
  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
 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."
 373   (let ((flag (pmail-desc-attr-p attr-index n)))
 374     (if (or (and flag (not sense)) (and (not flag) sense))
 375         n
 376       nil)))
 377
 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
 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.
 422   (setq pmail-desc-delete-callback callback)
 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
 455 ;; arch-tag: 9f70b890-ad54-414e-abb2-0845e3e4eb1a
 456 ;;; pmaildesc.el ends here