changeset 29160:998506bd35f3

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
author Dave Love <fx@gnu.org>
date Wed, 24 May 2000 16:25:27 +0000
parents c1e86c75dec7
children f80c9b55e44a
files lisp/mail/rmail.el lisp/mail/rmailout.el
diffstat 2 files changed, 73 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/rmail.el	Wed May 24 16:11:35 2000 +0000
+++ b/lisp/mail/rmail.el	Wed May 24 16:25:27 2000 +0000
@@ -268,6 +268,29 @@
   :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 @@
 	     (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 @@
 		  (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."
--- a/lisp/mail/rmailout.el	Wed May 24 16:11:35 2000 +0000
+++ b/lisp/mail/rmailout.el	Wed May 24 16:25:27 2000 +0000
@@ -110,7 +110,7 @@
 ;;; 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 @@
 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 @@
 	  (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