comparison lisp/mail/rmail.el @ 101916:85a6bf6279eb

(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)

101915:091a8cf73243

REGEXP is an expression to match in the preceeding specified FIELD.
FIELD/REGEXP pairs continue in the list.

examples:
  (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com
  (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS."
  :group 'rmail
  :version "21.1"
  :type '(repeat (sexp :tag "Directive")))

(defvar rmail-reply-prefix "Re: "

In a summary buffer, this holds the RMAIL buffer it is a summary for.")
(put 'rmail-buffer 'permanent-local t)

;; Message counters and markers.  Deleted flags.

(defvar rmail-current-message nil)
(put 'rmail-current-message 'permanent-local t)

(defvar rmail-total-messages nil)
(put 'rmail-total-messages 'permanent-local t)

(defvar rmail-message-vector nil)
(put 'rmail-message-vector 'permanent-local t)

(defvar rmail-deleted-vector nil)
(put 'rmail-deleted-vector 'permanent-local t)

(defvar rmail-msgref-vector nil
  "In an Rmail buffer, a vector whose Nth element is a list (N).
When expunging renumbers messages, these lists are modified

	  (bury-buffer rmail-summary-buffer)))
    (quit-window)))

(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)
  ;; If we are in a summary buffer, switch to the Rmail buffer.
  (set-buffer rmail-buffer)
  (let ((buff (current-buffer))
        (n rmail-current-message)
        (beg (rmail-msgbeg rmail-current-message))
        (end (rmail-msgend rmail-current-message)))
    (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
    (widen)
    (let ((buffer-read-only nil)
          (string (buffer-substring-no-properties beg end)))
      (goto-char end)
      (insert string))
    (set-buffer buff)
    (rmail-swap-buffers-maybe)

  "Process new messages for spam."
  (let* ((old-messages (- rmail-total-messages new-message-count))
	 (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+
	 ;; old-messages
	 (save-deleted (substring rmail-deleted-vector 0 (1+ old-messages)))
	 blurb)
    ;; set all messages to undeleted
    (setq rmail-deleted-vector (make-string (1+ rmail-total-messages) ?\ ))

	    (if (search-forward "\n\nFrom " nil 'move)
		(forward-char -5))
	    (setq start (point))))
	count))))

(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)))))))))

(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
		  (progn
		    (narrow-to-region msgbeg end)
		    (goto-char msgbeg)
		    (if (re-search-forward (concat "^"
						   (regexp-quote name)
						   ":")
					   nil t)
			(progn
			  (delete-region (point) (line-end-position))
			  (insert " " value))
		      (goto-char end)
		      (insert name ": " value "\n")))
		(rmail-error-bad-format msgnum)))))
	;; Ensure header changes get saved.
	(if end (set-buffer-modified-p t))))))

;;;; *** Rmail Attributes and Keywords ***

(defun rmail-get-attr-names (&optional msg)
  "Return the message attributes in a comma separated string.
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))
	result temp)
    (dotimes (index (length value))
      (setq temp (and (not (= ?- (aref value index)))
		      (nth 1 (aref rmail-attr-array index)))
	    result
	    (cond
	     ((and temp result) (format "%s, %s" result temp))
	     (temp temp)
	     (t result))))
    result))

(defun rmail-get-keywords (&optional msg)
  "Return the message keywords in a comma separated string.
MSG, if non-nil, identifies the message number to use.
If nil, that means the current message."

  (cond
   ((numberp state) state)
   ((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))
	  (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)))
		  (if (search-forward (concat rmail-attribute-header ": ") limit t)
		      ;; 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.
			(if (> missing 0)
			    (progn
			      (end-of-line)
			      (insert-char ?- missing)
			      (backward-char 1))
			  (forward-char attr))
			;; Change this attribute.
			(when (/= value (char-after))
			  (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.
		    (let ((header-value "--------"))
		      (aset header-value attr value)
		      (goto-char (if limit (- limit 1) (point-max)))
		      (setq altered (/= value ?-))
		      (insert rmail-attribute-header ": " header-value "\n"))))))
	  (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
	  (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))))))

(defun rmail-message-unseen-p (msgnum)
  "Test the unseen attribute for message MSGNUM.
Return non-nil if the unseen attribute is set, nil otherwise."
  (rmail-message-attr-p msgnum "......U"))

	(setq msgend (rmail-msgend msgnum))
	;; All access to the rmail-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)
		(narrow-to-region msgbeg msgend)
              (apply function args))))))))

