[Emacs-diffs] emacs/lisp/mail rmail.el

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       09/02/10 03:33:27

Modified files:
        lisp/mail      : rmail.el 

Log message:
        (rmail-automatic-folder-directives): Doc fix.
        (rmail-current-message, rmail-total-messages)
        (rmail-message-vector, rmail-deleted-vector): Add doc strings.
        (rmail-duplicate-message): Doc fix.
        (rmail-get-header-1, rmail-set-header-1, rmail-set-attribute-1):
        New functions.
        (rmail-get-header, rmail-set-header, rmail-set-attribute):
        Use rmail-apply-in-message.
        (rmail-message-attr-p): Use rmail-get-header, hence no longer requires
        unswapped-ness.
        (rmail-get-attr-names): Check for missing or corrupt attribute headers.
        (rmail-auto-file): Set the filed attribute, rather than explicitly not
        doing so.  (Bug#2231)

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mail/rmail.el?cvsroot=emacs&r1=1.496&r2=1.497

Patches:
Index: rmail.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mail/rmail.el,v
retrieving revision 1.496
retrieving revision 1.497
diff -u -b -r1.496 -r1.497
--- rmail.el    7 Feb 2009 18:35:05 -0000       1.496
+++ rmail.el    10 Feb 2009 03:33:27 -0000      1.497
@@ -498,7 +498,9 @@
 
 examples:
   (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com
-  (\"RMS\" \"from\" \"address@hidden") ; save all mail from RMS."
+  (\"RMS\" \"from\" \"address@hidden") ; save all mail from RMS.
+
+Note that this is only applied in the folder specifed by `rmail-file-name'."
   :group 'rmail
   :version "21.1"
   :type '(repeat (sexp :tag "Directive")))
@@ -529,16 +531,24 @@
 
 ;; Message counters and markers.  Deleted flags.
 
-(defvar rmail-current-message nil)
+(defvar rmail-current-message nil
+  "Integer specifying the message currently being displayed in this folder.")
 (put 'rmail-current-message 'permanent-local t)
 
-(defvar rmail-total-messages nil)
+(defvar rmail-total-messages nil
+  "Integer specifying the total number of messages in this folder.
+Includes deleted messages.")
 (put 'rmail-total-messages 'permanent-local t)
 
-(defvar rmail-message-vector nil)
+(defvar rmail-message-vector nil
+  "Vector of markers specifying the start and end of each message.
+Element N and N+1 specify the start and end of message N.")
 (put 'rmail-message-vector 'permanent-local t)
 
-(defvar rmail-deleted-vector nil)
+(defvar rmail-deleted-vector nil
+  "A string of length `rmail-total-messages' plus one.
+Character N is either a space or \"D\", according to whether
+message N is deleted or not.")
 (put 'rmail-deleted-vector 'permanent-local t)
 
 (defvar rmail-msgref-vector nil
@@ -1444,10 +1454,9 @@
 
 (defun rmail-duplicate-message ()
   "Create a duplicated copy of the current message.
-The duplicate copy goes into the Rmail file just after the
-original copy."
-  (interactive)
+The duplicate copy goes into the Rmail file just after the original."
   ;; If we are in a summary buffer, switch to the Rmail buffer.
+  ;; FIXME simpler to swap the contents, not the buffers?
   (set-buffer rmail-buffer)
   (let ((buff (current-buffer))
         (n rmail-current-message)
@@ -1710,7 +1719,7 @@
         (rsf-number-of-spam 0)
         (rsf-scanned-message-number (1+ old-messages))
         ;; save deletion flags of old messages: vector starts at zero
-        ;; (is one longer that no of messages), therefore take 1+
+        ;; (is one longer than no of messages), therefore take 1+
         ;; old-messages
         (save-deleted (substring rmail-deleted-vector 0 (1+ old-messages)))
         blurb)
@@ -1988,65 +1997,45 @@
            (setq start (point))))
        count))))
 
