1 ;;; mh-index -- MH-E interface to indexing programs
3 ;; Copyright (C) 2002 Free Software Foundation, Inc.
5 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;;; (1) The following search engines are supported:
36 ;;; (2) To use this package, you first have to build an index. Please read
37 ;;; the documentation for `mh-index-search' to get started. That
38 ;;; documentation will direct you to the specific instructions for your
39 ;;; particular indexer.
43 ;; $Id: mh-index.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
52 (autoload 'gnus-local-map-property
"gnus-util")
53 (autoload 'gnus-eval-format
"gnus-spec")
54 (autoload 'widget-convert-button
"wid-edit")
55 (autoload 'executable-find
"executable")
57 ;; Support different indexing programs
58 (defvar mh-indexer-choices
60 mh-swish
++-binary mh-swish
++-execute-search mh-swish
++-next-result
61 mh-swish
++-regexp-builder
)
63 mh-swish-binary mh-swish-execute-search mh-swish-next-result nil
)
65 mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result
66 mh-mairix-regexp-builder
)
68 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil
)
70 mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil
)
72 mh-pick-binary mh-pick-execute-search mh-pick-next-result
73 mh-pick-regexp-builder
)
75 mh-grep-binary mh-grep-execute-search mh-grep-next-result nil
))
76 "List of possible indexer choices.")
77 (defvar mh-indexer nil
78 "Chosen index program.")
79 (defvar mh-index-execute-search-function nil
80 "Function which executes the search program.")
81 (defvar mh-index-next-result-function nil
82 "Function to parse the next line of output.")
83 (defvar mh-index-regexp-builder nil
84 "Function used to construct search regexp.")
86 ;; FIXME: This should be a defcustom...
87 (defvar mh-index-folder
"+mhe-index"
88 "Folder that contains the folders resulting from the index searches.")
90 ;; Temporary buffers for search results
91 (defvar mh-index-temp-buffer
" *mh-index-temp*")
92 (defvar mh-checksum-buffer
" *mh-checksum-buffer*")
96 ;;; A few different checksum programs are supported. The supported programs
102 ;;; To add support for your favorite checksum program add a clause to the cond
103 ;;; statement in mh-checksum-choose. This should set the variable
104 ;;; mh-checksum-cmd to the command line needed to run the checsum program and
105 ;;; should set mh-checksum-parser to a function which returns a cons cell
106 ;;; containing the message number and checksum string.
108 (defvar mh-checksum-cmd
)
109 (defvar mh-checksum-parser
)
111 (defun mh-checksum-choose ()
112 "Check if a program to create a checksum is present."
113 (unless (boundp 'mh-checksum-cmd
)
114 (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path
)))
115 (cond ((executable-find "md5sum")
116 (setq mh-checksum-cmd
(list (executable-find "md5sum")))
117 (setq mh-checksum-parser
#'mh-md5sum-parser
))
118 ((executable-find "openssl")
119 (setq mh-checksum-cmd
(list (executable-find "openssl") "md5"))
120 (setq mh-checksum-parser
#'mh-openssl-parser
))
121 ((executable-find "md5")
122 (setq mh-checksum-cmd
(list (executable-find "md5")))
123 (setq mh-checksum-parser
#'mh-md5-parser
))
124 (t (error "No suitable checksum program"))))))
126 (defun mh-md5sum-parser ()
127 "Parse md5sum output."
128 (let ((begin (line-beginning-position))
129 (end (line-end-position))
130 first-space last-slash
)
131 (setq first-space
(search-forward " " end t
))
133 (setq last-slash
(search-backward "/" begin t
))
134 (cond ((and first-space last-slash
)
135 (cons (car (read-from-string (buffer-substring-no-properties
136 (1+ last-slash
) end
)))
137 (buffer-substring-no-properties begin
(1- first-space
))))
138 (t (cons nil nil
)))))
140 (defun mh-openssl-parser ()
141 "Parse openssl output."
142 (let ((begin (line-beginning-position))
143 (end (line-end-position))
144 last-space last-slash
)
146 (setq last-space
(search-backward " " begin t
))
147 (setq last-slash
(search-backward "/" begin t
))
148 (cond ((and last-slash last-space
)
149 (cons (car (read-from-string (buffer-substring-no-properties
150 (1+ last-slash
) (1- last-space
))))
151 (buffer-substring-no-properties (1+ last-space
) end
))))))
153 (defalias 'mh-md5-parser
'mh-openssl-parser
)
157 ;;; Make sure that we don't produce too long a command line.
159 (defvar mh-index-max-cmdline-args
500
160 "Maximum number of command line args.")
162 (defun mh-index-execute (cmd &rest args
)
163 "Partial imitation of xargs.
164 The current buffer contains a list of strings, one on each line. The function
165 will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
166 strings to it. This is repeated till all the strings have been used."
167 (goto-char (point-min))
168 (let ((out (get-buffer-create " *mh-xargs-output*")))
173 (let ((arg-list (reverse args
))
175 (while (and (not (eobp)) (< count mh-index-max-cmdline-args
))
176 (push (buffer-substring-no-properties (point) (line-end-position))
180 (apply #'call-process cmd nil
(list out nil
) nil
(nreverse arg-list
))))
182 (insert-buffer-substring out
)))
186 (defun mh-index-update-single-msg (msg checksum origin-map
)
187 "Update various maps for one message.
188 MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
189 non-nil, a hashtable containing which maps each message in the index folder to
190 the folder and message that it was copied from. The function updates the hash
191 tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
193 This function should only be called in the appropriate index folder buffer."
194 (cond ((and origin-map
(gethash checksum mh-index-checksum-origin-map
))
195 (let* ((intermediate (gethash msg origin-map
))
196 (ofolder (car intermediate
))
197 (omsg (cdr intermediate
)))
198 ;; This is most probably a duplicate. So eliminate it.
199 (call-process "rm" nil nil nil
200 (format "%s%s/%s" mh-user-path
201 (substring mh-current-folder
1) msg
))
202 (remhash omsg
(gethash ofolder mh-index-data
))))
204 (setf (gethash msg mh-index-msg-checksum-map
) checksum
)
206 (setf (gethash checksum mh-index-checksum-origin-map
)
207 (gethash msg origin-map
))))))
210 (defun mh-index-update-maps (folder &optional origin-map
)
211 "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
212 As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
213 is a hashtable which maps each message in the index folder to the original
214 folder and message from whence it was copied. If present the
215 checksum -> (origin-folder, origin-index) map is updated too."
216 (clrhash mh-index-msg-checksum-map
)
219 (set-buffer (get-buffer-create mh-checksum-buffer
))
221 ;; Run scan to check if any messages needs MD5 annotations at all
223 (mh-exec-cmd-output mh-scan-prog nil
"-width" "80"
224 "-format" "%(msg)\n%{x-mhe-checksum}\n"
226 (goto-char (point-min))
229 (setq msg
(buffer-substring-no-properties
230 (point) (line-end-position)))
234 ;; need to compute checksum
235 (set-buffer mh-checksum-buffer
)
236 (insert mh-user-path
(substring folder
1) "/" msg
"\n"))
239 (setq checksum
(buffer-substring-no-properties
240 (point) (line-end-position)))
241 (let ((msg (car (read-from-string msg
))))
243 (mh-index-update-single-msg msg checksum origin-map
)))))
245 ;; Run checksum program if needed
246 (unless (and (eobp) (bobp))
247 (apply #'mh-index-execute mh-checksum-cmd
)
248 (goto-char (point-min))
250 (let* ((intermediate (funcall mh-checksum-parser
))
251 (msg (car intermediate
))
252 (checksum (cdr intermediate
)))
255 (mh-exec-cmd "anno" folder msg
"-component" "X-MHE-Checksum"
256 "-nodate" "-text" checksum
"-inplace")
260 (mh-index-update-single-msg msg checksum origin-map
)))
263 (defun mh-index-generate-pretty-name (string)
264 "Given STRING generate a name which is suitable for use as a folder name.
265 White space from the beginning and end are removed. All spaces in the name are
266 replaced with underscores and all / are replaced with $. If STRING is longer
267 than 20 it is truncated too. STRING could be a list of strings in which case
268 they are concatenated to construct the base name."
272 (when (car string
) (insert (car string
)))
273 (dolist (s (cdr string
))
275 (setq string
(mh-replace-string "-lbrace" " "))
276 (setq string
(mh-replace-string "-rbrace" " "))
277 (subst-char-in-region (point-min) (point-max) ?
( ? t
)
278 (subst-char-in-region (point-min) (point-max) ?
) ? t
)
279 (subst-char-in-region (point-min) (point-max) ?- ? t
)
280 (goto-char (point-min))
281 (while (and (not (eobp)) (memq (char-after) '(? ?
\t ?
\n ?
\r ?_
)))
283 (goto-char (point-max))
284 (while (and (not (bobp)) (memq (char-before) '(? ?
\t ?
\n ?
\r ?_
)))
285 (delete-backward-char 1))
286 (subst-char-in-region (point-min) (point-max) ? ?_ t
)
287 (subst-char-in-region (point-min) (point-max) ?
\t ?_ t
)
288 (subst-char-in-region (point-min) (point-max) ?
\n ?_ t
)
289 (subst-char-in-region (point-min) (point-max) ?
\r ?_ t
)
290 (subst-char-in-region (point-min) (point-max) ?
/ ?$ t
)
291 (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
294 (defun* mh-index-search
(redo-search-flag folder search-regexp
295 &optional window-config
)
296 "Perform an indexed search in an MH mail folder.
298 If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
299 index search, then the search is repeated. Otherwise, FOLDER is searched with
300 SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
301 \"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
302 stores the window configuration that will be restored after the user quits the
303 folder containing the index search results.
305 Four indexing programs are supported; if none of these are present, then grep
306 is used. This function picks the first program that is available on your
307 system. If you would prefer to use a different program, set the customization
308 variable `mh-index-program' accordingly.
310 The documentation for the following functions describes how to generate the
311 index for each program:
313 - `mh-swish++-execute-search'
314 - `mh-swish-execute-search'
315 - `mh-mairix-execute-search'
316 - `mh-namazu-execute-search'
317 - `mh-glimpse-execute-search'
319 If none of these programs are present then we use pick. If desired grep can be
320 used instead. Details about these methods can be found in:
322 - `mh-pick-execute-search'
323 - `mh-grep-execute-search'
325 This and related functions use an X-MHE-Checksum header to cache the MD5
326 checksum of a message. This means that already present X-MHE-Checksum headers
327 in the incoming email could result in messages not being found. The following
328 procmail recipe should avoid this:
331 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
333 This has the effect of renaming already present X-MHE-Checksum headers."
335 (list current-prefix-arg
337 (unless mh-find-path-run
(mh-find-path))
338 (or (and current-prefix-arg
(car mh-index-previous-search
))
339 (mh-prompt-for-folder "Search" "+" nil
"all" t
)))
341 ;; Yes, we do want to call mh-index-choose every time in case the
342 ;; user has switched the indexer manually.
343 (unless (mh-index-choose) (error "No indexing program found"))
344 (or (and current-prefix-arg
(cadr mh-index-previous-search
))
345 mh-index-regexp-builder
346 (read-string (format "%s regexp: "
348 (symbol-name mh-indexer
))))))
350 (and current-prefix-arg
(cadr mh-index-previous-search
)))
351 mh-index-regexp-builder
)
352 (current-window-configuration)
354 (when (symbolp search-regexp
)
355 (mh-search-folder folder window-config
)
356 (setq mh-searching-function
'mh-index-do-search
)
357 (return-from mh-index-search
))
359 (let ((result-count 0)
360 (old-window-config (or window-config mh-previous-window-config
))
361 (previous-search mh-index-previous-search
)
362 (index-folder (format "%s/%s" mh-index-folder
363 (mh-index-generate-pretty-name search-regexp
))))
364 ;; Create a new folder for the search results or recreate the old one...
365 (if (and redo-search-flag mh-index-previous-search
)
366 (let ((buffer-name (buffer-name (current-buffer))))
367 (mh-process-or-undo-commands buffer-name
)
368 (save-excursion (mh-exec-cmd-quiet nil
"rmf" buffer-name
))
369 (mh-exec-cmd-quiet nil
"folder" "-create" "-fast" buffer-name
)
370 (setq index-folder buffer-name
))
371 (setq index-folder
(mh-index-new-folder index-folder
)))
373 (let ((folder-path (format "%s%s" mh-user-path
(substring folder
1)))
374 (folder-results-map (make-hash-table :test
#'equal
))
375 (origin-map (make-hash-table :test
#'equal
)))
376 ;; Run search program...
377 (message "Executing %s... " mh-indexer
)
378 (funcall mh-index-execute-search-function folder-path search-regexp
)
380 ;; Parse indexer output
381 (message "Processing %s output... " mh-indexer
)
382 (goto-char (point-min))
383 (loop for next-result
= (funcall mh-index-next-result-function
)
384 when
(null next-result
) return nil
385 do
(unless (eq next-result
'error
)
386 (unless (gethash (car next-result
) folder-results-map
)
387 (setf (gethash (car next-result
) folder-results-map
)
388 (make-hash-table :test
#'equal
)))
389 (setf (gethash (cadr next-result
)
390 (gethash (car next-result
) folder-results-map
))
393 ;; Copy the search results over
394 (maphash #'(lambda (folder msgs
)
395 (let ((msgs (sort (loop for msg being the hash-keys of msgs
398 (mh-exec-cmd "refile" msgs
"-src" folder
399 "-link" index-folder
)
400 (loop for msg in msgs
401 do
(incf result-count
)
402 (setf (gethash result-count origin-map
)
403 (cons folder msg
)))))
406 ;; Generate scan lines for the hits.
407 (let ((mh-show-threads-flag nil
))
408 (mh-visit-folder index-folder
() (list folder-results-map origin-map
)))
410 (goto-char (point-min))
412 (mh-update-sequences)
416 (when (or (and redo-search-flag previous-search
) window-config
)
417 (setq mh-previous-window-config old-window-config
))
418 (setq mh-index-previous-search
(list folder search-regexp
))
420 (message "%s found %s matches in %s folders"
421 (upcase-initials (symbol-name mh-indexer
))
422 (loop for msg-hash being hash-values of mh-index-data
423 sum
(hash-table-count msg-hash
))
424 (loop for msg-hash being hash-values of mh-index-data
425 count
(> (hash-table-count msg-hash
) 0))))))
428 (defun mh-index-do-search ()
429 "Construct appropriate regexp and call `mh-index-search'."
431 (unless (mh-index-choose) (error "No indexing program found"))
432 (let* ((regexp-list (mh-pick-parse-search-buffer))
433 (pattern (funcall mh-index-regexp-builder regexp-list
)))
435 (mh-index-search nil mh-current-folder pattern
436 mh-previous-window-config
)
437 (error "No search terms"))))
439 (defun mh-replace-string (old new
)
440 "Replace all occurrences of OLD with NEW in the current buffer."
441 (goto-char (point-min))
442 (while (search-forward old nil t
)
443 (replace-match new
)))
446 (defun mh-index-parse-search-regexp (input-string)
447 "Construct parse tree for INPUT-STRING.
448 All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by AND, OR and
449 NOT as appropriate. Then the resulting string is parsed."
452 (insert input-string
)
453 (downcase-region (point-min) (point-max))
455 (mh-replace-string "\t" " ")
457 (mh-replace-string "&" " and ")
458 (mh-replace-string " -and " " and ")
460 (mh-replace-string "|" " or ")
461 (mh-replace-string " -or " " or ")
463 (mh-replace-string "!" " not ")
464 (mh-replace-string "~" " not ")
465 (mh-replace-string " -not " " not ")
466 ;; synonyms of left brace
467 (mh-replace-string "(" " ( ")
468 (mh-replace-string " -lbrace " " ( ")
469 ;; synonyms of right brace
470 (mh-replace-string ")" " ) ")
471 (mh-replace-string " -rbrace " " ) ")
472 ;; get the normalized input
473 (setq input
(format "( %s )" (buffer-substring (point-min) (point-max)))))
475 (let ((tokens (mh-index-add-implicit-ops (split-string input
)))
479 (dolist (token tokens
)
480 (cond ((equal token
"(") (push 'paren op-stack
))
481 ((equal token
"not") (push 'not op-stack
))
482 ((equal token
"or") (push 'or op-stack
))
483 ((equal token
"and") (push 'and op-stack
))
485 (multiple-value-setq (op-stack operand-stack
)
486 (mh-index-evaluate op-stack operand-stack
))
487 (when (eq (car op-stack
) 'not
)
489 (push `(not ,(pop operand-stack
)) operand-stack
))
490 (when (eq (car op-stack
) 'and
)
492 (setq oper1
(pop operand-stack
))
493 (push `(and ,(pop operand-stack
) ,oper1
) operand-stack
)))
494 ((eq (car op-stack
) 'not
)
496 (push `(not ,token
) operand-stack
)
497 (when (eq (car op-stack
) 'and
)
499 (setq oper1
(pop operand-stack
))
500 (push `(and ,(pop operand-stack
) ,oper1
) operand-stack
)))
501 ((eq (car op-stack
) 'and
)
503 (push `(and ,(pop operand-stack
) ,token
) operand-stack
))
504 (t (push token operand-stack
))))
505 (prog1 (pop operand-stack
)
506 (when (or op-stack operand-stack
)
507 (error "Invalid regexp: %s" input
))))))
509 (defun mh-index-add-implicit-ops (tokens)
510 "Add implicit operators in the list TOKENS."
515 (setq current
(pop tokens
))
516 (cond ((or (equal current
")") (equal current
"and") (equal current
"or"))
517 (setq literal-seen nil
)
518 (push current result
))
521 (setq literal-seen nil
)
524 (push current result
)
525 (unless (or (equal current
"(") (equal current
"not"))
526 (setq literal-seen t
)))))
529 (defun mh-index-evaluate (op-stack operand-stack
)
530 "Read expression till starting paren based on OP-STACK and OPERAND-STACK."
531 (block mh-index-evaluate
534 (setq op
(pop op-stack
))
535 (cond ((eq op
'paren
)
536 (return-from mh-index-evaluate
(values op-stack operand-stack
)))
538 (push `(not ,(pop operand-stack
)) operand-stack
))
539 ((or (eq op
'and
) (eq op
'or
))
540 (setq oper1
(pop operand-stack
))
541 (push `(,op
,(pop operand-stack
) ,oper1
) operand-stack
))))
542 (error "Ran out of tokens"))))
545 (defun mh-index-next-folder (&optional backward-flag
)
546 "Jump to the next folder marker.
547 The function is only applicable to folders displaying index search results.
548 With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
551 (if (or (null mh-index-data
)
552 (memq 'unthread mh-view-ops
))
553 (message "Only applicable in an unthreaded MH-E index search buffer")
554 (let ((point (point)))
555 (forward-line (if backward-flag -
1 1))
556 (cond ((if backward-flag
557 (re-search-backward "^+" (point-min) t
)
558 (re-search-forward "^+" (point-max) t
))
560 ((and (if backward-flag
561 (goto-char (point-max))
562 (goto-char (point-min)))
565 (re-search-backward "^+" (point-min) t
)
566 (re-search-forward "^+" (point-max) t
))
568 (t (goto-char point
))))))
571 (defun mh-index-previous-folder ()
572 "Jump to the previous folder marker."
574 (mh-index-next-folder t
))
576 (defun mh-folder-exists-p (folder)
577 "Check if FOLDER exists."
578 (and (mh-folder-name-p folder
)
581 (mh-exec-cmd-output "folder" nil
"-fast" "-nocreate" folder
)
582 (goto-char (point-min))
585 (defun mh-msg-exists-p (msg folder
)
586 "Check if MSG exists in FOLDER."
587 (file-exists-p (format "%s%s/%s" mh-user-path
(substring folder
1) msg
)))
589 (defun mh-index-new-folder (name)
590 "Create and return an MH folder name based on NAME.
591 If the folder NAME already exists then check if NAME<2> exists. If it doesn't
592 then it is created and returned. Otherwise try NAME<3>. This is repeated till
593 we find a new folder name."
594 (unless (mh-folder-name-p name
)
595 (error "The argument should be a valid MH folder name"))
596 (let ((chosen-name name
))
598 (unless (mh-folder-exists-p name
)
599 (return-from unique-name
))
600 (loop for index from
2
601 do
(let ((new-name (format "%s<%s>" name index
)))
602 (unless (mh-folder-exists-p new-name
)
603 (setq chosen-name new-name
)
604 (return-from unique-name
)))))
605 (mh-exec-cmd-quiet nil
"folder" "-create" "-fast" chosen-name
)
606 (mh-remove-from-sub-folders-cache chosen-name
)
607 (when (boundp 'mh-speed-folder-map
)
608 (mh-speed-add-folder chosen-name
))
612 (defun mh-index-insert-folder-headers ()
613 "Annotate the search results with original folder names."
614 (let ((cur-msg (mh-get-msg-num nil
))
615 (old-buffer-modified-flag (buffer-modified-p))
616 (buffer-read-only nil
)
617 current-folder last-folder
)
618 (goto-char (point-min))
620 (setq current-folder
(car (gethash (gethash (mh-get-msg-num nil
)
621 mh-index-msg-checksum-map
)
622 mh-index-checksum-origin-map
)))
623 (when (and current-folder
(not (eq current-folder last-folder
)))
624 (insert (if last-folder
"\n" "") current-folder
"\n")
625 (setq last-folder current-folder
))
627 (when cur-msg
(mh-goto-msg cur-msg t
))
628 (set-buffer-modified-p old-buffer-modified-flag
)))
631 (defun mh-index-delete-folder-headers ()
632 "Delete the folder headers."
633 (let ((cur-msg (mh-get-msg-num nil
))
634 (old-buffer-modified-flag (buffer-modified-p))
635 (buffer-read-only nil
))
636 (while (and (not cur-msg
) (not (eobp)))
638 (setq cur-msg
(mh-get-msg-num nil
)))
639 (goto-char (point-min))
641 (if (or (char-equal (char-after) ?
+) (char-equal (char-after) 10))
642 (delete-region (point) (progn (forward-line) (point)))
644 (when cur-msg
(mh-goto-msg cur-msg t t
))
645 (set-buffer-modified-p old-buffer-modified-flag
)))
648 (defun mh-index-visit-folder ()
649 "Visit original folder from where the message at point was found."
651 (unless mh-index-data
652 (error "Not in an index folder"))
655 (cond ((and (bolp) (eolp))
656 (ignore-errors (forward-line -
1))
657 (setq msg
(mh-get-msg-num t
)))
658 ((equal (char-after (line-beginning-position)) ?
+)
659 (setq folder
(buffer-substring-no-properties
660 (line-beginning-position) (line-end-position))))
661 (t (setq msg
(mh-get-msg-num t
)))))
663 (setq folder
(car (gethash (gethash msg mh-index-msg-checksum-map
)
664 mh-index-checksum-origin-map
))))
666 folder
(loop for x being the hash-keys of
(gethash folder mh-index-data
)
667 when
(mh-msg-exists-p x folder
) collect x
))))
669 (defun mh-index-match-checksum (msg folder checksum
)
670 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
672 (mh-exec-cmd-output mh-scan-prog nil
"-width" "80"
673 "-format" "%{x-mhe-checksum}\n" folder msg
)
674 (goto-char (point-min))
675 (string-equal (buffer-substring-no-properties (point) (line-end-position))
679 (defun mh-index-execute-commands ()
680 "Delete/refile the actual messages.
681 The copies in the searched folder are then deleted/refiled to get the desired
682 result. Before deleting the messages we make sure that the message being
683 deleted is identical to the one that the user has marked in the index buffer."
684 (let ((message-table (make-hash-table :test
#'equal
)))
685 (dolist (msg-list (cons mh-delete-list
(mapcar #'cdr mh-refile-list
)))
686 (dolist (msg msg-list
)
687 (let* ((checksum (gethash msg mh-index-msg-checksum-map
))
688 (pair (gethash checksum mh-index-checksum-origin-map
)))
689 (when (and checksum
(car pair
) (cdr pair
)
690 (mh-index-match-checksum (cdr pair
) (car pair
) checksum
))
691 (push (cdr pair
) (gethash (car pair
) message-table
))
692 (remhash (cdr pair
) (gethash (car pair
) mh-index-data
))))))
693 (maphash (lambda (folder msgs
)
694 (apply #'mh-exec-cmd
"rmm" folder
(mh-coalesce-msg-list msgs
)))
701 (defvar mh-glimpse-binary
(executable-find "glimpse"))
702 (defvar mh-glimpse-directory
".glimpse")
705 (defun mh-glimpse-execute-search (folder-path search-regexp
)
706 "Execute glimpse and read the results.
708 In the examples below, replace /home/user/Mail with the path to your MH
711 First create the directory /home/user/Mail/.glimpse. Then create the file
712 /home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
718 ^/home/user/Mail/.glimpse
719 ^/home/user/Mail/mhe-index
721 If there are any directories you would like to ignore, append lines like the
722 following to .glimpse_exclude:
724 ^/home/user/Mail/scripts
726 You do not want to index the folders that hold the results of your searches
727 since they tend to be ephemeral and the original messages are indexed anyway.
728 The configuration file above assumes that the results are found in sub-folders
729 of `mh-index-folder' which is +mhe-index by default.
731 Use the following command line to generate the glimpse index. Run this
734 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
736 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
737 (set-buffer (get-buffer-create mh-index-temp-buffer
))
739 (call-process mh-glimpse-binary nil
'(t nil
) nil
742 "-H" (format "%s%s" mh-user-path mh-glimpse-directory
)
743 "-F" (format "^%s" folder-path
)
745 (goto-char (point-min)))
747 (defun mh-glimpse-next-result ()
748 "Read the next result.
749 Parse it and return the message folder, message index and the match. If no
750 other matches left then return nil. If the current record is invalid return
756 (let ((eol-pos (line-end-position))
757 (bol-pos (line-beginning-position))
758 folder-start msg-end
)
760 (unless (search-forward mh-user-path eol-pos t
)
762 (setq folder-start
(point))
763 (unless (search-forward ": " eol-pos t
)
765 (let ((match (buffer-substring-no-properties (point) eol-pos
)))
767 (setq msg-end
(point))
768 (unless (search-backward "/" folder-start t
)
770 (list (format "+%s" (buffer-substring-no-properties
771 folder-start
(point)))
772 (let ((val (ignore-errors (read-from-string
773 (buffer-substring-no-properties
774 (1+ (point)) msg-end
)))))
775 (if (and (consp val
) (integerp (car val
)))
785 (defvar mh-index-pick-folder
)
786 (defvar mh-pick-binary
"pick")
788 (defun mh-pick-execute-search (folder-path search-regexp
)
791 Unlike the other index search programs \"pick\" only searches messages present
792 in the folder itself and does not descend into any sub-folders that may be
795 FOLDER-PATH is the directory containing the mails to be searched and
796 SEARCH-REGEXP is the pattern that pick gets."
797 (set-buffer (get-buffer-create mh-index-temp-buffer
))
799 (setq mh-index-pick-folder
800 (concat "+" (substring folder-path
(length mh-user-path
))))
801 (apply #'call-process
(expand-file-name "pick" mh-progs
) nil
'(t nil
) nil
802 mh-index-pick-folder
"-list" search-regexp
)
803 (goto-char (point-min)))
805 (defun mh-pick-next-result ()
806 "Return the next pick search result."
808 (when (eobp) (return nil
))
809 (unless (re-search-forward "^[1-9][0-9]*$" (line-end-position) t
)
811 (list mh-index-pick-folder
812 (car (read-from-string (buffer-substring-no-properties
813 (line-beginning-position)
814 (line-end-position))))
822 (defvar mh-grep-binary
(executable-find "grep"))
824 (defun mh-grep-execute-search (folder-path search-regexp
)
825 "Execute grep and read the results.
826 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
827 (set-buffer (get-buffer-create mh-index-temp-buffer
))
829 (call-process mh-grep-binary nil
'(t nil
) nil
830 "-i" "-r" search-regexp folder-path
)
831 (goto-char (point-min)))
833 (defun mh-grep-next-result ()
834 "Read the next result.
835 Parse it and return the message folder, message index and the match. If no
836 other matches left then return nil. If the current record is invalid return
842 (let ((eol-pos (line-end-position))
843 (bol-pos (line-beginning-position))
844 folder-start msg-end
)
846 (unless (search-forward mh-user-path eol-pos t
)
848 (setq folder-start
(point))
849 (unless (search-forward ":" eol-pos t
)
851 (let ((match (buffer-substring-no-properties (point) eol-pos
)))
853 (setq msg-end
(point))
854 (unless (search-backward "/" folder-start t
)
856 (list (format "+%s" (buffer-substring-no-properties
857 folder-start
(point)))
858 (let ((val (ignore-errors (read-from-string
859 (buffer-substring-no-properties
860 (1+ (point)) msg-end
)))))
861 (if (and (consp val
) (integerp (car val
)))
871 (defvar mh-mairix-binary
(executable-find "mairix"))
872 (defvar mh-mairix-directory
".mairix")
873 (defvar mh-mairix-folder nil
)
875 (defun mh-mairix-execute-search (folder-path search-regexp-list
)
876 "Execute mairix and read the results.
878 In the examples below replace /home/user/Mail with the path to your MH
881 First create the directory /home/user/Mail/.mairix. Then create the file
882 /home/user/Mail/.mairix/config with the following contents:
884 # This should contain the same thing as your `mh-user-path'
887 # List of folders that should be indexed. 3 dots at the end means there are
888 # subfolders within the folder
889 mh_folders=archive...:inbox:drafts:news:sent:trash
892 database=/home/user/Mail/mairix/database
894 Use the following command line to generate the mairix index. Run this daily
897 mairix -f /home/user/Mail/.mairix/config
899 FOLDER-PATH is the directory in which SEARCH-REGEXP-LIST is used to search."
900 (set-buffer (get-buffer-create mh-index-temp-buffer
))
902 (unless mh-mairix-binary
903 (error "Set mh-mairix-binary appropriately"))
904 (apply #'call-process mh-mairix-binary nil
'(t nil
) nil
905 "-f" (format "%s%s/config" mh-user-path mh-mairix-directory
)
907 (goto-char (point-min))
908 (setq mh-mairix-folder
909 (let ((last-char (substring folder-path
(1- (length folder-path
)))))
910 (if (equal last-char
"/")
912 (format "%s/" folder-path
)))))
914 (defun mh-mairix-next-result ()
915 "Return next result from mairix output."
918 (when (or (eobp) (and (bolp) (eolp)))
920 (unless (eq (char-after) ?
/)
922 (let ((start (point))
924 (setq end
(line-end-position))
925 (unless (search-forward mh-mairix-folder end t
)
927 (goto-char (match-beginning 0))
928 (unless (equal (point) start
)
931 (unless (search-backward "/" start t
)
933 (setq msg-start
(1+ (point)))
935 (unless (search-forward mh-user-path end t
)
937 (list (format "+%s" (buffer-substring-no-properties
938 (point) (1- msg-start
)))
939 (car (read-from-string
940 (buffer-substring-no-properties msg-start end
)))
944 (defun mh-mairix-regexp-builder (regexp-list)
945 "Generate query for mairix.
946 REGEXP-LIST is an alist of fields and values."
948 (dolist (pair regexp-list
)
952 (cond ((eq (car pair
) 'to
) "t:")
953 ((eq (car pair
) 'from
) "f:")
954 ((eq (car pair
) 'cc
) "c:")
955 ((eq (car pair
) 'subject
) "s:")
956 ((eq (car pair
) 'date
) "d:")
958 (let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair
))))
960 (dolist (conjunct sop
)
961 (let ((expr-list (cdr conjunct
))
963 (dolist (e expr-list
)
964 (setq expr-string
(concat expr-string
"+"
966 (if (atom e
) e
(cadr e
)))))
967 (setq final
(concat final
"," (substring expr-string
1)))))
968 (substring final
1)))
972 (defun mh-mairix-convert-to-sop* (expr)
973 "Convert EXPR to sum of product form."
974 (cond ((atom expr
) `(or (and ,expr
)))
977 (loop for e in
(mapcar #'mh-mairix-convert-to-sop
* (cdr expr
))
979 ((eq (car expr
) 'and
)
980 (let ((conjuncts (mapcar #'mh-mairix-convert-to-sop
* (cdr expr
)))
982 (setq result
(pop conjuncts
))
984 (setq next-factor
(pop conjuncts
))
985 (setq result
(let ((res ()))
986 (dolist (t1 (cdr result
))
987 (dolist (t2 (cdr next-factor
))
988 (push `(and ,@(cdr t1
) ,@(cdr t2
)) res
)))
991 ((atom (cadr expr
)) `(or (and ,expr
)))
992 ((eq (caadr expr
) 'not
) (mh-mairix-convert-to-sop* (cadadr expr
)))
993 ((eq (caadr expr
) 'and
) (mh-mairix-convert-to-sop*
994 `(or ,@(mapcar #'(lambda (x) `(not ,x
))
996 ((eq (caadr expr
) 'or
) (mh-mairix-convert-to-sop*
997 `(and ,@(mapcar #'(lambda (x) `(not ,x
))
999 (t (error "Unreachable: %s" expr
))))
1005 (defvar mh-swish-binary
(executable-find "swish-e"))
1006 (defvar mh-swish-directory
".swish")
1007 (defvar mh-swish-folder nil
)
1010 (defun mh-swish-execute-search (folder-path search-regexp
)
1011 "Execute swish-e and read the results.
1013 In the examples below, replace /home/user/Mail with the path to your MH
1016 First create the directory /home/user/Mail/.swish. Then create the file
1017 /home/user/Mail/.swish/config with the following contents:
1019 IndexDir /home/user/Mail
1020 IndexFile /home/user/Mail/.swish/index
1021 IndexName \"Mail Index\"
1022 IndexDescription \"Mail Index\"
1023 IndexPointer \"http://nowhere\"
1024 IndexAdmin \"nobody\"
1025 #MetaNames automatic
1029 IgnoreTotalWordCountWhenRanking yes
1030 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
1031 BeginCharacters abcdefghijklmnopqrstuvwxyz
1032 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
1035 FileRules pathname contains /home/user/Mail/.swish
1036 FileRules pathname contains /home/user/Mail/mhe-index
1037 FileRules filename is index
1038 FileRules filename is \\..*
1039 FileRules filename is #.*
1040 FileRules filename is ,.*
1041 FileRules filename is .*~
1043 If there are any directories you would like to ignore, append lines like the
1044 following to config:
1046 FileRules pathname contains /home/user/Mail/scripts
1048 You do not want to index the folders that hold the results of your searches
1049 since they tend to be ephemeral and the original messages are indexed anyway.
1050 The configuration file above assumes that the results are found in sub-folders
1051 of `mh-index-folder' which is +mhe-index by default.
1053 Use the following command line to generate the swish index. Run this
1056 swish-e -c /home/user/Mail/.swish/config
1058 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1059 (set-buffer (get-buffer-create mh-index-temp-buffer
))
1061 (unless mh-swish-binary
1062 (error "Set mh-swish-binary appropriately"))
1063 (call-process mh-swish-binary nil
'(t nil
) nil
1065 "-f" (format "%s%s/index" mh-user-path mh-swish-directory
))
1066 (goto-char (point-min))
1067 (setq mh-swish-folder
1068 (let ((last-char (substring folder-path
(1- (length folder-path
)))))
1069 (if (equal last-char
"/")
1071 (format "%s/" folder-path
)))))
1073 (defun mh-swish-next-result ()
1074 "Get the next result from swish output."
1077 (when (or (eobp) (equal (char-after (point)) ?.
))
1079 (when (equal (char-after (point)) ?
#)
1081 (let* ((start (search-forward " " (line-end-position) t
))
1082 (end (search-forward " " (line-end-position) t
)))
1083 (unless (and start end
)
1086 (unless (file-exists-p (buffer-substring-no-properties start end
))
1088 (unless (search-backward "/" start t
)
1090 (list (let* ((s (buffer-substring-no-properties start
(1+ (point)))))
1091 (unless (string-match mh-swish-folder s
)
1093 (if (string-match mh-user-path s
)
1095 (substring s
(match-end 0) (1- (length s
))))
1097 (let* ((s (buffer-substring-no-properties (1+ (point)) end
))
1098 (val (ignore-errors (read-from-string s
))))
1099 (if (and (consp val
) (numberp (car val
)))
1107 ;; Swish++ interface
1109 (defvar mh-swish
++-binary
(or (executable-find "search++")
1110 (executable-find "search")))
1111 (defvar mh-swish
++-directory
".swish++")
1114 (defun mh-swish++-execute-search
(folder-path search-regexp
)
1115 "Execute swish++ and read the results.
1117 In the examples below, replace /home/user/Mail with the path to your MH
1120 First create the directory /home/user/Mail/.swish++. Then create the file
1121 /home/user/Mail/.swish++/swish++.conf with the following contents:
1123 IncludeMeta Bcc Cc Comments Content-Description From Keywords
1124 IncludeMeta Newsgroups Resent-To Subject To
1125 IncludeMeta Message-Id References In-Reply-To
1127 IndexFile /home/user/Mail/.swish++/swish++.index
1129 Use the following command line to generate the swish index. Run this
1132 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
1133 -o -path /home/user/Mail/.swish++ -prune \\
1134 -o -name \"[0-9]*\" -print \\
1135 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
1137 You do not want to index the folders that hold the results of your searches
1138 since they tend to be ephemeral and the original messages are indexed anyway.
1139 The command above assumes that the results are found in sub-folders of
1140 `mh-index-folder' which is +mhe-index by default.
1142 On some systems (Debian GNU/Linux, for example), use index++ instead of index.
1144 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1145 (set-buffer (get-buffer-create mh-index-temp-buffer
))
1147 (unless mh-swish
++-binary
1148 (error "Set mh-swish++-binary appropriately"))
1149 (call-process mh-swish
++-binary nil
'(t nil
) nil
1151 (format "-i%s%s/swish++.index"
1152 mh-user-path mh-swish
++-directory
)
1154 (goto-char (point-min))
1155 (setq mh-swish-folder
1156 (let ((last-char (substring folder-path
(1- (length folder-path
)))))
1157 (if (equal last-char
"/")
1159 (format "%s/" folder-path
)))))
1161 (defalias 'mh-swish
++-next-result
'mh-swish-next-result
)
1163 (defun mh-swish++-regexp-builder
(regexp-list)
1164 "Generate query for swish++.
1165 REGEXP-LIST is an alist of fields and values."
1166 (let ((regexp "") meta
)
1167 (dolist (elem regexp-list
)
1169 (setq regexp
(concat regexp
" and "
1170 (if (car elem
) "(" "")
1171 (if (car elem
) (symbol-name (car elem
)) "")
1172 (if (car elem
) " = " "")
1173 (mh-swish++-print-regexp
(cdr elem
))
1174 (if (car elem
) ")" "")))))
1175 (substring regexp
4)))
1177 (defun mh-swish++-print-regexp
(expr)
1178 "Return infix expression corresponding to EXPR."
1179 (cond ((atom expr
) (format "%s" expr
))
1180 ((eq (car expr
) 'not
)
1181 (format "(not %s)" (mh-swish++-print-regexp
(cadr expr
))))
1182 (t (format "(%s %s %s)" (mh-swish++-print-regexp
(cadr expr
))
1183 (symbol-name (car expr
))
1184 (mh-swish++-print-regexp
(caddr expr
))))))
1190 (defvar mh-namazu-binary
(executable-find "namazu"))
1191 (defvar mh-namazu-directory
".namazu")
1192 (defvar mh-namazu-folder nil
)
1195 (defun mh-namazu-execute-search (folder-path search-regexp
)
1196 "Execute namazu and read the results.
1198 In the examples below, replace /home/user/Mail with the path to your MH
1201 First create the directory /home/user/Mail/.namazu. Then create the file
1202 /home/user/Mail/.namazu/mknmzrc with the following contents:
1204 package conf; # Don't remove this line!
1205 $ADDRESS = 'user@localhost';
1206 $ALLOW_FILE = \"[0-9]*\";
1207 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
1209 In the above example configuration, none of the mail files contained in the
1210 directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
1212 You do not want to index the folders that hold the results of your searches
1213 since they tend to be ephemeral and the original messages are indexed anyway.
1214 The configuration file above assumes that the results are found in sub-folders
1215 of `mh-index-folder' which is +mhe-index by default.
1217 Use the following command line to generate the namazu index. Run this
1220 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
1223 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1224 (let ((namazu-index-directory
1225 (format "%s%s" mh-user-path mh-namazu-directory
)))
1226 (unless (file-exists-p namazu-index-directory
)
1227 (error "Namazu directory %s not present" namazu-index-directory
))
1228 (unless (executable-find mh-namazu-binary
)
1229 (error "Set mh-namazu-binary appropriately"))
1230 (set-buffer (get-buffer-create mh-index-temp-buffer
))
1232 (call-process mh-namazu-binary nil
'(t nil
) nil
1233 "-alR" search-regexp namazu-index-directory
)
1234 (goto-char (point-min))
1235 (setq mh-namazu-folder
1236 (let ((last (substring folder-path
(1- (length folder-path
)))))
1237 (if (equal last
"/")
1239 (format "%s/" folder-path
))))))
1241 (defun mh-namazu-next-result ()
1242 "Get the next result from namazu output."
1245 (when (eobp) (return nil
))
1246 (let ((file-name (buffer-substring-no-properties
1247 (point) (line-end-position))))
1248 (unless (equal (string-match mh-namazu-folder file-name
) 0)
1250 (unless (file-exists-p file-name
)
1252 (string-match mh-user-path file-name
)
1253 (let* ((folder/msg
(substring file-name
(match-end 0)))
1254 (mark (mh-search-from-end ?
/ folder
/msg
)))
1255 (unless mark
(return 'error
))
1256 (list (format "+%s" (substring folder
/msg
0 mark
))
1257 (let ((n (ignore-errors (read-from-string
1258 (substring folder
/msg
(1+ mark
))))))
1259 (if (and (consp n
) (numberp (car n
)))
1267 (defun mh-index-choose ()
1268 "Choose an indexing function.
1269 The side-effects of this function are that the variables `mh-indexer',
1270 `mh-index-execute-search-function', and `mh-index-next-result-function' are
1271 set according to the first indexer in `mh-indexer-choices' present on the
1274 ;; The following favors the user's preference; otherwise, the last
1275 ;; automatically chosen indexer is used for efficiency rather than going
1276 ;; through the list.
1277 (let ((program-alist (cond (mh-index-program
1279 (assoc mh-index-program mh-indexer-choices
)))
1281 (list (assoc mh-indexer mh-indexer-choices
)))
1282 (t mh-indexer-choices
))))
1283 (while program-alist
1284 (let* ((current (pop program-alist
))
1285 (executable (symbol-value (cadr current
))))
1287 (setq mh-indexer
(car current
))
1288 (setq mh-index-execute-search-function
(nth 2 current
))
1289 (setq mh-index-next-result-function
(nth 3 current
))
1290 (setq mh-index-regexp-builder
(nth 4 current
))
1291 (return mh-indexer
))))
1298 ;;; Local Variables:
1299 ;;; indent-tabs-mode: nil
1300 ;;; sentence-end-double-space: nil
1303 ;;; mh-index ends here