1 |
;;; mh-index -- MH-E interface to indexing programs |
;;; mh-index -- MH-E interface to indexing programs |
2 |
|
|
3 |
;; Copyright (C) 2002 Free Software Foundation, Inc. |
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
6 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
29 |
;;; (1) The following search engines are supported: |
;;; (1) The following search engines are supported: |
30 |
;;; swish++ |
;;; swish++ |
31 |
;;; swish-e |
;;; swish-e |
32 |
|
;;; mairix |
33 |
;;; namazu |
;;; namazu |
34 |
;;; glimpse |
;;; glimpse |
35 |
;;; grep |
;;; grep |
41 |
|
|
42 |
;;; Change Log: |
;;; Change Log: |
43 |
|
|
|
;; $Id$ |
|
|
|
|
44 |
;;; Code: |
;;; Code: |
45 |
|
|
46 |
(require 'cl) |
(require 'cl) |
164 |
will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args' |
will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args' |
165 |
strings to it. This is repeated till all the strings have been used." |
strings to it. This is repeated till all the strings have been used." |
166 |
(goto-char (point-min)) |
(goto-char (point-min)) |
167 |
(let ((out (get-buffer-create " *mh-xargs-output*"))) |
(let ((current-buffer (current-buffer))) |
168 |
(save-excursion |
(with-temp-buffer |
169 |
(set-buffer out) |
(let ((out (current-buffer))) |
170 |
(erase-buffer)) |
(set-buffer current-buffer) |
171 |
(while (not (eobp)) |
(while (not (eobp)) |
172 |
(let ((arg-list (reverse args)) |
(let ((arg-list (reverse args)) |
173 |
(count 0)) |
(count 0)) |
174 |
(while (and (not (eobp)) (< count mh-index-max-cmdline-args)) |
(while (and (not (eobp)) (< count mh-index-max-cmdline-args)) |
175 |
(push (buffer-substring-no-properties (point) (line-end-position)) |
(push (buffer-substring-no-properties (point) (line-end-position)) |
176 |
arg-list) |
arg-list) |
177 |
(incf count) |
(incf count) |
178 |
(forward-line)) |
(forward-line)) |
179 |
(apply #'call-process cmd nil (list out nil) nil (nreverse arg-list)))) |
(apply #'call-process cmd nil (list out nil) nil |
180 |
(erase-buffer) |
(nreverse arg-list)))) |
181 |
(insert-buffer-substring out))) |
(erase-buffer) |
182 |
|
(insert-buffer-substring out))))) |
183 |
|
|
184 |
|
|
185 |
|
|
230 |
(point) (line-end-position))) |
(point) (line-end-position))) |
231 |
(forward-line) |
(forward-line) |
232 |
(save-excursion |
(save-excursion |
233 |
(cond ((eolp) |
(cond ((not (string-match "^[0-9]*$" msg))) |
234 |
|
((eolp) |
235 |
;; need to compute checksum |
;; need to compute checksum |
236 |
(set-buffer mh-checksum-buffer) |
(set-buffer mh-checksum-buffer) |
237 |
(insert mh-user-path (substring folder 1) "/" msg "\n")) |
(insert mh-user-path (substring folder 1) "/" msg "\n")) |
261 |
(mh-index-update-single-msg msg checksum origin-map))) |
(mh-index-update-single-msg msg checksum origin-map))) |
262 |
(forward-line)))))) |
(forward-line)))))) |
263 |
|
|
264 |
|
(defvar mh-flists-results-folder "new" |
265 |
|
"Subfolder for `mh-index-folder' where flists output is placed.") |
266 |
|
|
267 |
(defun mh-index-generate-pretty-name (string) |
(defun mh-index-generate-pretty-name (string) |
268 |
"Given STRING generate a name which is suitable for use as a folder name. |
"Given STRING generate a name which is suitable for use as a folder name. |
269 |
White space from the beginning and end are removed. All spaces in the name are |
White space from the beginning and end are removed. All spaces in the name are |
292 |
(subst-char-in-region (point-min) (point-max) ?\n ?_ t) |
(subst-char-in-region (point-min) (point-max) ?\n ?_ t) |
293 |
(subst-char-in-region (point-min) (point-max) ?\r ?_ t) |
(subst-char-in-region (point-min) (point-max) ?\r ?_ t) |
294 |
(subst-char-in-region (point-min) (point-max) ?/ ?$ t) |
(subst-char-in-region (point-min) (point-max) ?/ ?$ t) |
295 |
(truncate-string-to-width (buffer-substring (point-min) (point-max)) 20))) |
(let ((out (truncate-string-to-width (buffer-string) 20))) |
296 |
|
(cond ((eq mh-indexer 'flists) mh-flists-results-folder) |
297 |
|
((equal out mh-flists-results-folder) (concat out "1")) |
298 |
|
(t out))))) |
299 |
|
|
300 |
;;;###mh-autoload |
;;;###mh-autoload |
301 |
(defun* mh-index-search (redo-search-flag folder search-regexp |
(defun* mh-index-search (redo-search-flag folder search-regexp |
302 |
&optional window-config) |
&optional window-config unseen-flag) |
303 |
"Perform an indexed search in an MH mail folder. |
"Perform an indexed search in an MH mail folder. |
304 |
|
Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. |
305 |
|
|
306 |
If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a |
If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a |
307 |
index search, then the search is repeated. Otherwise, FOLDER is searched with |
index search, then the search is repeated. Otherwise, FOLDER is searched with |
308 |
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is |
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is |
309 |
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG |
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG |
310 |
stores the window configuration that will be restored after the user quits the |
stores the window configuration that will be restored after the user quits the |
311 |
folder containing the index search results. |
folder containing the index search results. If optional argument UNSEEN-FLAG |
312 |
|
is non-nil, then all the messages are marked as unseen. |
313 |
|
|
314 |
Four indexing programs are supported; if none of these are present, then grep |
Four indexing programs are supported; if none of these are present, then grep |
315 |
is used. This function picks the first program that is available on your |
is used. This function picks the first program that is available on your |
390 |
(message "Processing %s output... " mh-indexer) |
(message "Processing %s output... " mh-indexer) |
391 |
(goto-char (point-min)) |
(goto-char (point-min)) |
392 |
(loop for next-result = (funcall mh-index-next-result-function) |
(loop for next-result = (funcall mh-index-next-result-function) |
393 |
when (null next-result) return nil |
while next-result |
394 |
do (unless (eq next-result 'error) |
do (unless (eq next-result 'error) |
395 |
(unless (gethash (car next-result) folder-results-map) |
(unless (gethash (car next-result) folder-results-map) |
396 |
(setf (gethash (car next-result) folder-results-map) |
(setf (gethash (car next-result) folder-results-map) |
412 |
(cons folder msg))))) |
(cons folder msg))))) |
413 |
folder-results-map) |
folder-results-map) |
414 |
|
|
415 |
|
;; Mark messages as unseen (if needed) |
416 |
|
(when (and unseen-flag (> result-count 0)) |
417 |
|
(mh-exec-cmd "mark" index-folder "all" |
418 |
|
"-sequence" (symbol-name mh-unseen-seq) "-add")) |
419 |
|
|
420 |
;; Generate scan lines for the hits. |
;; Generate scan lines for the hits. |
421 |
(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))) |
|
422 |
|
|
423 |
(goto-char (point-min)) |
(goto-char (point-min)) |
424 |
(forward-line) |
(forward-line) |
561 |
With non-nil optional argument BACKWARD-FLAG, jump to the previous group of |
With non-nil optional argument BACKWARD-FLAG, jump to the previous group of |
562 |
results." |
results." |
563 |
(interactive "P") |
(interactive "P") |
564 |
(if (or (null mh-index-data) |
(if (null mh-index-data) |
565 |
(memq 'unthread mh-view-ops)) |
(message "Only applicable in an MH-E index search buffer") |
|
(message "Only applicable in an unthreaded MH-E index search buffer") |
|
566 |
(let ((point (point))) |
(let ((point (point))) |
567 |
(forward-line (if backward-flag -1 1)) |
(forward-line (if backward-flag -1 1)) |
568 |
(cond ((if backward-flag |
(cond ((if backward-flag |
640 |
(set-buffer-modified-p old-buffer-modified-flag))) |
(set-buffer-modified-p old-buffer-modified-flag))) |
641 |
|
|
642 |
;;;###mh-autoload |
;;;###mh-autoload |
643 |
|
(defun mh-index-group-by-folder () |
644 |
|
"Partition the messages based on source folder. |
645 |
|
Returns an alist with the the folder names in the car and the cdr being the |
646 |
|
list of messages originally from that folder." |
647 |
|
(save-excursion |
648 |
|
(goto-char (point-min)) |
649 |
|
(let ((result-table (make-hash-table))) |
650 |
|
(loop for msg being hash-keys of mh-index-msg-checksum-map |
651 |
|
do (push msg (gethash (car (gethash |
652 |
|
(gethash msg mh-index-msg-checksum-map) |
653 |
|
mh-index-checksum-origin-map)) |
654 |
|
result-table))) |
655 |
|
(loop for x being the hash-keys of result-table |
656 |
|
collect (cons x (nreverse (gethash x result-table))))))) |
657 |
|
|
658 |
|
;;;###mh-autoload |
659 |
(defun mh-index-delete-folder-headers () |
(defun mh-index-delete-folder-headers () |
660 |
"Delete the folder headers." |
"Delete the folder headers." |
661 |
(let ((cur-msg (mh-get-msg-num nil)) |
(let ((cur-msg (mh-get-msg-num nil)) |
690 |
(when (not folder) |
(when (not folder) |
691 |
(setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) |
(setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) |
692 |
mh-index-checksum-origin-map)))) |
mh-index-checksum-origin-map)))) |
693 |
(mh-visit-folder |
(when (or (not (get-buffer folder)) |
694 |
folder (loop for x being the hash-keys of (gethash folder mh-index-data) |
(y-or-n-p (format "Reuse buffer displaying %s? " folder))) |
695 |
when (mh-msg-exists-p x folder) collect x)))) |
(mh-visit-folder |
696 |
|
folder (loop for x being the hash-keys of (gethash folder mh-index-data) |
697 |
|
when (mh-msg-exists-p x folder) collect x))))) |
698 |
|
|
699 |
|
;;;###mh-autoload |
700 |
|
(defun mh-index-update-unseen (msg) |
701 |
|
"Remove counterpart of MSG in source folder from `mh-unseen-seq'. |
702 |
|
Also `mh-update-unseen' is called in the original folder, if we have it open." |
703 |
|
(let* ((checksum (gethash msg mh-index-msg-checksum-map)) |
704 |
|
(folder-msg-pair (gethash checksum mh-index-checksum-origin-map)) |
705 |
|
(orig-folder (car folder-msg-pair)) |
706 |
|
(orig-msg (cdr folder-msg-pair))) |
707 |
|
(when (mh-index-match-checksum orig-msg orig-folder checksum) |
708 |
|
(when (get-buffer orig-folder) |
709 |
|
(save-excursion |
710 |
|
(set-buffer orig-folder) |
711 |
|
(unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list)) |
712 |
|
(mh-update-unseen))) |
713 |
|
(mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg) |
714 |
|
"-sequence" (symbol-name mh-unseen-seq) "-del")))) |
715 |
|
|
716 |
(defun mh-index-match-checksum (msg folder checksum) |
(defun mh-index-match-checksum (msg folder checksum) |
717 |
"Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." |
"Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." |
965 |
(when (or (eobp) (and (bolp) (eolp))) |
(when (or (eobp) (and (bolp) (eolp))) |
966 |
(return nil)) |
(return nil)) |
967 |
(unless (eq (char-after) ?/) |
(unless (eq (char-after) ?/) |
968 |
(return error)) |
(return 'error)) |
969 |
(let ((start (point)) |
(let ((start (point)) |
970 |
end msg-start) |
end msg-start) |
971 |
(setq end (line-end-position)) |
(setq end (line-end-position)) |
1047 |
|
|
1048 |
|
|
1049 |
|
|
1050 |
|
;; Interface to unseen messages script |
1051 |
|
|
1052 |
|
(defvar mh-flists-search-folders) |
1053 |
|
|
1054 |
|
(defun mh-flists-execute (&rest args) |
1055 |
|
"Search for unseen messages in `mh-flists-search-folders'. |
1056 |
|
If `mh-recursive-folders-flag' is t, then the folders are searched |
1057 |
|
recursively. All parameters ARGS are ignored." |
1058 |
|
(set-buffer (get-buffer-create mh-index-temp-buffer)) |
1059 |
|
(erase-buffer) |
1060 |
|
(unless (executable-find "sh") |
1061 |
|
(error "Didn't find sh")) |
1062 |
|
(with-temp-buffer |
1063 |
|
(let ((unseen (symbol-name mh-unseen-seq))) |
1064 |
|
(insert "for folder in `flists " |
1065 |
|
(cond ((eq mh-flists-search-folders t) mh-inbox) |
1066 |
|
((eq mh-flists-search-folders nil) "") |
1067 |
|
((listp mh-flists-search-folders) |
1068 |
|
(loop for folder in mh-flists-search-folders |
1069 |
|
concat (concat " " folder)))) |
1070 |
|
(if mh-recursive-folders-flag " -recurse" "") |
1071 |
|
" -sequence " unseen " -noshowzero -fast` ; do\n" |
1072 |
|
"mhpath \"+$folder\" " unseen "\n" "done\n")) |
1073 |
|
(call-process-region |
1074 |
|
(point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer)))) |
1075 |
|
|
1076 |
|
;;;###mh-autoload |
1077 |
|
(defun mh-index-new-messages (folders) |
1078 |
|
"Display new messages. |
1079 |
|
All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed. |
1080 |
|
By default the folders specified by `mh-index-new-messages-folders' are |
1081 |
|
searched. With a prefix argument, enter a space-separated list of folders, or |
1082 |
|
nothing to search all folders." |
1083 |
|
(interactive |
1084 |
|
(list (if current-prefix-arg |
1085 |
|
(split-string (read-string "Folders to search: ")) |
1086 |
|
mh-index-new-messages-folders))) |
1087 |
|
(let* ((mh-flists-search-folders folders) |
1088 |
|
(mh-indexer 'flists) |
1089 |
|
(mh-index-execute-search-function 'mh-flists-execute) |
1090 |
|
(mh-index-next-result-function 'mh-mairix-next-result) |
1091 |
|
(mh-mairix-folder mh-user-path) |
1092 |
|
(mh-index-regexp-builder nil) |
1093 |
|
(new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder)) |
1094 |
|
(window-config (if (equal new-folder mh-current-folder) |
1095 |
|
mh-previous-window-config |
1096 |
|
(current-window-configuration))) |
1097 |
|
(redo-flag nil)) |
1098 |
|
(cond ((buffer-live-p (get-buffer new-folder)) |
1099 |
|
;; The destination folder is being visited. Trick `mh-index-search' |
1100 |
|
;; into thinking that the folder was the result of a previous search. |
1101 |
|
(set-buffer new-folder) |
1102 |
|
(setq mh-index-previous-search (list "+" mh-flists-results-folder)) |
1103 |
|
(setq redo-flag t)) |
1104 |
|
((mh-folder-exists-p new-folder) |
1105 |
|
;; Folder exists but we don't have it open. That means they are |
1106 |
|
;; stale results from a old flists search. Clear it out. |
1107 |
|
(mh-exec-cmd-quiet nil "rmf" new-folder))) |
1108 |
|
(mh-index-search redo-flag "+" mh-flists-results-folder window-config t))) |
1109 |
|
|
1110 |
|
|
1111 |
|
|
1112 |
;; Swish interface |
;; Swish interface |
1113 |
|
|
1114 |
(defvar mh-swish-binary (executable-find "swish-e")) |
(defvar mh-swish-binary (executable-find "swish-e")) |
1272 |
(defun mh-swish++-regexp-builder (regexp-list) |
(defun mh-swish++-regexp-builder (regexp-list) |
1273 |
"Generate query for swish++. |
"Generate query for swish++. |
1274 |
REGEXP-LIST is an alist of fields and values." |
REGEXP-LIST is an alist of fields and values." |
1275 |
(let ((regexp "") meta) |
(let ((regexp "")) |
1276 |
(dolist (elem regexp-list) |
(dolist (elem regexp-list) |
1277 |
(when (cdr elem) |
(when (cdr elem) |
1278 |
(setq regexp (concat regexp " and " |
(setq regexp (concat regexp " and " |
1373 |
|
|
1374 |
|
|
1375 |
|
|
1376 |
|
;;;###mh-autoload |
1377 |
(defun mh-index-choose () |
(defun mh-index-choose () |
1378 |
"Choose an indexing function. |
"Choose an indexing function. |
1379 |
The side-effects of this function are that the variables `mh-indexer', |
The side-effects of this function are that the variables `mh-indexer', |