(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.
The bounds are widened enough to move point where desired, then narrowed
again afterward.

	(if (null directive-loop)
	    (if (null folder)
		(rmail-delete-forward)
	      (if (string= "/dev/null" folder)
		  (rmail-delete-message)
		(rmail-output folder 1 t)
		(setq d nil))))
	(setq d (cdr d))))))

;; Simple message motion commands.

101916:85a6bf6279eb

REGEXP is an expression to match in the preceeding specified FIELD.
FIELD/REGEXP pairs continue in the list.

examples:
  (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com
  (\"RMS\" \"from\" \"rms@\") ; 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")))

(defvar rmail-reply-prefix "Re: "

In a summary buffer, this holds the RMAIL buffer it is a summary for.")
(put 'rmail-buffer 'permanent-local t)

;; Message counters and markers.  Deleted flags.

(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
  "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
  "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
  "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
  "In an Rmail buffer, a vector whose Nth element is a list (N).
When expunging renumbers messages, these lists are modified

	  (bury-buffer rmail-summary-buffer)))
    (quit-window)))

(defun rmail-duplicate-message ()
  "Create a duplicated copy of the current message.
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)
        (beg (rmail-msgbeg rmail-current-message))
        (end (rmail-msgend rmail-current-message)))
    (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
      (widen)
      (let ((buffer-read-only nil)
          (string (buffer-substring-no-properties beg end)))
      (goto-char end)
      (insert string))
    (set-buffer buff)
    (rmail-swap-buffers-maybe)

  "Process new messages for spam."
  (let* ((old-messages (- rmail-total-messages new-message-count))
	 (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 than no of messages), therefore take 1+
	 ;; old-messages
	 (save-deleted (substring rmail-deleted-vector 0 (1+ old-messages)))
	 blurb)
    ;; set all messages to undeleted
    (setq rmail-deleted-vector (make-string (1+ rmail-total-messages) ?\ ))

	    (if (search-forward "\n\nFrom " nil 'move)
		(forward-char -5))
	    (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."
  (rmail-apply-in-message msgnum 'rmail-get-header-1 name))

(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
	(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))
	  (insert name ": " value "\n")))
    (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.
  ;; (Note replacing a header with an identical copy modifies.)
  (with-current-buffer rmail-buffer (set-buffer-modified-p t)))


;;;; *** Rmail Attributes and Keywords ***

(defun rmail-get-attr-names (&optional msg)
  "Return the message attributes in a comma separated string.
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)
    (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
	      (cond
	       ((and temp result) (format "%s, %s" result temp))
	       (temp temp)
	       (t result))))
      result)))

(defun rmail-get-keywords (&optional msg)
  "Return the message keywords in a comma separated string.
MSG, if non-nil, identifies the message number to use.
If nil, that means the current message."

  (cond
   ((numberp state) state)
   ((not state) ?-)
   (t (nth 0 (aref rmail-attr-array attr)))))

(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)
        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.
        (let ((missing (- (+ (point) attr) (line-end-position))))
          ;; Position point at this attribute, adding attributes if necessary.
          (if (> missing 0)
              (progn
                (end-of-line)
                (insert-char ?- missing)
                (backward-char 1))
            (forward-char attr))
          ;; Change this attribute.
          (when (/= value (char-after))
            (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.
      (let ((header-value "--------"))
        (aset header-value attr value)
        (goto-char (if limit (1- limit) (point-max)))
        (setq altered (/= value ?-))
        (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.
          (set-buffer-modified-p t)))))

(defun rmail-message-attr-p (msg 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.
Return non-nil if the unseen attribute is set, nil otherwise."
  (rmail-message-attr-p msgnum "......U"))

	(setq msgend (rmail-msgend msgnum))
	;; All access to the rmail-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)
	      (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.
The bounds are widened enough to move point where desired, then narrowed
again afterward.

	(if (null directive-loop)
	    (if (null folder)
		(rmail-delete-forward)
	      (if (string= "/dev/null" folder)
		  (rmail-delete-message)
		(rmail-output folder 1)
		(setq d nil))))
	(setq d (cdr d))))))

;; Simple message motion commands.