summaryrefslogtreecommitdiff
path: root/lisp/mh-e/mh-index.el
diff options
context:
space:
mode:
authorBill Wohler <wohler@newt.com>2003-04-25 05:52:00 +0000
committerBill Wohler <wohler@newt.com>2003-04-25 05:52:00 +0000
commit0d89d329659b138be765458b02de54963eeec501 (patch)
tree2ee786bed8074815d6ee5da39c23d191b19e8299 /lisp/mh-e/mh-index.el
parenta880674e9dbaeb2f8717df0eed9089fe0b9f6de9 (diff)
downloademacs-0d89d329659b138be765458b02de54963eeec501.tar.gz
Upgraded to MH-E version 7.3.
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
Diffstat (limited to 'lisp/mh-e/mh-index.el')
-rw-r--r--lisp/mh-e/mh-index.el176
1 files changed, 143 insertions, 33 deletions
diff --git a/lisp/mh-e/mh-index.el b/lisp/mh-e/mh-index.el
index a9da26953de..1d136469ec9 100644
--- a/lisp/mh-e/mh-index.el
+++ b/lisp/mh-e/mh-index.el
@@ -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 <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -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 @@ The current buffer contains a list of strings, one on each line. The function
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 @@ checksum -> (origin-folder, origin-index) map is updated too."
(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 @@ checksum -> (origin-folder, origin-index) map is updated too."
(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 @@ they are concatenated to construct the base name."
(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 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(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 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(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 @@ The function is only applicable to folders displaying index search results.
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 @@ we find a new folder name."
(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 @@ we find a new folder name."
(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 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP-LIST is used to search."
(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 @@ REGEXP-LIST is an alist of fields and values."
+;; 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 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
(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 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+;;;###mh-autoload
(defun mh-index-choose ()
"Choose an indexing function.
The side-effects of this function are that the variables `mh-indexer',