diff lisp/mh-e/mh-index.el @ 50702:7dd3d5eae9c7

Upgraded to MH-E version 7.3. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.

--- a/lisp/mh-e/mh-index.el	Fri Apr 25 04:32:25 2003 +0000
+++ b/lisp/mh-e/mh-index.el	Fri Apr 25 05:52:00 2003 +0000
@@ -1,6 +1,6 @@
 ;;; mh-index  --  MH-E interface to indexing programs
 
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
 
 ;; Author: Satyaki Das <[e-mail]>
 ;; Maintainer: Bill Wohler <[e-mail]>
@@ -29,6 +29,7 @@
 ;;;  (1) The following search engines are supported:
 ;;;        swish++
 ;;;        swish-e
+;;;        mairix
 ;;;        namazu
 ;;;        glimpse
 ;;;        grep
@@ -40,8 +41,6 @@
 
 ;;; Change Log:
 
-;; $Id: mh-index.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
-
 ;;; Code:
 
 (require 'cl)
@@ -165,21 +164,22 @@
 will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
 strings to it. This is repeated till all the strings have been used."
   (goto-char (point-min))
-  (let ((out (get-buffer-create " *mh-xargs-output*")))
-    (save-excursion
-      (set-buffer out)
-      (erase-buffer))
-    (while (not (eobp))
-      (let ((arg-list (reverse args))
-            (count 0))
-        (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
-          (push (buffer-substring-no-properties (point) (line-end-position))
-                arg-list)
-          (incf count)
-          (forward-line))
-        (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
-    (erase-buffer)
-    (insert-buffer-substring out)))
+  (let ((current-buffer (current-buffer)))
+    (with-temp-buffer
+      (let ((out (current-buffer)))
+        (set-buffer current-buffer)
+        (while (not (eobp))
+          (let ((arg-list (reverse args))
+                (count 0))
+            (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
+              (push (buffer-substring-no-properties (point) (line-end-position))
+                    arg-list)
+              (incf count)
+              (forward-line))
+            (apply #'call-process cmd nil (list out nil) nil
+                   (nreverse arg-list))))
+        (erase-buffer)
+        (insert-buffer-substring out)))))
 
 
 
@@ -230,7 +230,8 @@
                      (point) (line-end-position)))
           (forward-line)
           (save-excursion
-            (cond ((eolp)
+            (cond ((not (string-match "^[0-9]*$" msg)))
+                  ((eolp)
                    ;; need to compute checksum
                    (set-buffer mh-checksum-buffer)
                    (insert mh-user-path (substring folder 1) "/" msg "\n"))
@@ -260,6 +261,9 @@
               (mh-index-update-single-msg msg checksum origin-map)))
           (forward-line))))))
 
