Function: rmail-auto-file

rmail-auto-file is a byte-compiled function defined in rmail.el.gz.

Signature

(rmail-auto-file)

Documentation

Automatically move a message into another sfolder based on criteria.

This moves messages according to rmail-automatic-folder-directives. It only does something in the folder that rmail-file-name specifies. The function rmail-show-message calls this whenever it shows a message. This leaves a message alone if it already has the filed attribute.

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rmail.el.gz
(defun rmail-auto-file ()
  "Automatically move a message into another sfolder based on criteria.
This moves messages according to `rmail-automatic-folder-directives'.
It only does something in the folder that `rmail-file-name' specifies.
The function `rmail-show-message' calls this whenever it shows a message.
This leaves a message alone if it already has the `filed' attribute."
  (if (or (zerop rmail-total-messages)
	  (rmail-message-attr-p rmail-current-message "...F")
	  (not (string= (buffer-file-name)
			(expand-file-name rmail-file-name))))
      ;; Do nothing if the message has already been filed or if there
      ;; are no messages.
      nil
    ;; Find out some basics (common fields)
    (let ((from (mail-fetch-field "from"))
	  (subj (mail-fetch-field "subject"))
	  (to   (concat (mail-fetch-field "to") "," (mail-fetch-field "cc")))
	  (d rmail-automatic-folder-directives)
	  (directive-loop nil)
	  (folder nil))
      (while d
	(setq folder (car (car d))
	      directive-loop (cdr (car d)))
	(while (and (car directive-loop)
		    (let ((f (cond
			      ((string= (downcase (car directive-loop)) "from")
			       from)
			      ((string= (downcase (car directive-loop)) "to")
			       to)
			      ((string= (downcase (car directive-loop))
					"subject") subj)
			      (t (mail-fetch-field (car directive-loop))))))
		      ;; FIXME - shouldn't this ignore case?
		      (and f (string-match (car (cdr directive-loop)) f))))
	  (setq directive-loop (cdr (cdr directive-loop))))
	;; If there are no directives left, then it was a complete match.
	(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))))))