Mercurial > emacs
changeset 88257:b6d2078cce14
(rmail-header-attribute-header)
(rmail-header-keyword-header, rmail-header-get-limit): Doc.
(rmail-header-add-header): Add inhibit-point-motion-hooks and
buffer-undo-list bindings from rmail-header-set-header. I don't
know whether they are necessary, however.
(rmail-header-persist-attributes, rmail-header-set-header):
Deleted. rmail-header-add-header does what
rmail-header-set-header did, except throw an error if the header
was not found.
author | Alex Schroeder <alex@gnu.org> |
---|---|
date | Sat, 21 Jan 2006 15:27:34 +0000 |
parents | db2e6586ecf5 |
children | e03b9b63e187 |
files | lisp/mail/rmailhdr.el |
diffstat | 1 files changed, 8 insertions(+), 45 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/mail/rmailhdr.el Sat Jan 21 15:00:38 2006 +0000 +++ b/lisp/mail/rmailhdr.el Sat Jan 21 15:27:34 2006 +0000 @@ -26,16 +26,14 @@ ;;; 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.") + "The header that stores the Rmail attribute data.") (defconst rmail-header-keyword-header "X-BABYL-V6-KEYWORDS" - "The header that persists the Rmail keyword data.") + "The header that stores the Rmail keyword data.") (defvar rmail-header-overlay-list nil "A list of cached overlays used to make headers hidden or visible.") @@ -45,15 +43,15 @@ nil means headers are displayed, t indicates headers are not displayed.") (defun rmail-header-get-limit () - "Return the end of the headers." + "Return the end of the headers. +The current buffer must show one message. If you want to narrow +to the headers of a mail by number, use `rmail-narrow-to-header' +instead." (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. @@ -62,6 +60,8 @@ (save-excursion (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. @@ -170,43 +170,6 @@ (overlay-put overlay 'intangible t) (push overlay rmail-header-overlay-list)))))))) -(defun rmail-header-persist-attributes (attributes) - "Save ATTRIBUTES in the Rmail BABYL header." - (rmail-header-set-header rmail-header-attribute-header attributes)) - -(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."