]> code.delx.au - gnu-emacs/blobdiff - lisp/mh-e/mh-folder.el
Merge from trunk.
[gnu-emacs] / lisp / mh-e / mh-folder.el
index d9e6c74f3f392907e4099ddbf5ee0c098ef1f0dd..6b5ff3b62e2f20fadd58ba97bd0cb144b1e9da15 100644 (file)
@@ -162,9 +162,9 @@ annotation.")
     ["Go to Last Message"               mh-last-msg t]
     ["Go to Message by Number..."       mh-goto-msg t]
     ["Modify Message"                   mh-modify t]
-    ["Delete Message"                   mh-delete-msg (mh-get-msg-num nil)]
     ["Refile Message"                   mh-refile-msg (mh-get-msg-num nil)]
-    ["Undo Delete/Refile"               mh-undo (mh-outstanding-commands-p)]
+    ["Delete Message"                   mh-delete-msg (mh-get-msg-num nil)]
+    ["Undo Delete/Refile/Junk"          mh-undo (mh-outstanding-commands-p)]
     ["Execute Delete/Refile"            mh-execute-commands
      (mh-outstanding-commands-p)]
     "--"
@@ -405,12 +405,18 @@ See `mh-set-help'.")
    ;; Folders when displaying index buffer
    (list "^\\+.*"
          '(0 'mh-search-folder))
-   ;; Marked for deletion
-   (list (concat mh-scan-deleted-msg-regexp ".*")
-         '(0 'mh-folder-deleted))
    ;; Marked for refile
    (list (concat mh-scan-refiled-msg-regexp ".*")
          '(0 'mh-folder-refiled))
+   ;; Marked for deletion
+   (list (concat mh-scan-deleted-msg-regexp ".*")
+         '(0 'mh-folder-deleted))
+   ;; Marked for blacklisting
+   (list (concat mh-scan-blacklisted-msg-regexp ".*")
+         '(0 'mh-folder-blacklisted))
+   ;; Marked for whitelisting
+   (list (concat mh-scan-whitelisted-msg-regexp ".*")
+         '(0 'mh-folder-whitelisted))
    ;; After subject
    (list mh-scan-body-regexp
          '(1 'mh-folder-body nil t))
@@ -614,8 +620,10 @@ perform the operation on all messages in that region.
    'overlay-arrow-position nil          ; Allow for simultaneous display in
    'overlay-arrow-string ">"            ;  different MH-E buffers.
    'mh-showing-mode nil                 ; Show message also?
-   'mh-delete-list nil                  ; List of msgs nums to delete
    'mh-refile-list nil                  ; List of folder names in mh-seq-list
+   'mh-delete-list nil                  ; List of msgs nums to delete
+   'mh-blacklist nil                    ; List of messages to process as spam
+   'mh-whitelist nil                    ; List of messages to process as ham
    'mh-seq-list nil                     ; Alist of (seq . msgs) nums
    'mh-seen-list nil                    ; List of displayed messages
    'mh-next-direction 'forward          ; Direction to move to next message
@@ -709,15 +717,15 @@ RANGE is read in interactive use."
 
 ;;;###mh-autoload
 (defun mh-execute-commands ()
-  "Process outstanding delete and refile requests\\<mh-folder-mode-map>.
+  "Perform outstanding operations\\<mh-folder-mode-map>.
 
-If you've marked messages to be deleted or refiled and you want
-to go ahead and delete or refile the messages, use this command.
-Many MH-E commands that may affect the numbering of the
-messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder])
-will ask if you want to process refiles or deletes first and then
-either run this command for you or undo the pending refiles and
-deletes.
+If you've marked messages to be refiled, deleted, blacklisted, or
+whitelisted and you want to go ahead and perform these operations
+on these messages, use this command. Many MH-E commands that may
+affect the numbering of the messages (such as
+\\[mh-rescan-folder] or \\[mh-pack-folder]) will ask if you want
+to perform these operations first and then either run this
+command for you or undo the pending operations.
 
 This function runs `mh-before-commands-processed-hook' before the
 commands are processed and `mh-after-commands-processed-hook'
@@ -766,7 +774,7 @@ the message."
     return-value))
 
 ;;;###mh-autoload
-(defun mh-inc-folder (&optional file folder)
+(defun mh-inc-folder (&optional file folder dont-exec-pending)
   "Incorporate new mail into a folder.
 
 You can incorporate mail from any file into the current folder by
@@ -777,7 +785,10 @@ The hook `mh-inc-folder-hook' is run after incorporating new
 mail.
 
 Do not call this function from outside MH-E; use \\[mh-rmail]
