;; get-new-mail-for-spam-filter.el ;; version 1.0e, March 25 2004. ;; ;; modified versions of the rmail functions rmail-only-expunge and ;; rmail-get-new-mail that work with rmail-spam-filter for emacs ;; versions 21.3 and below ;; Eli Tziperman (eli@eps.harvard.edu), Bernd Kiefer (kiefer@dfki.de) (defun rmail-get-new-mail (&optional file-name) "Move any new mail from this RMAIL file's inbox files. The inbox files can be specified with the file's Mail: option. The variable `rmail-primary-inbox-list' specifies the inboxes for your primary RMAIL file if it has no Mail: option. By default, this is your /usr/spool/mail/$USER. You can also specify the file to get new mail from. In this case, the file of new mail is not changed or deleted. Noninteractively, you can pass the inbox file name as an argument. Interactively, a prefix argument causes us to read a file name and use that file as the inbox. If the variable `rmail-preserve-inbox' is non-nil, new mail will always be left in inbox files rather than deleted. This function runs `rmail-get-new-mail-hook' before saving the updated file. It returns t if it got any new messages. If `rmail-use-spam-filter' is non-nil, the spam-filtering actions specified by `rsf-definitions-alist' will be carried out on the new messages. Then, it may expunge the messages marked for deleting as spam. It prompts the user before deleting if `rmail-expunge-confirmed' is set, otherwise the deletion is automatic. The deletion involves only messages marked as spam by this invocation; messages previously marked for deletion will not be deleted (though they will remain marked for deletion)." (interactive (list (if current-prefix-arg (read-file-name "Get new mail from file: ")))) (run-hooks 'rmail-before-get-new-mail-hook) ;; If the disk file has been changed from under us, ;; revert to it before we get new mail. (or (verify-visited-file-modtime (current-buffer)) (find-file (buffer-file-name))) (set-buffer rmail-buffer) (rmail-maybe-set-message-counters) (widen) ;; Get rid of all undo records for this buffer. (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) (let ((all-files (if file-name (list file-name) rmail-inbox-list)) (rmail-enable-multibyte (default-value 'enable-multibyte-characters)) found) (unwind-protect (progn (while all-files (let ((opoint (point)) (new-messages 0) (rsf-spam-no 0) (delete-files ()) ;; If buffer has not changed yet, and has not been saved yet, ;; don't replace the old backup file now. (make-backup-files (and make-backup-files (buffer-modified-p))) (buffer-read-only nil) ;; Don't make undo records for what we do in getting mail. (buffer-undo-list t) success ;; Files to insert this time around. files ;; Last names of those files. file-last-names) ;; Pull files off all-files onto files ;; as long as there is no name conflict. ;; A conflict happens when two inbox file names ;; have the same last component. (while (and all-files (not (member (file-name-nondirectory (car all-files)) file-last-names))) (setq files (cons (car all-files) files) file-last-names (cons (file-name-nondirectory (car all-files)) files)) (setq all-files (cdr all-files))) ;; Put them back in their original order. (setq files (nreverse files)) (goto-char (point-max)) (skip-chars-backward " \t\n") ; just in case of brain damage (delete-region (point) (point-max)) ; caused by require-final-newline (save-excursion (save-restriction (narrow-to-region (point) (point)) ;; Read in the contents of the inbox files, ;; renaming them as necessary, ;; and adding to the list of files to delete eventually. (if file-name (rmail-insert-inbox-text files nil) (setq delete-files (rmail-insert-inbox-text files t))) ;; Scan the new text and convert each message to babyl format. (goto-char (point-min)) (unwind-protect (save-excursion (setq new-messages (rmail-convert-to-babyl-format) success t)) ;; Try to delete the garbage just inserted. (or success (delete-region (point-min) (point-max))) ;; If we could not convert the file's inboxes, ;; rename the files we tried to read ;; so we won't over and over again. (if (and (not file-name) (not success)) (let ((delfiles delete-files) (count 0)) (while delfiles (while (file-exists-p (format "RMAILOSE.%d" count)) (setq count (1+ count))) (rename-file (car delfiles) (format "RMAILOSE.%d" count)) (setq delfiles (cdr delfiles)))))) (or (zerop new-messages) (let (success) (widen) (search-backward "\n\^_" nil t) (narrow-to-region (point) (point-max)) (goto-char (1+ (point-min))) (rmail-count-new-messages) (run-hooks 'rmail-get-new-mail-hook) (save-buffer))) ;; Delete the old files, now that babyl file is saved. (while delete-files (condition-case () ;; First, try deleting. (condition-case () (delete-file (car delete-files)) (file-error ;; If we can't delete it, truncate it. (write-region (point) (point) (car delete-files)))) (file-error nil)) (setq delete-files (cdr delete-files))))) (if (= new-messages 0) (progn (goto-char opoint) (if (or file-name rmail-inbox-list) (message "(No new mail has arrived)"))) ;; check new messages to see if any of them are spam: (if rmail-use-spam-filter (let* ((old-messages (- rmail-total-messages new-messages)) (rsf-scanned-number (1+ old-messages)) ;; Make sure the spam file is in a buffer so that ;; rmail-output-to-rmail-file does not save it after ;; outputting each spam message. ;; Since rsf-file is an Rmail file, find-file will ;; run rmail on it. ;; The buffer of the spam file. (spam-file-buffer (find-file-noselect rsf-file))) (while (<= rsf-scanned-number rmail-total-messages) (progn (if (not (rmail-spam-filter rsf-scanned-number)) (setq rsf-spam-no (1+ rsf-spam-no))) (setq rsf-scanned-number (1+ rsf-scanned-number)) )) (if (> rsf-spam-no 0) ;; expunge only new deleted messages that were ;; marked by the spam filter and don't show the ;; current message (we do this later) (when (rmail-expunge-confirmed) (rmail-only-expunge (1+ old-messages) t))) ;; Save the rmail file again, since we may have deleted or ;; edited the messages, and save the spam file. ;; Save the spam file first, so the spam messages ;; can't be lost, as they could if we saved the rmail ;; file first and then Emacs crashed before we saved ;; the spam file. ;; If one of these files has not been modified, ;; save-buffer will not write it to disk, so there is no ;; wasted effort. (save-excursion (set-buffer spam-file-buffer) (save-buffer)) (save-buffer) )) (message "%d new message%s read%s" new-messages (if (= 1 new-messages) "" "s") ;; print a message on number of spam messages found: (if (= rsf-spam-no 0) "" (if (= 1 new-messages) (format ", and found to be a spam message!") (if (= rsf-spam-no 1) (format ", one of which found to be a spam message!") (format ", %d of which found to be spam messages!" rsf-spam-no))))) (if (and rmail-use-spam-filter (> rsf-spam-no 0)) (progn (if rsf-beep (beep t)) (sleep-for rsf-sleep-after-message))) ;; Move to the first new message ;; unless we have other unseen messages before it. (rmail-show-message (rmail-first-unseen-message)) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))) (run-hooks 'rmail-after-get-new-mail-hook) (setq found t)))) found) ;; Don't leave the buffer screwed up if we get a disk-full error. (or found (rmail-show-message))))) (defun rmail-only-expunge (&optional from dont-show) "Actually erase deleted messages in the file, starting at message FROM. If FROM is nil, erases all deleted messages. If DONT-SHOW is nil, `rmail-show-message' will be called at the end of processing." (interactive) (set-buffer rmail-buffer) (message "Expunging deleted messages...") ;; if from is not set, start expunging at the first message (if (not from) (setq from 1)) ;; Discard all undo records for this buffer. (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) (rmail-maybe-set-message-counters) (let* ((omax (- (buffer-size) (point-max))) (omin (- (buffer-size) (point-min))) (opoint (if (and (> rmail-current-message 0) (rmail-message-deleted-p rmail-current-message)) 0 (if rmail-enable-mime (with-current-buffer rmail-view-buffer (- (point)(point-min))) (- (point) (point-min))))) (messages-head (cons (aref rmail-message-vector 0) nil)) (messages-tail messages-head) ;; Don't make any undo records for the expunging. (buffer-undo-list t) (win)) (unwind-protect (save-excursion (widen) (goto-char (point-min)) (let ((counter 0) (number 1) (total rmail-total-messages) (new-message-number rmail-current-message) (new-summary nil) (new-msgref (list (list 0))) (rmailbuf (current-buffer)) (buffer-read-only nil) (messages rmail-message-vector) (deleted rmail-deleted-vector) (summary rmail-summary-vector)) (setq rmail-total-messages nil rmail-current-message nil rmail-message-vector nil rmail-deleted-vector nil rmail-summary-vector nil) (while (<= number total) (if (and (>= number from) (= (aref deleted number) ?D)) (progn (delete-region (marker-position (aref messages number)) (marker-position (aref messages (1+ number)))) (move-marker (aref messages number) nil) (if (> new-message-number counter) (setq new-message-number (1- new-message-number)))) (setq counter (1+ counter)) (setq messages-tail (setcdr messages-tail (cons (aref messages number) nil))) (setq new-summary (cons (if (= counter number) (aref summary (1- number))) new-summary)) (setq new-msgref (cons (aref rmail-msgref-vector number) new-msgref)) (setcar (car new-msgref) counter)) (if (zerop (% (setq number (1+ number)) 20)) (message "Expunging deleted messages...%d" number))) (setq messages-tail (setcdr messages-tail (cons (aref messages number) nil))) (setq rmail-current-message new-message-number rmail-total-messages counter rmail-message-vector (apply 'vector messages-head) ;; keep the first FROM deletion markers rmail-deleted-vector (concat (substring deleted 0 from) (make-string (- counter (1- from)) ?\ )) rmail-summary-vector (vconcat (nreverse new-summary)) rmail-msgref-vector (apply 'vector (nreverse new-msgref)) win t))) (message "Expunging deleted messages...done") (if (not win) (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) (if (not dont-show) (rmail-show-message (if (zerop rmail-current-message) 1 nil)) (if rmail-enable-mime (goto-char (+ (point-min) opoint)) (goto-char (+ (point) opoint)))))))