Sync to HEAD
[bpt/emacs.git] / lisp / mh-e / mh-index.el
CommitLineData
bdcfe844
BW
1;;; mh-index -- MH-E interface to indexing programs
2
924df208 3;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
bdcfe844 4
c3d9274a 5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
bdcfe844
BW
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
10;; This file is part of GNU Emacs.
11
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)
15;; any later version.
16
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.
21
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.
26
27;;; Commentary:
28
29;;; (1) The following search engines are supported:
30;;; swish++
31;;; swish-e
924df208 32;;; mairix
bdcfe844
BW
33;;; namazu
34;;; glimpse
35;;; grep
a1506d29 36;;;
bdcfe844
BW
37;;; (2) To use this package, you first have to build an index. Please read
38;;; the documentation for `mh-index-search' to get started. That
39;;; documentation will direct you to the specific instructions for your
40;;; particular indexer.
bdcfe844
BW
41
42;;; Change Log:
43
bdcfe844
BW
44;;; Code:
45
46(require 'cl)
47(require 'mh-e)
48(require 'mh-mime)
3d7ca223 49(require 'mh-pick)
bdcfe844 50
bdcfe844
BW
51(autoload 'gnus-local-map-property "gnus-util")
52(autoload 'gnus-eval-format "gnus-spec")
53(autoload 'widget-convert-button "wid-edit")
54(autoload 'executable-find "executable")
55
bdcfe844
BW
56;; Support different indexing programs
57(defvar mh-indexer-choices
58 '((swish++
3d7ca223
BW
59 mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result
60 mh-swish++-regexp-builder)
bdcfe844 61 (swish
3d7ca223
BW
62 mh-swish-binary mh-swish-execute-search mh-swish-next-result nil)
63 (mairix
64 mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result
65 mh-mairix-regexp-builder)
bdcfe844 66 (namazu
3d7ca223 67 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
bdcfe844 68 (glimpse
3d7ca223
BW
69 mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil)
70 (pick
71 mh-pick-binary mh-pick-execute-search mh-pick-next-result
72 mh-pick-regexp-builder)
bdcfe844 73 (grep
3d7ca223 74 mh-grep-binary mh-grep-execute-search mh-grep-next-result nil))
bdcfe844
BW
75 "List of possible indexer choices.")
76(defvar mh-indexer nil
77 "Chosen index program.")
78(defvar mh-index-execute-search-function nil
79 "Function which executes the search program.")
80(defvar mh-index-next-result-function nil
81 "Function to parse the next line of output.")
3d7ca223
BW
82(defvar mh-index-regexp-builder nil
83 "Function used to construct search regexp.")
bdcfe844 84
c3d9274a
BW
85;; FIXME: This should be a defcustom...
86(defvar mh-index-folder "+mhe-index"
87 "Folder that contains the folders resulting from the index searches.")
88
89;; Temporary buffers for search results
bdcfe844 90(defvar mh-index-temp-buffer " *mh-index-temp*")
c3d9274a
BW
91(defvar mh-checksum-buffer " *mh-checksum-buffer*")
92
93\f
bdcfe844 94
c3d9274a
BW
95;;; A few different checksum programs are supported. The supported programs
96;;; are:
97;;; 1. md5sum
98;;; 2. md5
99;;; 3. openssl
100;;;
101;;; To add support for your favorite checksum program add a clause to the cond
102;;; statement in mh-checksum-choose. This should set the variable
103;;; mh-checksum-cmd to the command line needed to run the checsum program and
104;;; should set mh-checksum-parser to a function which returns a cons cell
105;;; containing the message number and checksum string.
106
107(defvar mh-checksum-cmd)
108(defvar mh-checksum-parser)
109
110(defun mh-checksum-choose ()
111 "Check if a program to create a checksum is present."
112 (unless (boundp 'mh-checksum-cmd)
113 (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
114 (cond ((executable-find "md5sum")
115 (setq mh-checksum-cmd (list (executable-find "md5sum")))
116 (setq mh-checksum-parser #'mh-md5sum-parser))
117 ((executable-find "openssl")
118 (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
119 (setq mh-checksum-parser #'mh-openssl-parser))
120 ((executable-find "md5")
121 (setq mh-checksum-cmd (list (executable-find "md5")))
122 (setq mh-checksum-parser #'mh-md5-parser))
123 (t (error "No suitable checksum program"))))))
124
125(defun mh-md5sum-parser ()
126 "Parse md5sum output."
127 (let ((begin (line-beginning-position))
128 (end (line-end-position))
129 first-space last-slash)
130 (setq first-space (search-forward " " end t))
131 (goto-char end)
132 (setq last-slash (search-backward "/" begin t))
133 (cond ((and first-space last-slash)
134 (cons (car (read-from-string (buffer-substring-no-properties
135 (1+ last-slash) end)))
136 (buffer-substring-no-properties begin (1- first-space))))
137 (t (cons nil nil)))))
138
139(defun mh-openssl-parser ()
140 "Parse openssl output."
141 (let ((begin (line-beginning-position))
142 (end (line-end-position))
143 last-space last-slash)
144 (goto-char end)
145 (setq last-space (search-backward " " begin t))
146 (setq last-slash (search-backward "/" begin t))
147 (cond ((and last-slash last-space)
148 (cons (car (read-from-string (buffer-substring-no-properties
149 (1+ last-slash) (1- last-space))))
150 (buffer-substring-no-properties (1+ last-space) end))))))
151
152(defalias 'mh-md5-parser 'mh-openssl-parser)
bdcfe844
BW
153
154\f
155
c3d9274a 156;;; Make sure that we don't produce too long a command line.
bdcfe844 157
c3d9274a
BW
158(defvar mh-index-max-cmdline-args 500
159 "Maximum number of command line args.")
160
161(defun mh-index-execute (cmd &rest args)
162 "Partial imitation of xargs.
163The current buffer contains a list of strings, one on each line. The function
164will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
165strings to it. This is repeated till all the strings have been used."
166 (goto-char (point-min))
924df208
BW
167 (let ((current-buffer (current-buffer)))
168 (with-temp-buffer
169 (let ((out (current-buffer)))
170 (set-buffer current-buffer)
171 (while (not (eobp))
172 (let ((arg-list (reverse args))
173 (count 0))
174 (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
175 (push (buffer-substring-no-properties (point) (line-end-position))
176 arg-list)
177 (incf count)
178 (forward-line))
179 (apply #'call-process cmd nil (list out nil) nil
180 (nreverse arg-list))))
181 (erase-buffer)
182 (insert-buffer-substring out)))))
bdcfe844
BW
183
184\f
185
c3d9274a
BW
186(defun mh-index-update-single-msg (msg checksum origin-map)
187 "Update various maps for one message.
188MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
189non-nil, a hashtable containing which maps each message in the index folder to
190the folder and message that it was copied from. The function updates the hash
191tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
192
193This 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))))
203 (t
204 (setf (gethash msg mh-index-msg-checksum-map) checksum)
205 (when origin-map
206 (setf (gethash checksum mh-index-checksum-origin-map)
207 (gethash msg origin-map))))))
208
209;;;###mh-autoload
210(defun mh-index-update-maps (folder &optional origin-map)
211 "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
212As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
213is a hashtable which maps each message in the index folder to the original
214folder and message from whence it was copied. If present the
215checksum -> (origin-folder, origin-index) map is updated too."
216 (clrhash mh-index-msg-checksum-map)
217 (save-excursion
218 ;; Clear temp buffer
219 (set-buffer (get-buffer-create mh-checksum-buffer))
220 (erase-buffer)
221 ;; Run scan to check if any messages needs MD5 annotations at all
222 (with-temp-buffer
223 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
224 "-format" "%(msg)\n%{x-mhe-checksum}\n"
225 folder "all")
226 (goto-char (point-min))
227 (let (msg checksum)
228 (while (not (eobp))
229 (setq msg (buffer-substring-no-properties
230 (point) (line-end-position)))
231 (forward-line)
232 (save-excursion
924df208
BW
233 (cond ((not (string-match "^[0-9]*$" msg)))
234 ((eolp)
c3d9274a
BW
235 ;; need to compute checksum
236 (set-buffer mh-checksum-buffer)
237 (insert mh-user-path (substring folder 1) "/" msg "\n"))
238 (t
239 ;; update maps
240 (setq checksum (buffer-substring-no-properties
241 (point) (line-end-position)))
242 (let ((msg (car (read-from-string msg))))
243 (set-buffer folder)
244 (mh-index-update-single-msg msg checksum origin-map)))))
245 (forward-line))))
246 ;; Run checksum program if needed
247 (unless (and (eobp) (bobp))
248 (apply #'mh-index-execute mh-checksum-cmd)
249 (goto-char (point-min))
250 (while (not (eobp))
251 (let* ((intermediate (funcall mh-checksum-parser))
252 (msg (car intermediate))
253 (checksum (cdr intermediate)))
254 (when msg
255 ;; annotate
256 (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
257 "-nodate" "-text" checksum "-inplace")
258 ;; update maps
259 (save-excursion
260 (set-buffer folder)
261 (mh-index-update-single-msg msg checksum origin-map)))
262 (forward-line))))))
263
924df208
BW
264(defvar mh-flists-results-folder "new"
265 "Subfolder for `mh-index-folder' where flists output is placed.")
266
c3d9274a
BW
267(defun mh-index-generate-pretty-name (string)
268 "Given STRING generate a name which is suitable for use as a folder name.
269White space from the beginning and end are removed. All spaces in the name are
270replaced with underscores and all / are replaced with $. If STRING is longer
3d7ca223
BW
271than 20 it is truncated too. STRING could be a list of strings in which case
272they are concatenated to construct the base name."
c3d9274a 273 (with-temp-buffer
3d7ca223
BW
274 (if (stringp string)
275 (insert string)
276 (when (car string) (insert (car string)))
277 (dolist (s (cdr string))
278 (insert "_" s)))
279 (setq string (mh-replace-string "-lbrace" " "))
280 (setq string (mh-replace-string "-rbrace" " "))
281 (subst-char-in-region (point-min) (point-max) ?( ? t)
282 (subst-char-in-region (point-min) (point-max) ?) ? t)
283 (subst-char-in-region (point-min) (point-max) ?- ? t)
c3d9274a 284 (goto-char (point-min))
3d7ca223 285 (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_)))
c3d9274a
BW
286 (delete-char 1))
287 (goto-char (point-max))
3d7ca223 288 (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_)))
c3d9274a 289 (delete-backward-char 1))
3d7ca223 290 (subst-char-in-region (point-min) (point-max) ? ?_ t)
c3d9274a
BW
291 (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
292 (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
293 (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
294 (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
924df208
BW
295 (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)))))
c3d9274a
BW
299
300;;;###mh-autoload
3d7ca223 301(defun* mh-index-search (redo-search-flag folder search-regexp
924df208 302 &optional window-config unseen-flag)
bdcfe844 303 "Perform an indexed search in an MH mail folder.
924df208 304Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
bdcfe844 305
c3d9274a
BW
306If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
307index search, then the search is repeated. Otherwise, FOLDER is searched with
308SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
3d7ca223
BW
309\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
310stores the window configuration that will be restored after the user quits the
924df208
BW
311folder containing the index search results. If optional argument UNSEEN-FLAG
312is non-nil, then all the messages are marked as unseen.
bdcfe844
BW
313
314Four indexing programs are supported; if none of these are present, then grep
315is used. This function picks the first program that is available on your
316system. If you would prefer to use a different program, set the customization
317variable `mh-index-program' accordingly.
318
319The documentation for the following functions describes how to generate the
320index for each program:
321
322 - `mh-swish++-execute-search'
323 - `mh-swish-execute-search'
3d7ca223 324 - `mh-mairix-execute-search'
bdcfe844 325 - `mh-namazu-execute-search'
c3d9274a
BW
326 - `mh-glimpse-execute-search'
327
3d7ca223
BW
328If none of these programs are present then we use pick. If desired grep can be
329used instead. Details about these methods can be found in:
330
331 - `mh-pick-execute-search'
332 - `mh-grep-execute-search'
333
c3d9274a
BW
334This and related functions use an X-MHE-Checksum header to cache the MD5
335checksum of a message. This means that already present X-MHE-Checksum headers
336in the incoming email could result in messages not being found. The following
337procmail recipe should avoid this:
338
339 :0 wf
340 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
341
342This has the effect of renaming already present X-MHE-Checksum headers."
bdcfe844 343 (interactive
c3d9274a
BW
344 (list current-prefix-arg
345 (progn
bdcfe844 346 (unless mh-find-path-run (mh-find-path))
c3d9274a 347 (or (and current-prefix-arg (car mh-index-previous-search))
3d7ca223 348 (mh-prompt-for-folder "Search" "+" nil "all" t)))
bdcfe844
BW
349 (progn
350 ;; Yes, we do want to call mh-index-choose every time in case the
351 ;; user has switched the indexer manually.
352 (unless (mh-index-choose) (error "No indexing program found"))
c3d9274a 353 (or (and current-prefix-arg (cadr mh-index-previous-search))
3d7ca223 354 mh-index-regexp-builder
c3d9274a
BW
355 (read-string (format "%s regexp: "
356 (upcase-initials
3d7ca223
BW
357 (symbol-name mh-indexer))))))
358 (if (and (not
359 (and current-prefix-arg (cadr mh-index-previous-search)))
360 mh-index-regexp-builder)
361 (current-window-configuration)
362 nil)))
363 (when (symbolp search-regexp)
364 (mh-search-folder folder window-config)
365 (setq mh-searching-function 'mh-index-do-search)
366 (return-from mh-index-search))
c3d9274a
BW
367 (mh-checksum-choose)
368 (let ((result-count 0)
3d7ca223 369 (old-window-config (or window-config mh-previous-window-config))
c3d9274a
BW
370 (previous-search mh-index-previous-search)
371 (index-folder (format "%s/%s" mh-index-folder
372 (mh-index-generate-pretty-name search-regexp))))
373 ;; Create a new folder for the search results or recreate the old one...
374 (if (and redo-search-flag mh-index-previous-search)
375 (let ((buffer-name (buffer-name (current-buffer))))
376 (mh-process-or-undo-commands buffer-name)
377 (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
378 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
379 (setq index-folder buffer-name))
380 (setq index-folder (mh-index-new-folder index-folder)))
381
382 (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
383 (folder-results-map (make-hash-table :test #'equal))
384 (origin-map (make-hash-table :test #'equal)))
bdcfe844 385 ;; Run search program...
c3d9274a 386 (message "Executing %s... " mh-indexer)
bdcfe844
BW
387 (funcall mh-index-execute-search-function folder-path search-regexp)
388
c3d9274a 389 ;; Parse indexer output
bdcfe844
BW
390 (message "Processing %s output... " mh-indexer)
391 (goto-char (point-min))
c3d9274a 392 (loop for next-result = (funcall mh-index-next-result-function)
924df208 393 while next-result
c3d9274a
BW
394 do (unless (eq next-result 'error)
395 (unless (gethash (car next-result) folder-results-map)
396 (setf (gethash (car next-result) folder-results-map)
397 (make-hash-table :test #'equal)))
398 (setf (gethash (cadr next-result)
399 (gethash (car next-result) folder-results-map))
400 t)))
401
402 ;; Copy the search results over
403 (maphash #'(lambda (folder msgs)
404 (let ((msgs (sort (loop for msg being the hash-keys of msgs
405 collect msg)
406 #'<)))
407 (mh-exec-cmd "refile" msgs "-src" folder
408 "-link" index-folder)
409 (loop for msg in msgs
410 do (incf result-count)
411 (setf (gethash result-count origin-map)
412 (cons folder msg)))))
413 folder-results-map)
bdcfe844 414
924df208
BW
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
bdcfe844 420 ;; Generate scan lines for the hits.
924df208 421 (mh-visit-folder index-folder () (list folder-results-map origin-map))
c3d9274a 422
bdcfe844
BW
423 (goto-char (point-min))
424 (forward-line)
c3d9274a
BW
425 (mh-update-sequences)
426 (mh-recenter nil)
427
428 ;; Maintain history
3d7ca223 429 (when (or (and redo-search-flag previous-search) window-config)
c3d9274a
BW
430 (setq mh-previous-window-config old-window-config))
431 (setq mh-index-previous-search (list folder search-regexp))
bdcfe844 432
bdcfe844
BW
433 (message "%s found %s matches in %s folders"
434 (upcase-initials (symbol-name mh-indexer))
c3d9274a
BW
435 (loop for msg-hash being hash-values of mh-index-data
436 sum (hash-table-count msg-hash))
437 (loop for msg-hash being hash-values of mh-index-data
438 count (> (hash-table-count msg-hash) 0))))))
439
3d7ca223
BW
440;;;###mh-autoload
441(defun mh-index-do-search ()
442 "Construct appropriate regexp and call `mh-index-search'."
443 (interactive)
444 (unless (mh-index-choose) (error "No indexing program found"))
445 (let* ((regexp-list (mh-pick-parse-search-buffer))
446 (pattern (funcall mh-index-regexp-builder regexp-list)))
447 (if pattern
448 (mh-index-search nil mh-current-folder pattern
449 mh-previous-window-config)
450 (error "No search terms"))))
451
452(defun mh-replace-string (old new)
453 "Replace all occurrences of OLD with NEW in the current buffer."
454 (goto-char (point-min))
455 (while (search-forward old nil t)
456 (replace-match new)))
457
458;;;###mh-autoload
459(defun mh-index-parse-search-regexp (input-string)
460 "Construct parse tree for INPUT-STRING.
461All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by AND, OR and
462NOT as appropriate. Then the resulting string is parsed."
463 (let (input)
464 (with-temp-buffer
465 (insert input-string)
466 (downcase-region (point-min) (point-max))
467 ;; replace tabs
468 (mh-replace-string "\t" " ")
469 ;; synonyms of AND
470 (mh-replace-string "&" " and ")
471 (mh-replace-string " -and " " and ")
472 ;; synonyms of OR
473 (mh-replace-string "|" " or ")
474 (mh-replace-string " -or " " or ")
475 ;; synonyms of NOT
476 (mh-replace-string "!" " not ")
477 (mh-replace-string "~" " not ")
478 (mh-replace-string " -not " " not ")
479 ;; synonyms of left brace
480 (mh-replace-string "(" " ( ")
481 (mh-replace-string " -lbrace " " ( ")
482 ;; synonyms of right brace
483 (mh-replace-string ")" " ) ")
484 (mh-replace-string " -rbrace " " ) ")
485 ;; get the normalized input
486 (setq input (format "( %s )" (buffer-substring (point-min) (point-max)))))
487
488 (let ((tokens (mh-index-add-implicit-ops (split-string input)))
489 (op-stack ())
490 (operand-stack ())
491 oper1)
492 (dolist (token tokens)
493 (cond ((equal token "(") (push 'paren op-stack))
494 ((equal token "not") (push 'not op-stack))
495 ((equal token "or") (push 'or op-stack))
496 ((equal token "and") (push 'and op-stack))
497 ((equal token ")")
498 (multiple-value-setq (op-stack operand-stack)
499 (mh-index-evaluate op-stack operand-stack))
500 (when (eq (car op-stack) 'not)
501 (pop op-stack)
502 (push `(not ,(pop operand-stack)) operand-stack))
503 (when (eq (car op-stack) 'and)
504 (pop op-stack)
505 (setq oper1 (pop operand-stack))
506 (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
507 ((eq (car op-stack) 'not)
508 (pop op-stack)
509 (push `(not ,token) operand-stack)
510 (when (eq (car op-stack) 'and)
511 (pop op-stack)
512 (setq oper1 (pop operand-stack))
513 (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
514 ((eq (car op-stack) 'and)
515 (pop op-stack)
516 (push `(and ,(pop operand-stack) ,token) operand-stack))
517 (t (push token operand-stack))))
518 (prog1 (pop operand-stack)
519 (when (or op-stack operand-stack)
520 (error "Invalid regexp: %s" input))))))
521
522(defun mh-index-add-implicit-ops (tokens)
523 "Add implicit operators in the list TOKENS."
524 (let ((result ())
525 (literal-seen nil)
526 current)
527 (while tokens
528 (setq current (pop tokens))
529 (cond ((or (equal current ")") (equal current "and") (equal current "or"))
530 (setq literal-seen nil)
531 (push current result))
532 ((and literal-seen
533 (push "and" result)
534 (setq literal-seen nil)
535 nil))
536 (t
537 (push current result)
538 (unless (or (equal current "(") (equal current "not"))
539 (setq literal-seen t)))))
540 (nreverse result)))
541
542(defun mh-index-evaluate (op-stack operand-stack)
543 "Read expression till starting paren based on OP-STACK and OPERAND-STACK."
544 (block mh-index-evaluate
545 (let (op oper1)
546 (while op-stack
547 (setq op (pop op-stack))
548 (cond ((eq op 'paren)
549 (return-from mh-index-evaluate (values op-stack operand-stack)))
550 ((eq op 'not)
551 (push `(not ,(pop operand-stack)) operand-stack))
552 ((or (eq op 'and) (eq op 'or))
553 (setq oper1 (pop operand-stack))
554 (push `(,op ,(pop operand-stack) ,oper1) operand-stack))))
555 (error "Ran out of tokens"))))
556
c3d9274a
BW
557;;;###mh-autoload
558(defun mh-index-next-folder (&optional backward-flag)
559 "Jump to the next folder marker.
560The function is only applicable to folders displaying index search results.
561With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
562results."
563 (interactive "P")
924df208
BW
564 (if (null mh-index-data)
565 (message "Only applicable in an MH-E index search buffer")
c3d9274a
BW
566 (let ((point (point)))
567 (forward-line (if backward-flag -1 1))
568 (cond ((if backward-flag
569 (re-search-backward "^+" (point-min) t)
570 (re-search-forward "^+" (point-max) t))
571 (beginning-of-line))
572 ((and (if backward-flag
573 (goto-char (point-max))
574 (goto-char (point-min)))
575 nil))
576 ((if backward-flag
577 (re-search-backward "^+" (point-min) t)
578 (re-search-forward "^+" (point-max) t))
579 (beginning-of-line))
580 (t (goto-char point))))))
581
582;;;###mh-autoload
583(defun mh-index-previous-folder ()
584 "Jump to the previous folder marker."
bdcfe844 585 (interactive)
c3d9274a
BW
586 (mh-index-next-folder t))
587
588(defun mh-folder-exists-p (folder)
589 "Check if FOLDER exists."
590 (and (mh-folder-name-p folder)
591 (save-excursion
592 (with-temp-buffer
593 (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
594 (goto-char (point-min))
595 (not (eobp))))))
596
597(defun mh-msg-exists-p (msg folder)
598 "Check if MSG exists in FOLDER."
599 (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
600
601(defun mh-index-new-folder (name)
602 "Create and return an MH folder name based on NAME.
603If the folder NAME already exists then check if NAME<2> exists. If it doesn't
604then it is created and returned. Otherwise try NAME<3>. This is repeated till
605we find a new folder name."
606 (unless (mh-folder-name-p name)
607 (error "The argument should be a valid MH folder name"))
608 (let ((chosen-name name))
609 (block unique-name
610 (unless (mh-folder-exists-p name)
611 (return-from unique-name))
612 (loop for index from 2
613 do (let ((new-name (format "%s<%s>" name index)))
614 (unless (mh-folder-exists-p new-name)
615 (setq chosen-name new-name)
616 (return-from unique-name)))))
617 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
3d7ca223 618 (mh-remove-from-sub-folders-cache chosen-name)
c3d9274a
BW
619 (when (boundp 'mh-speed-folder-map)
620 (mh-speed-add-folder chosen-name))
c3d9274a
BW
621 chosen-name))
622
623;;;###mh-autoload
624(defun mh-index-insert-folder-headers ()
625 "Annotate the search results with original folder names."
626 (let ((cur-msg (mh-get-msg-num nil))
627 (old-buffer-modified-flag (buffer-modified-p))
628 (buffer-read-only nil)
629 current-folder last-folder)
bdcfe844 630 (goto-char (point-min))
c3d9274a
BW
631 (while (not (eobp))
632 (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
633 mh-index-msg-checksum-map)
634 mh-index-checksum-origin-map)))
635 (when (and current-folder (not (eq current-folder last-folder)))
636 (insert (if last-folder "\n" "") current-folder "\n")
637 (setq last-folder current-folder))
638 (forward-line))
639 (when cur-msg (mh-goto-msg cur-msg t))
640 (set-buffer-modified-p old-buffer-modified-flag)))
641
924df208
BW
642;;;###mh-autoload
643(defun mh-index-group-by-folder ()
644 "Partition the messages based on source folder.
645Returns an alist with the the folder names in the car and the cdr being the
646list 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
c3d9274a
BW
658;;;###mh-autoload
659(defun mh-index-delete-folder-headers ()
660 "Delete the folder headers."
661 (let ((cur-msg (mh-get-msg-num nil))
662 (old-buffer-modified-flag (buffer-modified-p))
663 (buffer-read-only nil))
3d7ca223
BW
664 (while (and (not cur-msg) (not (eobp)))
665 (forward-line)
666 (setq cur-msg (mh-get-msg-num nil)))
c3d9274a
BW
667 (goto-char (point-min))
668 (while (not (eobp))
669 (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
670 (delete-region (point) (progn (forward-line) (point)))
bdcfe844 671 (forward-line)))
c3d9274a
BW
672 (when cur-msg (mh-goto-msg cur-msg t t))
673 (set-buffer-modified-p old-buffer-modified-flag)))
bdcfe844 674
c3d9274a
BW
675;;;###mh-autoload
676(defun mh-index-visit-folder ()
677 "Visit original folder from where the message at point was found."
bdcfe844 678 (interactive)
c3d9274a
BW
679 (unless mh-index-data
680 (error "Not in an index folder"))
681 (let (folder msg)
682 (save-excursion
683 (cond ((and (bolp) (eolp))
684 (ignore-errors (forward-line -1))
685 (setq msg (mh-get-msg-num t)))
686 ((equal (char-after (line-beginning-position)) ?+)
687 (setq folder (buffer-substring-no-properties
688 (line-beginning-position) (line-end-position))))
689 (t (setq msg (mh-get-msg-num t)))))
690 (when (not folder)
691 (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
692 mh-index-checksum-origin-map))))
924df208
BW
693 (when (or (not (get-buffer folder))
694 (y-or-n-p (format "Reuse buffer displaying %s? " folder)))
695 (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'.
702Also `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"))))
c3d9274a
BW
715
716(defun mh-index-match-checksum (msg folder checksum)
717 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
718 (with-temp-buffer
719 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
720 "-format" "%{x-mhe-checksum}\n" folder msg)
721 (goto-char (point-min))
722 (string-equal (buffer-substring-no-properties (point) (line-end-position))
723 checksum)))
724
725;;;###mh-autoload
726(defun mh-index-execute-commands ()
727 "Delete/refile the actual messages.
728The copies in the searched folder are then deleted/refiled to get the desired
729result. Before deleting the messages we make sure that the message being
730deleted is identical to the one that the user has marked in the index buffer."
731 (let ((message-table (make-hash-table :test #'equal)))
732 (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
733 (dolist (msg msg-list)
734 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
735 (pair (gethash checksum mh-index-checksum-origin-map)))
736 (when (and checksum (car pair) (cdr pair)
737 (mh-index-match-checksum (cdr pair) (car pair) checksum))
738 (push (cdr pair) (gethash (car pair) message-table))
739 (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
740 (maphash (lambda (folder msgs)
741 (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
742 message-table)))
bdcfe844
BW
743
744\f
745
746;; Glimpse interface
747
748(defvar mh-glimpse-binary (executable-find "glimpse"))
749(defvar mh-glimpse-directory ".glimpse")
750
c3d9274a 751;;;###mh-autoload
bdcfe844
BW
752(defun mh-glimpse-execute-search (folder-path search-regexp)
753 "Execute glimpse and read the results.
754
755In the examples below, replace /home/user/Mail with the path to your MH
756directory.
757
758First create the directory /home/user/Mail/.glimpse. Then create the file
759/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
760
761 */.*
762 */#*
763 */,*
764 */*~
765 ^/home/user/Mail/.glimpse
c3d9274a 766 ^/home/user/Mail/mhe-index
bdcfe844
BW
767
768If there are any directories you would like to ignore, append lines like the
769following to .glimpse_exclude:
770
771 ^/home/user/Mail/scripts
772
c3d9274a
BW
773You do not want to index the folders that hold the results of your searches
774since they tend to be ephemeral and the original messages are indexed anyway.
775The configuration file above assumes that the results are found in sub-folders
776of `mh-index-folder' which is +mhe-index by default.
777
bdcfe844
BW
778Use the following command line to generate the glimpse index. Run this
779daily from cron:
780
781 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
782
783FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
784 (set-buffer (get-buffer-create mh-index-temp-buffer))
785 (erase-buffer)
786 (call-process mh-glimpse-binary nil '(t nil) nil
c3d9274a 787 ;(format "-%s" fuzz)
bdcfe844 788 "-i" "-y"
c3d9274a 789 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
bdcfe844
BW
790 "-F" (format "^%s" folder-path)
791 search-regexp)
792 (goto-char (point-min)))
793
794(defun mh-glimpse-next-result ()
795 "Read the next result.
796Parse it and return the message folder, message index and the match. If no
797other matches left then return nil. If the current record is invalid return
798'error."
799 (prog1
c3d9274a
BW
800 (block nil
801 (when (eobp)
802 (return nil))
803 (let ((eol-pos (line-end-position))
804 (bol-pos (line-beginning-position))
805 folder-start msg-end)
806 (goto-char bol-pos)
807 (unless (search-forward mh-user-path eol-pos t)
bdcfe844 808 (return 'error))
c3d9274a
BW
809 (setq folder-start (point))
810 (unless (search-forward ": " eol-pos t)
811 (return 'error))
812 (let ((match (buffer-substring-no-properties (point) eol-pos)))
813 (forward-char -2)
814 (setq msg-end (point))
815 (unless (search-backward "/" folder-start t)
816 (return 'error))
817 (list (format "+%s" (buffer-substring-no-properties
818 folder-start (point)))
819 (let ((val (ignore-errors (read-from-string
820 (buffer-substring-no-properties
821 (1+ (point)) msg-end)))))
822 (if (and (consp val) (integerp (car val)))
823 (car val)
824 (return 'error)))
825 match))))
bdcfe844
BW
826 (forward-line)))
827
828\f
829
3d7ca223
BW
830;; Pick interface
831
832(defvar mh-index-pick-folder)
833(defvar mh-pick-binary "pick")
834
835(defun mh-pick-execute-search (folder-path search-regexp)
836 "Execute pick.
837
838Unlike the other index search programs \"pick\" only searches messages present
839in the folder itself and does not descend into any sub-folders that may be
840present.
841
842FOLDER-PATH is the directory containing the mails to be searched and
843SEARCH-REGEXP is the pattern that pick gets."
844 (set-buffer (get-buffer-create mh-index-temp-buffer))
845 (erase-buffer)
846 (setq mh-index-pick-folder
847 (concat "+" (substring folder-path (length mh-user-path))))
848 (apply #'call-process (expand-file-name "pick" mh-progs) nil '(t nil) nil
849 mh-index-pick-folder "-list" search-regexp)
850 (goto-char (point-min)))
851
852(defun mh-pick-next-result ()
853 "Return the next pick search result."
854 (prog1 (block nil
855 (when (eobp) (return nil))
856 (unless (re-search-forward "^[1-9][0-9]*$" (line-end-position) t)
857 (return 'error))
858 (list mh-index-pick-folder
859 (car (read-from-string (buffer-substring-no-properties
860 (line-beginning-position)
861 (line-end-position))))
862 nil))
863 (forward-line)))
864
865\f
866
bdcfe844
BW
867;; Grep interface
868
869(defvar mh-grep-binary (executable-find "grep"))
870
871(defun mh-grep-execute-search (folder-path search-regexp)
872 "Execute grep and read the results.
873FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
874 (set-buffer (get-buffer-create mh-index-temp-buffer))
875 (erase-buffer)
876 (call-process mh-grep-binary nil '(t nil) nil
877 "-i" "-r" search-regexp folder-path)
878 (goto-char (point-min)))
879
880(defun mh-grep-next-result ()
881 "Read the next result.
882Parse it and return the message folder, message index and the match. If no
883other matches left then return nil. If the current record is invalid return
884'error."
885 (prog1
c3d9274a
BW
886 (block nil
887 (when (eobp)
888 (return nil))
889 (let ((eol-pos (line-end-position))
890 (bol-pos (line-beginning-position))
891 folder-start msg-end)
892 (goto-char bol-pos)
893 (unless (search-forward mh-user-path eol-pos t)
bdcfe844 894 (return 'error))
c3d9274a
BW
895 (setq folder-start (point))
896 (unless (search-forward ":" eol-pos t)
897 (return 'error))
898 (let ((match (buffer-substring-no-properties (point) eol-pos)))
899 (forward-char -1)
900 (setq msg-end (point))
901 (unless (search-backward "/" folder-start t)
902 (return 'error))
903 (list (format "+%s" (buffer-substring-no-properties
904 folder-start (point)))
905 (let ((val (ignore-errors (read-from-string
906 (buffer-substring-no-properties
907 (1+ (point)) msg-end)))))
908 (if (and (consp val) (integerp (car val)))
909 (car val)
910 (return 'error)))
911 match))))
bdcfe844
BW
912 (forward-line)))
913
914\f
915
3d7ca223
BW
916;; Mairix interface
917
918(defvar mh-mairix-binary (executable-find "mairix"))
919(defvar mh-mairix-directory ".mairix")
920(defvar mh-mairix-folder nil)
921
922(defun mh-mairix-execute-search (folder-path search-regexp-list)
923 "Execute mairix and read the results.
924
925In the examples below replace /home/user/Mail with the path to your MH
926directory.
927
928First create the directory /home/user/Mail/.mairix. Then create the file
929/home/user/Mail/.mairix/config with the following contents:
930
931 # This should contain the same thing as your `mh-user-path'
932 base=/home/user/Mail
a1506d29 933
3d7ca223
BW
934 # List of folders that should be indexed. 3 dots at the end means there are
935 # subfolders within the folder
936 mh_folders=archive...:inbox:drafts:news:sent:trash
a1506d29 937
3d7ca223
BW
938 vfolder_format=raw
939 database=/home/user/Mail/mairix/database
940
941Use the following command line to generate the mairix index. Run this daily
942from cron:
943
944 mairix -f /home/user/Mail/.mairix/config
945
946FOLDER-PATH is the directory in which SEARCH-REGEXP-LIST is used to search."
947 (set-buffer (get-buffer-create mh-index-temp-buffer))
948 (erase-buffer)
949 (unless mh-mairix-binary
950 (error "Set mh-mairix-binary appropriately"))
951 (apply #'call-process mh-mairix-binary nil '(t nil) nil
952 "-f" (format "%s%s/config" mh-user-path mh-mairix-directory)
953 search-regexp-list)
954 (goto-char (point-min))
955 (setq mh-mairix-folder
956 (let ((last-char (substring folder-path (1- (length folder-path)))))
957 (if (equal last-char "/")
958 folder-path
959 (format "%s/" folder-path)))))
960
961(defun mh-mairix-next-result ()
962 "Return next result from mairix output."
963 (prog1
964 (block nil
965 (when (or (eobp) (and (bolp) (eolp)))
966 (return nil))
967 (unless (eq (char-after) ?/)
924df208 968 (return 'error))
3d7ca223
BW
969 (let ((start (point))
970 end msg-start)
971 (setq end (line-end-position))
972 (unless (search-forward mh-mairix-folder end t)
973 (return 'error))
974 (goto-char (match-beginning 0))
975 (unless (equal (point) start)
976 (return 'error))
977 (goto-char end)
978 (unless (search-backward "/" start t)
979 (return 'error))
980 (setq msg-start (1+ (point)))
981 (goto-char start)
982 (unless (search-forward mh-user-path end t)
983 (return 'error))
984 (list (format "+%s" (buffer-substring-no-properties
985 (point) (1- msg-start)))
986 (car (read-from-string
987 (buffer-substring-no-properties msg-start end)))
988 ())))
989 (forward-line)))
990
991(defun mh-mairix-regexp-builder (regexp-list)
992 "Generate query for mairix.
993REGEXP-LIST is an alist of fields and values."
994 (let ((result ()))
995 (dolist (pair regexp-list)
996 (when (cdr pair)
997 (push
998 (concat
999 (cond ((eq (car pair) 'to) "t:")
1000 ((eq (car pair) 'from) "f:")
1001 ((eq (car pair) 'cc) "c:")
1002 ((eq (car pair) 'subject) "s:")
1003 ((eq (car pair) 'date) "d:")
1004 (t ""))
1005 (let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair))))
1006 (final ""))
1007 (dolist (conjunct sop)
1008 (let ((expr-list (cdr conjunct))
1009 (expr-string ""))
1010 (dolist (e expr-list)
1011 (setq expr-string (concat expr-string "+"
1012 (if (atom e) "" "~")
1013 (if (atom e) e (cadr e)))))
1014 (setq final (concat final "," (substring expr-string 1)))))
1015 (substring final 1)))
1016 result)))
1017 result))
1018
1019(defun mh-mairix-convert-to-sop* (expr)
1020 "Convert EXPR to sum of product form."
1021 (cond ((atom expr) `(or (and ,expr)))
1022 ((eq (car expr) 'or)
1023 (cons 'or
1024 (loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr))
1025 append (cdr e))))
1026 ((eq (car expr) 'and)
1027 (let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr)))
1028 result next-factor)
1029 (setq result (pop conjuncts))
1030 (while conjuncts
1031 (setq next-factor (pop conjuncts))
1032 (setq result (let ((res ()))
1033 (dolist (t1 (cdr result))
1034 (dolist (t2 (cdr next-factor))
1035 (push `(and ,@(cdr t1) ,@(cdr t2)) res)))
1036 (cons 'or res))))
1037 result))
1038 ((atom (cadr expr)) `(or (and ,expr)))
1039 ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr)))
1040 ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop*
1041 `(or ,@(mapcar #'(lambda (x) `(not ,x))
1042 (cdadr expr)))))
1043 ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
1044 `(and ,@(mapcar #'(lambda (x) `(not ,x))
1045 (cdadr expr)))))
1046 (t (error "Unreachable: %s" expr))))
1047
1048\f
1049
924df208
BW
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'.
1056If `mh-recursive-folders-flag' is t, then the folders are searched
1057recursively. 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.
1079All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed.
1080By default the folders specified by `mh-index-new-messages-folders' are
1081searched. With a prefix argument, enter a space-separated list of folders, or
1082nothing 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\f
1111
bdcfe844
BW
1112;; Swish interface
1113
1114(defvar mh-swish-binary (executable-find "swish-e"))
1115(defvar mh-swish-directory ".swish")
1116(defvar mh-swish-folder nil)
1117
c3d9274a 1118;;;###mh-autoload
bdcfe844
BW
1119(defun mh-swish-execute-search (folder-path search-regexp)
1120 "Execute swish-e and read the results.
1121
1122In the examples below, replace /home/user/Mail with the path to your MH
1123directory.
1124
1125First create the directory /home/user/Mail/.swish. Then create the file
1126/home/user/Mail/.swish/config with the following contents:
1127
1128 IndexDir /home/user/Mail
1129 IndexFile /home/user/Mail/.swish/index
1130 IndexName \"Mail Index\"
1131 IndexDescription \"Mail Index\"
1132 IndexPointer \"http://nowhere\"
1133 IndexAdmin \"nobody\"
1134 #MetaNames automatic
1135 IndexReport 3
1136 FollowSymLinks no
1137 UseStemming no
1138 IgnoreTotalWordCountWhenRanking yes
1139 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
1140 BeginCharacters abcdefghijklmnopqrstuvwxyz
1141 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
1142 IgnoreLimit 50 1000
1143 IndexComments 0
1144 FileRules pathname contains /home/user/Mail/.swish
c3d9274a 1145 FileRules pathname contains /home/user/Mail/mhe-index
bdcfe844 1146 FileRules filename is index
3d7ca223 1147 FileRules filename is \\..*
bdcfe844
BW
1148 FileRules filename is #.*
1149 FileRules filename is ,.*
1150 FileRules filename is .*~
1151
1152If there are any directories you would like to ignore, append lines like the
1153following to config:
1154
1155 FileRules pathname contains /home/user/Mail/scripts
1156
c3d9274a
BW
1157You do not want to index the folders that hold the results of your searches
1158since they tend to be ephemeral and the original messages are indexed anyway.
1159The configuration file above assumes that the results are found in sub-folders
1160of `mh-index-folder' which is +mhe-index by default.
1161
bdcfe844
BW
1162Use the following command line to generate the swish index. Run this
1163daily from cron:
1164
1165 swish-e -c /home/user/Mail/.swish/config
1166
1167FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1168 (set-buffer (get-buffer-create mh-index-temp-buffer))
1169 (erase-buffer)
1170 (unless mh-swish-binary
1171 (error "Set mh-swish-binary appropriately"))
1172 (call-process mh-swish-binary nil '(t nil) nil
1173 "-w" search-regexp
1174 "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
1175 (goto-char (point-min))
1176 (setq mh-swish-folder
1177 (let ((last-char (substring folder-path (1- (length folder-path)))))
1178 (if (equal last-char "/")
1179 folder-path
1180 (format "%s/" folder-path)))))
1181
1182(defun mh-swish-next-result ()
1183 "Get the next result from swish output."
1184 (prog1
1185 (block nil
1186 (when (or (eobp) (equal (char-after (point)) ?.))
1187 (return nil))
1188 (when (equal (char-after (point)) ?#)
1189 (return 'error))
1190 (let* ((start (search-forward " " (line-end-position) t))
1191 (end (search-forward " " (line-end-position) t)))
1192 (unless (and start end)
1193 (return 'error))
1194 (setq end (1- end))
1195 (unless (file-exists-p (buffer-substring-no-properties start end))
1196 (return 'error))
1197 (unless (search-backward "/" start t)
1198 (return 'error))
1199 (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
1200 (unless (string-match mh-swish-folder s)
1201 (return 'error))
1202 (if (string-match mh-user-path s)
1203 (format "+%s"
1204 (substring s (match-end 0) (1- (length s))))
1205 (return 'error)))
1206 (let* ((s (buffer-substring-no-properties (1+ (point)) end))
1207 (val (ignore-errors (read-from-string s))))
1208 (if (and (consp val) (numberp (car val)))
1209 (car val)
1210 (return 'error)))
1211 nil)))
1212 (forward-line)))
1213
1214\f
1215
1216;; Swish++ interface
1217
1218(defvar mh-swish++-binary (or (executable-find "search++")
c3d9274a 1219 (executable-find "search")))
bdcfe844
BW
1220(defvar mh-swish++-directory ".swish++")
1221
c3d9274a 1222;;;###mh-autoload
bdcfe844
BW
1223(defun mh-swish++-execute-search (folder-path search-regexp)
1224 "Execute swish++ and read the results.
1225
1226In the examples below, replace /home/user/Mail with the path to your MH
1227directory.
1228
1229First create the directory /home/user/Mail/.swish++. Then create the file
1230/home/user/Mail/.swish++/swish++.conf with the following contents:
1231
c3d9274a
BW
1232 IncludeMeta Bcc Cc Comments Content-Description From Keywords
1233 IncludeMeta Newsgroups Resent-To Subject To
1234 IncludeMeta Message-Id References In-Reply-To
1235 IncludeFile Mail *
1236 IndexFile /home/user/Mail/.swish++/swish++.index
bdcfe844
BW
1237
1238Use the following command line to generate the swish index. Run this
1239daily from cron:
1240
c3d9274a
BW
1241 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
1242 -o -path /home/user/Mail/.swish++ -prune \\
1243 -o -name \"[0-9]*\" -print \\
1244 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
1245
1246You do not want to index the folders that hold the results of your searches
1247since they tend to be ephemeral and the original messages are indexed anyway.
1248The command above assumes that the results are found in sub-folders of
1249`mh-index-folder' which is +mhe-index by default.
bdcfe844
BW
1250
1251On some systems (Debian GNU/Linux, for example), use index++ instead of index.
1252
1253FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1254 (set-buffer (get-buffer-create mh-index-temp-buffer))
1255 (erase-buffer)
1256 (unless mh-swish++-binary
1257 (error "Set mh-swish++-binary appropriately"))
1258 (call-process mh-swish++-binary nil '(t nil) nil
1259 "-m" "10000"
1260 (format "-i%s%s/swish++.index"
1261 mh-user-path mh-swish++-directory)
1262 search-regexp)
1263 (goto-char (point-min))
1264 (setq mh-swish-folder
1265 (let ((last-char (substring folder-path (1- (length folder-path)))))
1266 (if (equal last-char "/")
1267 folder-path
1268 (format "%s/" folder-path)))))
1269
1270(defalias 'mh-swish++-next-result 'mh-swish-next-result)
1271
3d7ca223
BW
1272(defun mh-swish++-regexp-builder (regexp-list)
1273 "Generate query for swish++.
1274REGEXP-LIST is an alist of fields and values."
924df208 1275 (let ((regexp ""))
3d7ca223
BW
1276 (dolist (elem regexp-list)
1277 (when (cdr elem)
1278 (setq regexp (concat regexp " and "
1279 (if (car elem) "(" "")
1280 (if (car elem) (symbol-name (car elem)) "")
1281 (if (car elem) " = " "")
1282 (mh-swish++-print-regexp (cdr elem))
1283 (if (car elem) ")" "")))))
1284 (substring regexp 4)))
1285
1286(defun mh-swish++-print-regexp (expr)
1287 "Return infix expression corresponding to EXPR."
1288 (cond ((atom expr) (format "%s" expr))
1289 ((eq (car expr) 'not)
1290 (format "(not %s)" (mh-swish++-print-regexp (cadr expr))))
1291 (t (format "(%s %s %s)" (mh-swish++-print-regexp (cadr expr))
1292 (symbol-name (car expr))
1293 (mh-swish++-print-regexp (caddr expr))))))
1294
bdcfe844
BW
1295\f
1296
1297;; Namazu interface
1298
1299(defvar mh-namazu-binary (executable-find "namazu"))
1300(defvar mh-namazu-directory ".namazu")
1301(defvar mh-namazu-folder nil)
1302
c3d9274a 1303;;;###mh-autoload
bdcfe844
BW
1304(defun mh-namazu-execute-search (folder-path search-regexp)
1305 "Execute namazu and read the results.
1306
1307In the examples below, replace /home/user/Mail with the path to your MH
1308directory.
1309
1310First create the directory /home/user/Mail/.namazu. Then create the file
1311/home/user/Mail/.namazu/mknmzrc with the following contents:
1312
1313 package conf; # Don't remove this line!
1314 $ADDRESS = 'user@localhost';
1315 $ALLOW_FILE = \"[0-9]*\";
c3d9274a
BW
1316 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
1317
1318In the above example configuration, none of the mail files contained in the
1319directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
1320
1321You do not want to index the folders that hold the results of your searches
1322since they tend to be ephemeral and the original messages are indexed anyway.
1323The configuration file above assumes that the results are found in sub-folders
1324of `mh-index-folder' which is +mhe-index by default.
bdcfe844
BW
1325
1326Use the following command line to generate the namazu index. Run this
1327daily from cron:
1328
1329 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
1330 /home/user/Mail
1331
1332FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1333 (let ((namazu-index-directory
c3d9274a 1334 (format "%s%s" mh-user-path mh-namazu-directory)))
bdcfe844
BW
1335 (unless (file-exists-p namazu-index-directory)
1336 (error "Namazu directory %s not present" namazu-index-directory))
1337 (unless (executable-find mh-namazu-binary)
1338 (error "Set mh-namazu-binary appropriately"))
1339 (set-buffer (get-buffer-create mh-index-temp-buffer))
1340 (erase-buffer)
1341 (call-process mh-namazu-binary nil '(t nil) nil
1342 "-alR" search-regexp namazu-index-directory)
1343 (goto-char (point-min))
1344 (setq mh-namazu-folder
1345 (let ((last (substring folder-path (1- (length folder-path)))))
1346 (if (equal last "/")
1347 folder-path
1348 (format "%s/" folder-path))))))
1349
1350(defun mh-namazu-next-result ()
1351 "Get the next result from namazu output."
1352 (prog1
1353 (block nil
1354 (when (eobp) (return nil))
1355 (let ((file-name (buffer-substring-no-properties
1356 (point) (line-end-position))))
1357 (unless (equal (string-match mh-namazu-folder file-name) 0)
1358 (return 'error))
1359 (unless (file-exists-p file-name)
1360 (return 'error))
1361 (string-match mh-user-path file-name)
1362 (let* ((folder/msg (substring file-name (match-end 0)))
c3d9274a 1363 (mark (mh-search-from-end ?/ folder/msg)))
bdcfe844
BW
1364 (unless mark (return 'error))
1365 (list (format "+%s" (substring folder/msg 0 mark))
1366 (let ((n (ignore-errors (read-from-string
1367 (substring folder/msg (1+ mark))))))
1368 (if (and (consp n) (numberp (car n)))
1369 (car n)
1370 (return 'error)))
1371 nil))))
1372 (forward-line)))
1373
1374\f
1375
924df208 1376;;;###mh-autoload
bdcfe844
BW
1377(defun mh-index-choose ()
1378 "Choose an indexing function.
1379The side-effects of this function are that the variables `mh-indexer',
1380`mh-index-execute-search-function', and `mh-index-next-result-function' are
1381set according to the first indexer in `mh-indexer-choices' present on the
1382system."
1383 (block nil
1384 ;; The following favors the user's preference; otherwise, the last
1385 ;; automatically chosen indexer is used for efficiency rather than going
1386 ;; through the list.
1387 (let ((program-alist (cond (mh-index-program
1388 (list
c3d9274a 1389 (assoc mh-index-program mh-indexer-choices)))
bdcfe844
BW
1390 (mh-indexer
1391 (list (assoc mh-indexer mh-indexer-choices)))
1392 (t mh-indexer-choices))))
1393 (while program-alist
1394 (let* ((current (pop program-alist))
1395 (executable (symbol-value (cadr current))))
1396 (when executable
1397 (setq mh-indexer (car current))
3d7ca223
BW
1398 (setq mh-index-execute-search-function (nth 2 current))
1399 (setq mh-index-next-result-function (nth 3 current))
1400 (setq mh-index-regexp-builder (nth 4 current))
bdcfe844
BW
1401 (return mh-indexer))))
1402 nil)))
1403
1404\f
1405
bdcfe844
BW
1406(provide 'mh-index)
1407
1408;;; Local Variables:
c3d9274a 1409;;; indent-tabs-mode: nil
bdcfe844
BW
1410;;; sentence-end-double-space: nil
1411;;; End:
1412
6b61353c 1413;;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47
bdcfe844 1414;;; mh-index ends here