1999-01-23 Eric M. Ludlam <zappo@ultranet.com>

	* rmailout.el (rmail-output-to-rmail-file): Added optional param STAY

	* rmail.el (rmail-automatic-folder-directives): New user variable.
	(rmail-show-message): Add call to `rmail-auto-file' during display.
	(rmail-auto-file): New function

diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index c243994cbe988cd2670f5de2767d4d2d4140067d..4da590d88c87b4cfca642dba291a94d4b3018727 100644 (file)
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -268,6 +268,29 @@ before obeying `rmail-ignored-headers'."
   :group 'rmail-headers
   :type 'function)
 
+(defcustom rmail-automatic-folder-directives nil
+  "List of directives specifying where to put a message.
+Each element of the list is of the form:
+
+  (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )
+
+Where FOLDERNAME is the name of a BABYL format folder to put the
+message.  If any of the field regexp's are nil, then it is ignored.
+
+If FOLDERNAME is \"/dev/null\", it is deleted.
+If FOLDERNAME is nil then it is deleted, and skipped.
+
+FIELD is the plain text name of a field in the message, such as
+\"subject\" or \"from\".  A FIELD of \"to\" will automatically include
+all text from the \"cc\" field as well.
+
+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.")
+  
 (defvar rmail-reply-prefix "Re: "
   "String to prepend to Subject line when replying to a message.")
 
@@ -2228,6 +2251,7 @@ If summary buffer is currently displayed, update current message there also."
             (let ((curr-msg rmail-current-message))
               (rmail-select-summary
                (rmail-summary-goto-msg curr-msg t t))))
+       (rmail-auto-file)
        (if blurb
            (message blurb))))))
 
@@ -2274,6 +2298,42 @@ If summary buffer is currently displayed, update current message there also."
                  (setq rmail-overlay-list
                        (cons overlay rmail-overlay-list))))))))))
 
+(defun rmail-auto-file ()
+  "Automatically move a message into a sub-folder based on criteria.
+Called when a new message is displayed."
+  (if (or (rmail-message-labels-p rmail-current-message "filed")
+         (not (string= (buffer-file-name)
+                       (expand-file-name rmail-file-name))))
+      ;; Do nothing if it's already been filed.
+      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= (car directive-loop) "from") from)
+                             ((string= (car directive-loop) "to") to)
+                             ((string= (car directive-loop) "subject") subj)
+                             (t (mail-fetch-field (car directive-loop))))))
+                     (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-to-rmail-file folder 1 t)
+               (setq d nil))))
+       (setq d (cdr d))))))
+
 (defun rmail-next-message (n)
   "Show following message whether deleted or not.
 With prefix arg N, moves forward N messages, or backward if N is negative."

diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index c9232401133edf10fcbc50a7568ae9daf932d080..3b7ea24fd7495fbe3d23e1f3f9ac7d13f302947d 100644 (file)
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -110,7 +110,7 @@ Set `rmail-default-file' to this name as well as returning it."
 ;;; There are functions elsewhere in Emacs that use this function;
 ;;; look at them before you change the calling method.
 ;;;###autoload
-(defun rmail-output-to-rmail-file (file-name &optional count)
+(defun rmail-output-to-rmail-file (file-name &optional count stay)
   "Append the current message to an Rmail file named FILE-NAME.
 If the file does not exist, ask if it should be created.
 If file is being visited, the message is appended to the Emacs
@@ -122,7 +122,10 @@ The default file name comes from `rmail-default-rmail-file',
 which is updated to the name you use in this command.
 
 A prefix argument N says to output N consecutive messages
-starting with the current one.  Deleted messages are skipped and don't count."
+starting with the current one.  Deleted messages are skipped and don't count.
+
+If optional argument STAY is non-nil, then leave the last filed
+mesasge up instead of moving forward to the next non-deleted message."
   (interactive
    (list (rmail-output-read-rmail-file-name)
         (prefix-numeric-value current-prefix-arg)))
@@ -217,9 +220,15 @@ starting with the current one.  Deleted messages are skipped and don't count."
          (if redelete (rmail-set-attribute "deleted" t))))
       (setq count (1- count))
       (if rmail-delete-after-output
-         (unless (rmail-delete-forward) (setq count 0))
+         (unless 
+             (if (and (= count 0) stay)
+                 (rmail-delete-message)
+               (rmail-delete-forward))
+           (setq count 0))
        (if (> count 0)
-           (unless (rmail-next-undeleted-message 1) (setq count 0)))))))
+           (unless 
+               (if (not stay) (rmail-next-undeleted-message 1))
+             (setq count 0)))))))
 
 ;;;###autoload
 (defcustom rmail-fields-not-to-output nil