+(defvar mh-flists-results-folder "new"
+  "Subfolder for `mh-index-folder' where flists output is placed.")
+
 (defun mh-index-generate-pretty-name (string)
   "Given STRING generate a name which is suitable for use as a folder name.
 White space from the beginning and end are removed. All spaces in the name are
@@ -288,19 +292,24 @@
     (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
     (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
     (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
-    (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
+    (let ((out (truncate-string-to-width (buffer-string) 20)))
+      (cond ((eq mh-indexer 'flists) mh-flists-results-folder)
+            ((equal out mh-flists-results-folder) (concat out "1"))
+            (t out)))))
 
 ;;;###mh-autoload
 (defun* mh-index-search (redo-search-flag folder search-regexp
-                        &optional window-config)
+                        &optional window-config unseen-flag)
   "Perform an indexed search in an MH mail folder.
+Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
 
 If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
 index search, then the search is repeated. Otherwise, FOLDER is searched with
 SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
 \"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
 stores the window configuration that will be restored after the user quits the
-folder containing the index search results.
+folder containing the index search results. If optional argument UNSEEN-FLAG
+is non-nil, then all the messages are marked as unseen.
 
 Four indexing programs are supported; if none of these are present, then grep
 is used. This function picks the first program that is available on your
@@ -381,7 +390,7 @@
       (message "Processing %s output... " mh-indexer)
       (goto-char (point-min))
       (loop for next-result = (funcall mh-index-next-result-function)
-            when (null next-result) return nil
+            while next-result
             do (unless (eq next-result 'error)
                  (unless (gethash (car next-result) folder-results-map)
                    (setf (gethash (car next-result) folder-results-map)
@@ -403,9 +412,13 @@
                                  (cons folder msg)))))
                folder-results-map)
 
+      ;; Mark messages as unseen (if needed)
+      (when (and unseen-flag (> result-count 0))
+        (mh-exec-cmd "mark" index-folder "all"
+                     "-sequence" (symbol-name mh-unseen-seq) "-add"))
+
       ;; Generate scan lines for the hits.
-      (let ((mh-show-threads-flag nil))
-        (mh-visit-folder index-folder () (list folder-results-map origin-map)))
+      (mh-visit-folder index-folder () (list folder-results-map origin-map))
 
       (goto-char (point-min))
       (forward-line)
@@ -548,9 +561,8 @@
 With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
 results."
   (interactive "P")
-  (if (or (null mh-index-data)
-          (memq 'unthread mh-view-ops))
-      (message "Only applicable in an unthreaded MH-E index search buffer")
+  (if (null mh-index-data)
+      (message "Only applicable in an MH-E index search buffer")
     (let ((point (point)))
       (forward-line (if backward-flag -1 1))
       (cond ((if backward-flag
@@ -628,6 +640,22 @@
     (set-buffer-modified-p old-buffer-modified-flag)))
 
 ;;;###mh-autoload
+(defun mh-index-group-by-folder ()
+  "Partition the messages based on source folder.
+Returns an alist with the the folder names in the car and the cdr being the
+list of messages originally from that folder."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((result-table (make-hash-table)))
+      (loop for msg being hash-keys of mh-index-msg-checksum-map
+            do (push msg (gethash (car (gethash
+                                        (gethash msg mh-index-msg-checksum-map)
+                                        mh-index-checksum-origin-map))
+                                  result-table)))
+      (loop for x being the hash-keys of result-table
+            collect (cons x (nreverse (gethash x result-table)))))))
+
+;;;###mh-autoload
 (defun mh-index-delete-folder-headers ()
   "Delete the folder headers."
   (let ((cur-msg (mh-get-msg-num nil))
@@ -662,9 +690,28 @@
     (when (not folder)
       (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
                                  mh-index-checksum-origin-map))))
-    (mh-visit-folder
-     folder (loop for x being the hash-keys of (gethash folder mh-index-data)
-                  when (mh-msg-exists-p x folder) collect x))))
+    (when (or (not (get-buffer folder))
+              (y-or-n-p (format "Reuse buffer displaying %s? " folder)))
+      (mh-visit-folder
+       folder (loop for x being the hash-keys of (gethash folder mh-index-data)
+                    when (mh-msg-exists-p x folder) collect x)))))
+
+;;;###mh-autoload
+(defun mh-index-update-unseen (msg)
+  "Remove counterpart of MSG in source folder from `mh-unseen-seq'.
+Also `mh-update-unseen' is called in the original folder, if we have it open."
+  (let* ((checksum (gethash msg mh-index-msg-checksum-map))
+         (folder-msg-pair (gethash checksum mh-index-checksum-origin-map))
+         (orig-folder (car folder-msg-pair))
+         (orig-msg (cdr folder-msg-pair)))
+    (when (mh-index-match-checksum orig-msg orig-folder checksum)
+      (when (get-buffer orig-folder)
+        (save-excursion
+          (set-buffer orig-folder)
+          (unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))
+          (mh-update-unseen)))
+      (mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)
+                          "-sequence" (symbol-name mh-unseen-seq) "-del"))))
 
 (defun mh-index-match-checksum (msg folder checksum)
   "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
@@ -918,7 +965,7 @@
         (when (or (eobp) (and (bolp) (eolp)))
           (return nil))
         (unless (eq (char-after) ?/)
-          (return error))
+          (return 'error))
         (let ((start (point))
               end msg-start)
           (setq end (line-end-position))
@@ -1000,6 +1047,68 @@
 
 
 
+;; Interface to unseen messages script
+
+(defvar mh-flists-search-folders)
+
+(defun mh-flists-execute (&rest args)
+  "Search for unseen messages in `mh-flists-search-folders'.
+If `mh-recursive-folders-flag' is t, then the folders are searched
+recursively. All parameters ARGS are ignored."
+  (set-buffer (get-buffer-create mh-index-temp-buffer))
+  (erase-buffer)
+  (unless (executable-find "sh")
+    (error "Didn't find sh"))
+  (with-temp-buffer
+    (let ((unseen (symbol-name mh-unseen-seq)))
+      (insert "for folder in `flists "
+              (cond ((eq mh-flists-search-folders t) mh-inbox)
+                    ((eq mh-flists-search-folders nil) "")
+                    ((listp mh-flists-search-folders)
+                     (loop for folder in mh-flists-search-folders
+                           concat (concat " " folder))))
+              (if mh-recursive-folders-flag " -recurse" "")
+              " -sequence " unseen " -noshowzero -fast` ; do\n"
+              "mhpath \"+$folder\" " unseen "\n" "done\n"))
+    (call-process-region
+     (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer))))
+
+;;;###mh-autoload
+(defun mh-index-new-messages (folders)
+  "Display new messages.
+All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed.
+By default the folders specified by `mh-index-new-messages-folders' are
+searched. With a prefix argument, enter a space-separated list of folders, or
+nothing to search all folders."
+  (interactive
+   (list (if current-prefix-arg
+             (split-string (read-string "Folders to search: "))
+           mh-index-new-messages-folders)))
+  (let* ((mh-flists-search-folders folders)
+         (mh-indexer 'flists)
+         (mh-index-execute-search-function 'mh-flists-execute)
+         (mh-index-next-result-function 'mh-mairix-next-result)
+         (mh-mairix-folder mh-user-path)
+         (mh-index-regexp-builder nil)
+         (new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder))
+         (window-config (if (equal new-folder mh-current-folder)
+                            mh-previous-window-config
+                          (current-window-configuration)))
+         (redo-flag nil))
+    (cond ((buffer-live-p (get-buffer new-folder))
+           ;; The destination folder is being visited. Trick `mh-index-search'
+           ;; into thinking that the folder was the result of a previous search.
+           (set-buffer new-folder)
+           (setq mh-index-previous-search (list "+" mh-flists-results-folder))
+           (setq redo-flag t))
+          ((mh-folder-exists-p new-folder)
+           ;; Folder exists but we don't have it open. That means they are
+           ;; stale results from a old flists search. Clear it out.
+           (mh-exec-cmd-quiet nil "rmf" new-folder)))
+    (mh-index-search redo-flag "+" mh-flists-results-folder window-config t)))
+
+
+
 ;; Swish interface
 
 (defvar mh-swish-binary (executable-find "swish-e"))
@@ -1163,7 +1272,7 @@
 (defun mh-swish++-regexp-builder (regexp-list)
   "Generate query for swish++.
 REGEXP-LIST is an alist of fields and values."
-  (let ((regexp "") meta)
+  (let ((regexp ""))
     (dolist (elem regexp-list)
       (when (cdr elem)
         (setq regexp (concat regexp " and "
@@ -1264,6 +1373,7 @@
 
 
 
+;;;###mh-autoload
 (defun mh-index-choose ()
   "Choose an indexing function.
 The side-effects of this function are that the variables `mh-indexer',