+(defun rmail-get-header-1 (name)
+  "Subroutine of `rmail-get-header'.
+Narrow to header, call `mail-fetch-field' to find header NAME."
+  (if (search-forward "\n\n" nil t)
+      (progn
+        (narrow-to-region (point-min) (point))
+        (mail-fetch-field name))
+    (rmail-error-bad-format)))
+
 (defun rmail-get-header (name &optional msgnum)
   "Return the value of message header NAME, nil if it has none.
 MSGNUM specifies the message number to get it from.
 If MSGNUM is nil, use the current message."
-  (with-current-buffer rmail-buffer
-    (or msgnum (setq msgnum rmail-current-message))
-    (when (> msgnum 0)
-      (let (msgbeg end)
-       (setq msgbeg (rmail-msgbeg msgnum))
-       ;; All access to the buffer's local variables is now finished...
-       (save-excursion
-         ;; ... so it is ok to go to a different buffer.
-         (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
-          (save-excursion
-         (save-restriction
-           (widen)
-             (goto-char msgbeg)
-             (setq end (search-forward "\n\n" nil t))
-             (if end
-                 (progn
-                   (narrow-to-region msgbeg end)
-                   (mail-fetch-field name))
-               (rmail-error-bad-format msgnum)))))))))
+  (rmail-apply-in-message msgnum 'rmail-get-header-1 name))
 
-(defun rmail-set-header (name &optional msgnum value)
-  "Store VALUE in message header NAME, nil if it has none.
-MSGNUM specifies the message number to operate on.
-If MSGNUM is nil, use the current message."
-  (with-current-buffer rmail-buffer
-    (or msgnum (setq msgnum rmail-current-message))
-    (when (> msgnum 0)
-      (let (msgbeg end)
-       (setq msgbeg (rmail-msgbeg msgnum))
-       ;; All access to the buffer's local variables is now finished...
-       (save-excursion
-         ;; ... so it is ok to go to a different buffer.
-         (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
-          (save-excursion
-         (save-restriction
-           (widen)
-             (goto-char msgbeg)
-             (setq end (search-forward "\n\n" nil t))
-             (if end (setq end (1- end)))
-             (if end
+(defun rmail-set-header-1 (name value)
+  "Subroutine of `rmail-set-header'.
+Narrow to header, set header NAME to VALUE, replacing existing if present."
+  (if (search-forward "\n\n" nil t)
                  (progn
-                   (narrow-to-region msgbeg end)
-                   (goto-char msgbeg)
-                   (if (re-search-forward (concat "^"
-                                                  (regexp-quote name)
-                                                  ":")
-                                          nil t)
+       (forward-char -1)
+       (narrow-to-region (point-min) (point))
+       (goto-char (point-min))
+       (if (re-search-forward (concat "^" (regexp-quote name) ":") nil 'move)
                        (progn
                          (delete-region (point) (line-end-position))
                          (insert " " value))
-                     (goto-char end)
                      (insert name ": " value "\n")))
-               (rmail-error-bad-format msgnum)))))
+    (rmail-error-bad-format)))
+
+(defun rmail-set-header (name &optional msgnum value)
+  "Store VALUE in message header NAME, nil if it has none.
+MSGNUM specifies the message number to operate on.
+If MSGNUM is nil, use the current message."
+  (rmail-apply-in-message msgnum 'rmail-set-header-1 name value)
        ;; Ensure header changes get saved.
-       (if end (set-buffer-modified-p t))))))
+  ;; (Note replacing a header with an identical copy modifies.)
+  (with-current-buffer rmail-buffer (set-buffer-modified-p t)))
+
 
 ;;;; *** Rmail Attributes and Keywords ***
 
@@ -2055,8 +2044,12 @@
 MSG specifies the message number to get it from.
 If MSG is nil, use the current message."
   (let ((value (rmail-get-header rmail-attribute-header msg))
+       (nmax (length rmail-attr-array))
        result temp)
-    (dotimes (index (length value))
+    (when value
+      (unless (= (length value) nmax)
+       (error "Corrupt attribute header in message"))
+      (dotimes (index nmax)
       (setq temp (and (not (= ?- (aref value index)))
                      (nth 1 (aref rmail-attr-array index)))
            result
@@ -2064,7 +2057,7 @@
             ((and temp result) (format "%s, %s" result temp))
             (temp temp)
             (t result))))
-    result))
+      result)))
 
 (defun rmail-get-keywords (&optional msg)
   "Return the message keywords in a comma separated string.
@@ -2116,44 +2109,21 @@
    ((not state) ?-)
    (t (nth 0 (aref rmail-attr-array attr)))))
 