-instead."
+instead.
+
+In a program, the processing of outstanding commands is not performed
+if DONT-EXEC-PENDING is non-nil."
   (interactive (list (if current-prefix-arg
                          (expand-file-name
                           (read-file-name "inc mail from file: "
@@ -786,6 +797,8 @@ instead."
                          (mh-prompt-for-folder "inc mail into" mh-inbox t))))
   (if (not folder)
       (setq folder mh-inbox))
+  (unless dont-exec-pending
+    (mh-process-or-undo-commands folder))
   (let ((threading-needed-flag nil))
     (let ((config (current-window-configuration)))
       (when (and mh-show-buffer (get-buffer mh-show-buffer))
@@ -1181,14 +1194,18 @@ RANGE is read in interactive use."
   (cond ((numberp range)
          (let ((original-position (point)))
            (beginning-of-line)
-           (while (not (or (looking-at mh-scan-deleted-msg-regexp)
-                           (looking-at mh-scan-refiled-msg-regexp)
+           (while (not (or (looking-at mh-scan-refiled-msg-regexp)
+                           (looking-at mh-scan-deleted-msg-regexp)
+                           (looking-at mh-scan-blacklisted-msg-regexp)
+                           (looking-at mh-scan-whitelisted-msg-regexp)
                            (and (eq mh-next-direction 'forward) (bobp))
                            (and (eq mh-next-direction 'backward)
                                 (save-excursion (forward-line) (eobp)))))
              (forward-line (if (eq mh-next-direction 'forward) -1 1)))
-           (if (or (looking-at mh-scan-deleted-msg-regexp)
-                   (looking-at mh-scan-refiled-msg-regexp))
+           (if (or (looking-at mh-scan-refiled-msg-regexp)
+                   (looking-at mh-scan-deleted-msg-regexp)
+                   (looking-at mh-scan-blacklisted-msg-regexp)
+                   (looking-at mh-scan-whitelisted-msg-regexp))
                (progn
                  (mh-undo-msg (mh-get-msg-num t))
                  (mh-maybe-show))
@@ -1520,7 +1537,7 @@ is updated."
   (save-excursion
     (when (eq major-mode 'mh-show-mode)
       (set-buffer mh-show-folder-buffer))
-    (or mh-delete-list mh-refile-list)))
+    (or mh-delete-list mh-refile-list mh-blacklist mh-whitelist)))
 
 ;;;###mh-autoload
 (defun mh-set-folder-modified-p (flag)
@@ -1544,10 +1561,15 @@ after the commands are processed."
 
     (let ((redraw-needed-flag mh-index-data)
           (folders-changed (list mh-current-folder))
-          (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
-                        (mh-create-sequence-map mh-seq-list)))
+          (seq-map (and
+                    (or (and mh-refile-list mh-refile-preserves-sequences-flag)
+                        (and mh-whitelist
+                             mh-whitelist-preserves-sequences-flag))
+                    (mh-create-sequence-map mh-seq-list)))
           (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
-                         (make-hash-table))))
+                         (make-hash-table)))
+          (white-map (and mh-whitelist mh-whitelist-preserves-sequences-flag
+                          (make-hash-table))))
       ;; Remove invalid scan lines if we are in an index folder and then remove
       ;; the real messages
       (when mh-index-data
@@ -1594,6 +1616,49 @@ after the commands are processed."
              (mh-delete-scan-msgs mh-delete-list)
              (setq mh-delete-list nil)))
 
+      ;; Blacklist messages.
+      (when mh-blacklist
+        (let ((msg-list (mh-coalesce-msg-list mh-blacklist))
+              (dest (mh-junk-blacklist-disposition)))
+          (mh-junk-process-blacklist mh-blacklist)
+          ;; TODO I wonder why mh-exec-cmd is used instead of the following:
+          ;; (mh-refile-a-msg nil (intern dest))
+          ;; (mh-delete-a-msg nil)))
+          (if (null dest)
+              (apply 'mh-exec-cmd "rmm" folder msg-list)
+            (apply 'mh-exec-cmd "refile" "-src" folder dest msg-list)
+            (push dest folders-changed))
+          (setq redraw-needed-flag t)
+          (mh-delete-scan-msgs mh-blacklist)
+          (setq mh-blacklist nil)))
+
+      ;; Whitelist messages.
+      (when mh-whitelist
+        (let ((msg-list (mh-coalesce-msg-list mh-whitelist))
+              (last (car (mh-translate-range mh-inbox "last"))))
+          (mh-junk-process-whitelist mh-whitelist)
+          (apply #'mh-exec-cmd "refile" "-src" folder mh-inbox msg-list)
+          (push mh-inbox folders-changed)
+          (setq redraw-needed-flag t)
+          (mh-delete-scan-msgs mh-whitelist)
+          (when mh-whitelist-preserves-sequences-flag
+            (clrhash white-map)
+            (loop for i from (1+ (or last 0))
+                  for msg in (sort (copy-sequence mh-whitelist) #'<)
+                  do (loop for seq-name in (gethash msg seq-map)
+                           do (push i (gethash seq-name white-map))))
+            (maphash
+             #'(lambda (seq msgs)
+                 ;; Can't be run in background, since the current
+                 ;; folder is changed by mark this could lead to a
+                 ;; race condition with the next refile/whitelist.
+                 (apply #'mh-exec-cmd "mark"
+                        "-sequence" (symbol-name seq) mh-inbox
+                        "-add" (mapcar #'(lambda(x) (format "%s" x))
+                                       (mh-coalesce-msg-list msgs))))
+             white-map))
+          (setq mh-whitelist nil)))
+
       ;; Don't need to remove sequences since delete and refile do so.
       ;; Mark cur message
       (if (> (buffer-size) 0)
@@ -1904,6 +1969,10 @@ once when he kept statistics on his mail usage."
       (setq message (mh-get-msg-num t)))
     (if (looking-at mh-scan-refiled-msg-regexp)
         (error "Message %d is refiled; undo refile before deleting" message))
+    (if (looking-at mh-scan-blacklisted-msg-regexp)
+        (error "Message %d is blacklisted; undo before deleting" message))
+    (if (looking-at mh-scan-whitelisted-msg-regexp)
+        (error "Message %d is whitelisted; undo before deleting" message))
     (if (looking-at mh-scan-deleted-msg-regexp)
         nil
       (mh-set-folder-modified-p t)
@@ -1925,6 +1994,10 @@ be refiled."
       (setq message (mh-get-msg-num t)))
     (cond ((looking-at mh-scan-deleted-msg-regexp)
            (error "Message %d is deleted; undo delete before moving" message))
+          ((looking-at mh-scan-blacklisted-msg-regexp)
+           (error "Message %d is blacklisted; undo before moving" message))
+          ((looking-at mh-scan-whitelisted-msg-regexp)
+           (error "Message %d is whitelisted; undo before moving" message))
           ((looking-at mh-scan-refiled-msg-regexp)
            (if (y-or-n-p
                 (format "Message %d already refiled; copy to %s as well? "
@@ -1943,7 +2016,7 @@ be refiled."
            (run-hooks 'mh-refile-msg-hook)))))
 
 (defun mh-undo-msg (msg)
-  "Undo the deletion or refile of one MSG.
+  "Undo the deletion, refile, black- or whitelisting of one MSG.
 If MSG is nil then act on the message at point"
   (save-excursion
     (if (numberp msg)
@@ -1952,6 +2025,10 @@ If MSG is nil then act on the message at point"
       (setq msg (mh-get-msg-num t)))
     (cond ((memq msg mh-delete-list)
            (setq mh-delete-list (delq msg mh-delete-list)))
+          ((memq msg mh-blacklist)
+           (setq mh-blacklist (delq msg mh-blacklist)))
+          ((memq msg mh-whitelist)
+           (setq mh-whitelist (delq msg mh-whitelist)))
           (t
            (dolist (folder-msg-list mh-refile-list)
              (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))