--- /dev/null
+;;; rmaildesc.el --- Low level message descriptor library for Rmail.
+
+;; Copyright (C) 2002
+;; Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This package provides low level functions for tracking messages in Rmail.
+
+;;; Code:
+
+;; Written by Paul Reilly as part of moving BABYL to mbox format.
+
+(eval-when-compile
+ (require 'rmailhdr)
+ (require 'mail-utils))
+
+(defvar rmail-desc-attributes nil
+ "A private variable providing temporary access to message attributes.")
+
+(defvar rmail-desc-delete-callback nil
+ "A function pointer called after a message has been deleted.
+It expects one argument --- the message number.")
+
+(defvar rmail-desc-vector nil
+ "A vector of message descriptors.
+A message descriptor contains data formatted as follows:
+
+ (START ATTRIBUTES KEYWORDS DATE LINE-COUNT SENDER SUBJECT)
+
+where
+
+ START is a marker at the beginning of the header
+
+ ATTRIBUTES is a string where each character encodes an
+ attribute. A hyphen (-) indicates that the attribute is not
+ set:
+
+ ANSWERED The message has been replied to (A).
+ DELETED The message has been marked for deletion (D).
+ EDITED The message has been edited (E).
+ FILED The message has been filed (F).
+ RESENT The message has been resent (R).
+ STORED The message has been saved to a file (S).
+ UNSEEN The message has not been read (-).
+
+ KEYWORDS is a list of User defined label strings.
+
+ DATE is a list of strings describing the message date:
+
+ DAY-OF-WEEK Mon, Sun, etc.
+ DAY-NUMBER 9, 13, 15, etc.
+ MONTH Feb, Jun, etc.
+ YEAR 2001, 2002, etc.
+ TIME 12:03:25, etc.
+
+ LINE-COUNT is the number of lines in the message.
+
+ SENDER is the name of the User sending the message.
+
+ SUBJECT is the subject header, cached to support fast summary line generation.
+")
+(put 'rmail-desc-vector 'permanent-local t)
+
+;;;; Constants supporting message vector processing.
+
+;;; Message component indexes.
+
+(defconst rmail-desc-beg-index 0
+ "The message descriptor element index for the start of the message text.")
+
+(defconst rmail-desc-attrs-index 1
+ "The message descriptor element index for the attributes string.")
+
+(defconst rmail-desc-keywords-index 2
+ "The message descriptor element index for the User defined labels.")
+
+(defconst rmail-desc-date-index 3
+ "The message descriptor element index for the message date information.")
+
+(defconst rmail-desc-line-count-index 4
+ "The message descriptor element index for the message line count.")
+
+(defconst rmail-desc-sender-index 5
+ "The message descriptor element index for the message line count.")
+
+(defconst rmail-desc-subject-index 6
+ "The message descriptor element index for the message line count.")
+
+;;; Attribute indexes
+
+(defconst rmail-desc-answered-index 0
+ "The index for the `answered' attribute.")
+
+(defconst rmail-desc-deleted-index 1
+ "The index for the `deleted' attribute.")
+
+(defconst rmail-desc-edited-index 2
+ "The index for the `edited' attirute.")
+
+(defconst rmail-desc-filed-index 3
+ "The index for the `filed' attribute.")
+
+(defconst rmail-desc-resent-index 4
+ "The index for the `resent' attribute.")
+
+(defconst rmail-desc-stored-index 5
+ "The index for the `stored' attribute.")
+
+(defconst rmail-desc-unseen-index 6
+ "The index for the `unseen' attribute.")
+
+(defconst rmail-desc-attr-code-index 0
+ "The index for the attibute code.")
+
+(defconst rmail-desc-attr-keyword-index 1
+ "The index for the attribute keyword.")
+
+(defconst rmail-desc-attr-summary-offset-index 2
+ "The index for the attribute offset in a summary buffer.")
+
+(defconst rmail-desc-attr-alist
+ (list (cons rmail-desc-answered-index (list ?A "answered" 1))
+ (cons rmail-desc-deleted-index (list ?D "deleted" 0))
+ (cons rmail-desc-edited-index (list ?E "edited" 3))
+ (cons rmail-desc-filed-index (list ?F "filed" 2))
+ (cons rmail-desc-resent-index (list ?R "resent" nil))
+ (cons rmail-desc-stored-index (list ?S "stored" 4))
+ (cons rmail-desc-unseen-index (list ? "unseen" 0)))
+ "An alist mapping an attribute to a keycode, keyword and summary offset.")
+
+(defconst rmail-desc-attr-index-map
+ (list (cons "answered" rmail-desc-answered-index)
+ (cons "deleted" rmail-desc-deleted-index)
+ (cons "edited" rmail-desc-edited-index)
+ (cons "filed" rmail-desc-filed-index)
+ (cons "resent" rmail-desc-resent-index)
+ (cons "stored" rmail-desc-stored-index)
+ (cons "unseen" rmail-desc-unseen-index)))
+
+;;; Date indexes
+
+(defconst rmail-desc-date-day-of-week-index 0
+ "The DAY-OF-WEEK index into the list of date information.")
+
+(defconst rmail-desc-date-day-number-index 1
+ "The DAY-NUMBER index into the list of date information.")
+
+(defconst rmail-desc-date-month-index 2
+ "The MONTH index into the list of date information.")
+
+(defconst rmail-desc-date-year-index 3
+ "The YEAR index into the list of date information.")
+
+(defconst rmail-desc-date-time-index 4
+ "The TIME index into the list of date information.")
+
+(defsubst rmail-desc-get-descriptor (n)
+ "Return a descriptor for message N.
+N is 1 based, i.e. the first message number is 1."
+ (aref rmail-desc-vector (1- n)))
+
+(defsubst rmail-desc-get-start (n)
+ "Return the position of the start of message N."
+ (marker-position
+ (nth rmail-desc-beg-index (rmail-desc-get-descriptor n))))
+
+(defun rmail-desc-get-end (n)
+ "Return the position of the end of message N."
+ (if (= n (length rmail-desc-vector))
+ (save-restriction
+ (widen)
+ (point-max))
+ (rmail-desc-get-start (1+ n))))
+
+(defun rmail-desc-add-descriptors (descriptor-list)
+ "Append DESCRIPTOR-LIST to the Rmail message descriptor vector."
+ (setq rmail-desc-vector
+ (vconcat rmail-desc-vector descriptor-list)))
+
+(defun rmail-desc-add-keyword (keyword n)
+ "Add KEYWORD to the list of keywords for message N.
+The current buffer, likely narrowed, contains message N."
+
+ ;; Append KEYWORD to the descriptor for message N.
+ (save-excursion
+ (save-restriction
+ (let ((keyword-list (rmail-desc-get-keyword-list n))
+ (display-state (rmail-desc-get-header-display-state n)))
+ (rmail-header-show-headers)
+ (if keyword-list
+
+ ;; ??? Don't use setcdr for this.
+ ;; Just add it to the front of the list
+ ;; and store the updated list back in its proper place.
+
+ ;; Append the string to the list unless it already is there.
+ (unless (member-ignore-case keyword keyword-list)
+ (setcdr keyword-list (append (cdr keyword-list) (list keyword)))
+
+ ;; Persist the label for this message.
+ (rmail-header-add-header
+ rmail-header-keyword-header
+ (concat (rmail-header-get-header rmail-header-keyword-header)
+ "," keyword)))
+
+ ;; Create the initial keyword list as well as the keyword header
+ ;; and persist the header.
+ (setq keyword-list
+ (nthcdr rmail-desc-keywords-index (rmail-desc-get-descriptor n)))
+ (setcar keyword-list (list keyword))
+ (rmail-header-add-header rmail-header-keyword-header keyword))
+ (rmail-header-toggle-visibility display-state)))))
+
+(defun rmail-desc-remove-keyword (keyword n)
+ "Remove KEYWORD from the list of keywords for message N.
+The current buffer, likely narrowed, contains message N."
+
+ ;; Remove KEYWORD from the descriptor for message N.
+ (save-excursion
+ (save-restriction
+ (let ((desc-list (nthcdr rmail-desc-keywords-index
+ (rmail-desc-get-descriptor n)))
+ (display-state (rmail-desc-get-header-display-state n)))
+
+ ;; Remove the keyword from the descriptor.
+ (setcar desc-list (delete keyword (car desc-list)))
+
+ ;; Persist the change by removing the keyword for the keywords
+ ;; header and restore the display state.
+ (rmail-header-show-headers)
+ (rmail-header-delete-keyword keyword)
+ (rmail-header-toggle-visibility display-state)))))
+
+(defun rmail-desc-attr-p (attr-index n)
+ "Return the state of the the attribute denoted by ATTR-INDEX in
+ message N."
+ (let ((attrs (nth rmail-desc-attrs-index
+ (rmail-desc-get-descriptor n))))
+ (not (equal "-" (substring attrs attr-index (1+ attr-index))))))
+
+(defun rmail-desc-clear-descriptors ()
+ "Clear the Rmail message vector of all messages."
+ (setq rmail-desc-vector nil))
+
+(defun rmail-desc-deleted-p (n)
+ "Return non-nil if message N is marked for deletion."
+ (rmail-desc-attr-p rmail-desc-deleted-index n))
+
+(defun rmail-desc-delete-maybe (n)
+ "Determine if message N is marked for deletion. If so then delete it.
+Return t if the message is deleted, nil if not."
+ (if (rmail-desc-deleted-p n)
+ (progn
+ (rmail-desc-delete n)
+ t)))
+
+(defun rmail-desc-delete (n)
+ "Remove message N from the Rmail buffer and from the descriptor vector."
+ (save-excursion
+ (save-restriction
+ ;; Enable the buffer to be written, ignore intangibility and do
+ ;; not record these changes in the undo list.
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (buffer-undo-list t)
+ start end)
+ (widen)
+
+ ;; Remove the message from the buffer and neutralize the
+ ;; marker pointing to the start of the message.
+ (delete-region (rmail-desc-get-start n) (rmail-desc-get-end n))
+ (move-marker (nth rmail-desc-beg-index (rmail-desc-get-descriptor n)) nil)
+
+ ;; Remove the message descriptor from the Rmail message vector
+ ;; and execute the callback indicating the message has been
+ ;; deleted.
+ (aset rmail-desc-vector (1- n) t)
+ (funcall rmail-desc-delete-callback n)))))
+
+(defun rmail-desc-get-attr-code (attr-index n)
+ "Return the attribute code for ATTR-INDEX in message N.
+If the attribute is not set, return nil."
+ (if (rmail-desc-attr-p attr-index n)
+ (string (nth rmail-desc-attr-code-index
+ (cdr (assoc attr-index rmail-desc-attr-alist))))))
+
+(defun rmail-desc-get-attr-index (attr)
+ "Return the attribute index associated with attribute ATTR, a string."
+ (cdr (assoc attr rmail-desc-attr-index-map)))
+
+(defun rmail-desc-get-attributes (n)
+ "Return the attribute vector for message N."
+ (nth rmail-desc-attrs-index (rmail-desc-get-descriptor n)))
+
+(defsubst rmail-desc-get-count ()
+ "Return the number of messages described in the Rmail descriptor vector."
+ (length rmail-desc-vector))
+
+(defun rmail-desc-get-date (n)
+ "Return the date list generated when the messages were read in."
+ (nth rmail-desc-date-index (rmail-desc-get-descriptor n)))
+
+(defun rmail-desc-get-day-number (n)
+ "Return the day number (1..31) from the date associated with message N."
+ (nth rmail-desc-date-day-number-index
+ (nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
+
+(defun rmail-desc-get-day-of-week (n)
+ "Return the day of week (Sun .. Sat) from the date associated with message N."
+ (nth rmail-desc-date-day-of-week-index
+ (nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
+
+(defun rmail-desc-get-default-attrs ()
+ "Return the default attributes for a new message."
+ (format "%s" "------U"))
+
+(defun rmail-desc-get-header-display-state (n)
+ "Return t if ignorable headers are being displayed, nil otherwise."
+ (null (overlays-at (rmail-desc-get-start n))))
+
+(defun rmail-desc-get-keyword (attr-index)
+ "Return the keyword string associated with ATTR-INDEX."
+ (nth rmail-desc-attr-keyword-index
+ (cdr (assoc attr-index rmail-desc-attr-alist))))
+
+(defun rmail-desc-get-keyword-list (n)
+ "Return the list of User defined keywords for message N."
+ (nth rmail-desc-keywords-index (rmail-desc-get-descriptor n)))
+
+(defun rmail-desc-get-keyword-maybe (attribute)
+ "Return the keyword associated with ATTRIBUTE if it is set, nil otherwise.
+ATTRIBUTE is a cons cell associating an attribute index with a keyword string."
+ (let ((index (car attribute)))
+ (if (not (equal "-" (substring rmail-desc-attributes index (1+ index))))
+ (nth rmail-desc-attr-keyword-index (cdr attribute)))))
+
+(defun rmail-desc-get-keywords (n)
+ "Return a list of keywords for message N."
+ ;; Combine the attribute keywords with the User defined keywords.
+ (setq rmail-desc-attributes (rmail-desc-get-attributes n))
+ (append (delq nil (mapcar
+ 'rmail-desc-get-keyword-maybe
+ rmail-desc-attr-alist))
+ (rmail-desc-get-keyword-list n)))
+
+(defun rmail-desc-get-line-count (n)
+ "Return the message body line count."
+ (nth rmail-desc-line-count-index (rmail-desc-get-descriptor n)))
+
+(defun rmail-desc-get-month (n)
+ "Return the month (Jan .. Dec) from the date associated with message N."
+ (nth rmail-desc-date-month-index
+ (nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
+
+(defun rmail-desc-get-sender (n)
+ "Return the User registered as the mail sender."
+ (nth rmail-desc-sender-index (rmail-desc-get-descriptor n)))
+
+(defun rmail-desc-get-subject (n)
+ "Return the cached subject header."
+ (nth rmail-desc-subject-index (rmail-desc-get-descriptor n)))
+
+(defun rmail-desc-get-summary-offset (attr-index)
+ "Return the summary buffer offset associated with ATTR-INDEX.
+This is the relative position where the attribute code letter is
+displayed in the Rmail summary buffer."
+ (nth rmail-desc-attr-summary-offset-index
+ (cdr (assoc attr-index rmail-desc-attr-alist))))
+
+(defun rmail-desc-get-time (n)
+ "Return the time (hh:mm:ss) from the date associated with message N."
+ (nth rmail-desc-date-time-index
+ (nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
+
+(defun rmail-desc-get-year (n)
+ "Return the year (1969 ... 2###) from the date associated with message N."
+ (nth rmail-desc-date-year-index
+ (nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
+
+;; This is a strange thing to use.
+;; Why not write a simple loop instead?
+(defun rmail-desc-make-index-list ()
+ "Return a list of integers from 1 to the total number of messages."
+ (let ((result (make-vector (length rmail-desc-vector) nil))
+ (index 0))
+ (while (< index (length result))
+ (aset result index (1+ index))
+ (setq index (1+ index)))
+ (append result nil)))
+
+(defun rmail-desc-prune-deleted-messages (callback)
+ "Remove all messages marked for marked for deletion.
+Return the number of messages removed. Invoke CALLBACK immediately
+after a message has been deleted.."
+
+ ;; Set the callback.
+ (setq rmail-desc-delete-callback callback)
+
+ ;; Remove all messages marked for deletion from the Rmail buffer and
+ ;; their descriptors from the Rmail message vector.
+ (let ((result (length (delq t (mapcar 'rmail-desc-delete-maybe
+ (rmail-desc-make-index-list))))))
+ (setq rmail-desc-vector
+ (vconcat (delq t (append rmail-desc-vector nil))))
+ result))
+
+(defun rmail-desc-set-attribute (attr-index state n)
+ "Set the attribute denoted by ATTR-INDEX in message N according to STATE.
+If STATE is non-nil the attribute will be set to the single character code
+associated with ATTR-INDEX in rmail-desc-attr-alist, otherwise the attribute is
+set to the hyphen character (-)."
+ (let ((attributes (nth rmail-desc-attrs-index (rmail-desc-get-descriptor n)))
+ code)
+ (setq code (if state
+ (car (cdr (assoc attr-index rmail-desc-attr-alist)))
+ ?-))
+ (aset attributes attr-index code)
+ (rmail-header-persist-attributes attributes)))
+
+(defun rmail-desc-set-start (n pos)
+ "Set the start position for message N to POS."
+ (set-marker (nth rmail-desc-beg-index (rmail-desc-get-descriptor n)) pos))
+
+(defun rmail-desc-showing-message-p (n)
+ "Return t if the current buffer is displaying message N, nil otherwise."
+ (let ((beg (rmail-desc-get-start n))
+ (end (rmail-desc-get-end n))
+ (curpos (point)))
+ (and (>= curpos beg) (< curpos end))))
+
+(provide 'rmaildesc)
--- /dev/null
+;;; rmail-header.el --- Header handling code of "RMAIL" mail reader for Emacs
+
+;; Copyright (C) 2002
+;; Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;; Written by Paul Reilly as part of moving BABYL to inbox/mbox format.
+
+(eval-when-compile
+ (require 'mail-utils))
+
+(defconst rmail-header-attribute-header "X-BABYL-V6-ATTRIBUTES"
+ "The header that persists the Rmail attribute data.")
+
+(defconst rmail-header-keyword-header "X-BABYL-V6-KEYWORDS"
+ "The header that persists the Rmail keyword data.")
+
+(defvar rmail-header-overlay-list nil
+ "A list of cached overlays used to make headers hidden or visible.")
+
+(defvar rmail-header-display-mode nil
+ "Records the current header display mode.
+nil means headers are displayed, t indicates headers are not displayed.")
+
+(defmacro rmail-header-get-limit ()
+ '(progn
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (error "Invalid message format."))))
+
+;;; The following functions are presented alphabetically ordered by
+;;; name.
+
+(defun rmail-header-add-header (header value)
+ "Add HEADER to the list of headers and associate VALUE with it.
+The current buffer, possibly narrowed, contains a single message."
+ (save-excursion
+ (let* ((inhibit-read-only t)
+ (case-fold-search t)
+ (limit (rmail-header-get-limit))
+ start end)
+
+ ;; Search for the given header. If found, then set it's value.
+ ;; If not then add the header to the end of the header section.
+ (goto-char (point-min))
+ (if (re-search-forward (format "^%s: " header) limit t)
+
+ ;; Kill the current value and replace it with the new.
+ (progn
+ (beginning-of-line)
+ (setq start (point))
+ (while (progn
+ (forward-line 1)
+ (looking-at "[ \t]+")))
+ (kill-region start (point)))
+
+ ;; Add a new header at the end of the headers.
+ (goto-char limit))
+ (insert header ": " value "\n"))))
+
+(defun rmail-header-contains-keyword-p (keyword)
+ "Return t if KEYWORD exists in the current buffer, nil otherwise."
+ (let ((limit (rmail-header-get-limit)))
+ (goto-char (point-min))
+ (if (re-search-forward (format "^%s: " rmail-header-keyword-header) limit t)
+
+ ;; Some keywords exist. Now search for the specific keyword.
+ (let ((start (point))
+ (end (progn (end-of-line) (point))))
+ (if (re-search-forward (concat "\\(" keyword ",\\|" keyword "$\\)"))
+ t)))))
+
+(defun rmail-header-get-header (header)
+ "Return the text value for HEADER, nil if no such header exists.
+The current buffer, possibly narrowed, contains a single message."
+ (save-excursion
+ (let ((case-fold-search t)
+ (inhibit-point-motion-hooks t)
+ (limit (rmail-header-get-limit))
+ result start end)
+
+ ;; Search for the given header. If found return it, otherwise
+ ;; nil.
+ (goto-char (point-min))
+ (if (re-search-forward (format "^%s: " header) limit t)
+
+ ;; Get the value, including extension parts.
+ (progn
+ (setq start (point))
+ (end-of-line)
+ (setq result (buffer-substring start (point)))
+ (while (progn
+ (forward-line 1)
+ (looking-at "[ \t]+"))
+ (setq start (match-end 0))
+ (end-of-line)
+ (setq result (format "%s %s" result
+ (buffer-substring start (point)))))))
+ result)))
+
+(defun rmail-header-get-keywords ()
+ "Return the keywords in the current message.
+The current buffer, possibly narrowed, contains a single message."
+
+ ;; Search for a keyword header and return the comma separated
+ ;; strings as a list.
+ (let ((limit (rmail-header-get-limit)) result)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (format "^%s: " rmail-header-keyword-header) limit t)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (progn (end-of-line) (point)))
+ (goto-char (point-min))
+ (mail-parse-comma-list))))))
+
+
+(defun rmail-header-hide-headers ()
+ "Hide ignored headers. All others will be visible.
+The current buffer, possibly narrowed, contains a single message."
+ (save-excursion
+ (let ((case-fold-search t)
+ (limit (rmail-header-get-limit))
+ (inhibit-point-motion-hooks t)
+ start end visibility-p overlay overlay-list)
+
+ ;; Record the display state as having headers hidden.
+ (setq rmail-header-display-mode t)
+
+ ;; Clear the pool of overlays for reuse.
+ (mapcar 'delete-overlay rmail-header-overlay-list)
+ (setq overlay-list rmail-header-overlay-list)
+
+ ;; Determine whether to use the displayed headers or the ignored
+ ;; headers.
+ (if rmail-displayed-headers
+
+ ;; Set the visibility predicate function to ignore headers
+ ;; marked for display.
+ (setq visibility-p 'rmail-header-show-displayed-p)
+
+ ;; Set the visibility predicate function to hide ignored
+ ;; headers.
+ (setq visibility-p 'rmail-header-hide-ignored-p))
+
+ ;; Walk through all the headers marking the non-displayed
+ ;; headers as invisible.
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t:]+[ :]" limit t)
+
+ ;; Determine if the current header needs to be hidden.
+ (beginning-of-line)
+ (if (funcall visibility-p)
+
+ ;; It does. Make this header hidden by setting an overlay
+ ;; with both the invisible and intangible properties set.
+ (progn
+ (setq start (point))
+ (forward-line 1)
+ (while (looking-at "[ \t]+")
+ (forward-line 1))
+ (setq end (point))
+
+ ;; Use one of the cleared, cached overlays until they
+ ;; run out.
+ (if (car overlay-list)
+
+ ;; Use a cached overlay.
+ (progn
+ (setq overlay (car overlay-list)
+ overlay-list (cdr overlay-list))
+ (move-overlay overlay start end))
+
+ ;; No overlay exists for this header. Create one and
+ ;; add it to the cache.
+ (setq overlay (make-overlay start end)
+ rmail-header-overlay-list
+ (append (list overlay)
+ rmail-header-overlay-list))
+ (overlay-put overlay 'invisible t)
+ (overlay-put overlay 'intangible t)))
+
+ ;; It does not. Move point away from this header.
+ (forward-line 1))))))
+
+(defun rmail-header-persist-attributes (attributes)
+ "Save ATTRIBUTES in the Rmail BABYL header.
+The current buffer, possibly narrowed, contains a single message."
+ (rmail-header-set-header rmail-header-attribute-header attributes))
+
+(defun rmail-header-remove-keyword (keyword)
+ "..."
+ ;; tbd
+ )
+
+(defun rmail-header-set-header (header value)
+ "Set the current value of HEADER to VALUE.
+The current buffer, possibly narrowed, contains a single message."
+ (save-excursion
+
+ ;; Enable the buffer to be written, search for the header case
+ ;; insensitively, ignore intangibility and do not record these
+ ;; changes in the undo list.
+ (let ((inhibit-read-only t)
+ (case-fold-search t)
+ (inhibit-point-motion-hooks t)
+ (buffer-undo-list t)
+ (limit (rmail-header-get-limit))
+ start end)
+
+ ;; Search for the given header. If found, then set it's value.
+ ;; If not generate an error.
+ (goto-char (point-min))
+ (if (re-search-forward (format "^%s: " header) limit t)
+
+ ;; Kill the current value and replace it with the new.
+ (progn
+ (setq start (point))
+ (while (progn
+ (forward-line 1)
+ (looking-at "[ \t]+")))
+ (setq end (point-marker))
+ (goto-char start)
+ (insert-and-inherit value)
+ (kill-region (point) (1- (marker-position end))))
+ ;; Generate an error since the header does not exist.
+ (error "Header %s not found." header)))))
+
+(defun rmail-header-show-headers ()
+ "Show all headers.
+The current buffer, possibly narrowed, contains a single message."
+ ;; Remove all the overlays used to control hiding headers.
+ (mapcar 'delete-overlay rmail-header-overlay-list)
+ (setq rmail-header-display-mode nil))
+
+(defun rmail-header-toggle-visibility (&optional arg)
+ "Toggle the visibility of the ignored headers if ARG is nil.
+Hide the ignored headers if ARG is greater than 0, otherwise show the
+ignored headers. The current buffer, possibly narrowed, contains a
+single message."
+ (cond ((eq arg nil)
+ (if rmail-header-display-mode
+ (rmail-header-show-headers)
+ (rmail-header-hide-headers)))
+ ((or (eq arg t) (> arg 0))
+ (rmail-header-hide-headers))
+ (t (rmail-header-show-headers))))
+
+(defun rmail-header-hide-ignored-p ()
+ "Test that the header is one of the headers marked to be ignored."
+ (looking-at rmail-ignored-headers))
+
+(defun rmail-header-show-displayed-p ()
+ "Test that the header is not one of the headers marked for display."
+ (not (looking-at rmail-displayed-headers)))
+
+(provide 'rmailhdr)
projects / emacs.git / commitdiff