-(defun rmail-set-attribute (attr state &optional msgnum)
-  "Turn an attribute of a message on or off according to STATE.
-STATE is either nil or the character (numeric) value associated
-with the state (nil represents off and non-nil represents on).
-ATTR is the index of the attribute.  MSGNUM is message number to
-change; nil means current message."
-  (with-current-buffer rmail-buffer
-    (let ((value (rmail-get-attr-value attr state))
+(defun rmail-set-attribute-1 (attr state)
+  "Subroutine of `rmail-set-attribute'.
+Set Rmail attribute ATTR to STATE in `rmail-attribute-header',
+creating the header if necessary.  Returns non-nil if a
+significant attribute change was made."
+  (let ((limit (search-forward "\n\n" nil t))
+        (value (rmail-get-attr-value attr state))
          (inhibit-read-only t)
-         limit
-         altered
-         msgbeg)
-      (or msgnum (setq msgnum rmail-current-message))
-      (when (> msgnum 0)
-       ;; The "deleted" attribute is also stored in a special vector
-       ;; so update that too.
-       (if (= attr rmail-deleted-attr-index)
-           (rmail-set-message-deleted-p msgnum state))
-       (setq msgbeg (rmail-msgbeg msgnum))
-
-       ;; All access to the buffer's local variables is now finished...
-       (unwind-protect
-           (save-excursion
-             ;; ... so it is ok to go to a different buffer.
-             (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
-              (save-excursion
-             (save-restriction
-               (widen)
-                 ;; Determine if the current state is the desired state.
-                 (goto-char msgbeg)
-                 (save-excursion
-                   (setq limit (search-forward "\n\n" nil t)))
+        altered)
+    (goto-char (point-min))
                  (if (search-forward (concat rmail-attribute-header ": ") 
limit t)
-                     ;; If this message already records attributes,
-                     ;; just change the value for this one.
+        ;; If this message already records attributes, just change the
+        ;; value for this one.
                      (let ((missing (- (+ (point) attr) (line-end-position))))
-                       ;; Position point at this  attribute,
-                       ;; adding attributes if necessary.
+          ;; Position point at this attribute, adding attributes if necessary.
                        (if (> missing 0)
                            (progn
                              (end-of-line)
@@ -2165,35 +2135,41 @@
                          (setq altered t)
                          (delete-char 1)
                          (insert value)))
-                   ;; Otherwise add a header line to record the attributes
-                   ;; and set all but this one to no.
+      ;; Otherwise add a header line to record the attributes and set
+      ;; all but this one to no.
                    (let ((header-value "--------"))
                      (aset header-value attr value)
-                     (goto-char (if limit (- limit 1) (point-max)))
+        (goto-char (if limit (1- limit) (point-max)))
                      (setq altered (/= value ?-))
-                     (insert rmail-attribute-header ": " header-value 
"\n"))))))
+        (insert rmail-attribute-header ": " header-value "\n")))
+    altered))
+
+(defun rmail-set-attribute (attr state &optional msgnum)
+  "Turn an attribute of a message on or off according to STATE.
+STATE is either nil or the character (numeric) value associated
+with the state (nil represents off and non-nil represents on).
+ATTR is the index of the attribute.  MSGNUM is message number to
+change; nil means current message."
+  (with-current-buffer rmail-buffer
+    (or msgnum (setq msgnum rmail-current-message))
+    (when (> msgnum 0)
+      ;; The "deleted" attribute is also stored in a special vector so
+      ;; update that too.
+      (if (= attr rmail-deleted-attr-index)
+          (rmail-set-message-deleted-p msgnum state))
+      (if (prog1
+              (rmail-apply-in-message msgnum 'rmail-set-attribute-1 attr state)
          (if (= msgnum rmail-current-message)
-             (rmail-display-labels))))
-      ;; If we made a significant change in an attribute,
-      ;; mark rmail-buffer modified, so it will be (1) saved
-      ;; and (2) displayed in the mode line.
-      (if altered
+                (rmail-display-labels)))
+          ;; If we made a significant change in an attribute, mark
+          ;; rmail-buffer modified, so it will be (1) saved and (2)
+          ;; displayed in the mode line.
          (set-buffer-modified-p t)))))
 
 (defun rmail-message-attr-p (msg attrs)
-  "Return t if the attributes header for message MSG matches regexp ATTRS.
-This function assumes the Rmail buffer is unswapped."
-  (save-excursion
-    (save-restriction
-      (let ((start (rmail-msgbeg msg))
-            limit)
-        (widen)
-        (goto-char start)
-        (setq limit (search-forward "\n\n" (rmail-msgend msg) t))
-        (goto-char start)
-        (and limit
-             (search-forward (concat rmail-attribute-header ": ") limit t)
-             (looking-at attrs))))))
+  "Return t if the attributes header for message MSG matches regexp ATTRS."
+  (let ((value (rmail-get-header rmail-attribute-header msg)))
+    (and value (string-match attrs value))))
 
 (defun rmail-message-unseen-p (msgnum)
   "Test the unseen attribute for message MSGNUM.
@@ -2235,6 +2211,7 @@
                (narrow-to-region msgbeg msgend)
               (apply function args))))))))
 
+;; Unused (save for commented out code in rmailedit.el).
 (defun rmail-widen-to-current-msgbeg (function)
   "Call FUNCTION with point at start of internal data of current message.
 Assumes that bounds were previously narrowed to display the message in Rmail.
@@ -2805,7 +2782,7 @@
                (rmail-delete-forward)
              (if (string= "/dev/null" folder)
                  (rmail-delete-message)
-               (rmail-output folder 1 t)
+               (rmail-output folder 1)
                (setq d nil))))
        (setq d (cdr d))))))