Add arch taglines
[bpt/emacs.git] / lisp / mh-e / mh-index.el
1 ;;; mh-index -- MH-E interface to indexing programs
2
3 ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
4
5 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
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
32 ;;; mairix
33 ;;; namazu
34 ;;; glimpse
35 ;;; grep
36 ;;;
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.
41
42 ;;; Change Log:
43
44 ;;; Code:
45
46 (require 'cl)
47 (require 'mh-e)
48 (require 'mh-mime)
49 (require 'mh-pick)
50
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
56 ;; Support different indexing programs
57 (defvar mh-indexer-choices
58 '((swish++
59 mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result
60 mh-swish++-regexp-builder)
61 (swish
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)
66 (namazu
67 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
68 (glimpse
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)
73 (grep
74 mh-grep-binary mh-grep-execute-search mh-grep-next-result nil))
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.")
82 (defvar mh-index-regexp-builder nil
83 "Function used to construct search regexp.")
84
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
90 (defvar mh-index-temp-buffer " *mh-index-temp*")
91 (defvar mh-checksum-buffer " *mh-checksum-buffer*")
92
93 \f
94
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)
153
154 \f
155
156 ;;; Make sure that we don't produce too long a command line.
157
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.
163 The current buffer contains a list of strings, one on each line. The function
164 will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
165 strings to it. This is repeated till all the strings have been used."
166 (goto-char (point-min))
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)))))
183
184 \f
185
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'.
192
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))))
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.
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)
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
233 (cond ((not (string-match "^[0-9]*$" msg)))
234 ((eolp)
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
264 (defvar mh-flists-results-folder "new"
265 "Subfolder for `mh-index-folder' where flists output is placed.")
266
267 (defun mh-index-generate-pretty-name (string)
268 "Given STRING generate a name which is suitable for use as a folder name.
269 White space from the beginning and end are removed. All spaces in the name are
270 replaced with underscores and all / are replaced with $. If STRING is longer
271 than 20 it is truncated too. STRING could be a list of strings in which case
272 they are concatenated to construct the base name."
273 (with-temp-buffer
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)
284 (goto-char (point-min))
285 (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_)))
286 (delete-char 1))
287 (goto-char (point-max))
288 (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_)))
289 (delete-backward-char 1))
290 (subst-char-in-region (point-min) (point-max) ? ?_ t)
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)
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)))))
299
300 ;;;###mh-autoload
301 (defun* mh-index-search (redo-search-flag folder search-regexp
302 &optional window-config unseen-flag)
303 "Perform an indexed search in an MH mail folder.
304 Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
305
306 If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
307 index search, then the search is repeated. Otherwise, FOLDER is searched with
308 SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
309 \"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
310 stores the window configuration that will be restored after the user quits the
311 folder containing the index search results. If optional argument UNSEEN-FLAG
312 is non-nil, then all the messages are marked as unseen.
313
314 Four indexing programs are supported; if none of these are present, then grep
315 is used. This function picks the first program that is available on your
316 system. If you would prefer to use a different program, set the customization
317 variable `mh-index-program' accordingly.
318
319 The documentation for the following functions describes how to generate the
320 index for each program:
321
322 - `mh-swish++-execute-search'
323 - `mh-swish-execute-search'
324 - `mh-mairix-execute-search'
325 - `mh-namazu-execute-search'
326 - `mh-glimpse-execute-search'
327
328 If none of these programs are present then we use pick. If desired grep can be
329 used instead. Details about these methods can be found in:
330
331 - `mh-pick-execute-search'
332 - `mh-grep-execute-search'
333
334 This and related functions use an X-MHE-Checksum header to cache the MD5
335 checksum of a message. This means that already present X-MHE-Checksum headers
336 in the incoming email could result in messages not being found. The following
337 procmail recipe should avoid this:
338
339 :0 wf
340 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
341
342 This has the effect of renaming already present X-MHE-Checksum headers."
343 (interactive
344 (list current-prefix-arg
345 (progn
346 (unless mh-find-path-run (mh-find-path))
347 (or (and current-prefix-arg (car mh-index-previous-search))
348 (mh-prompt-for-folder "Search" "+" nil "all" t)))
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"))
353 (or (and current-prefix-arg (cadr mh-index-previous-search))
354 mh-index-regexp-builder
355 (read-string (format "%s regexp: "
356 (upcase-initials
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))
367 (mh-checksum-choose)
368 (let ((result-count 0)
369 (old-window-config (or window-config mh-previous-window-config))
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)))
385 ;; Run search program...
386 (message "Executing %s... " mh-indexer)
387 (funcall mh-index-execute-search-function folder-path search-regexp)
388
389 ;; Parse indexer output
390 (message "Processing %s output... " mh-indexer)
391 (goto-char (point-min))
392 (loop for next-result = (funcall mh-index-next-result-function)
393 while next-result
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)
414
415 ;; Mark messages as unseen (if needed)
416 (when (and unseen-flag (> result-count 0))
417 (mh-exec-cmd "mark" index-folder "all"
418 "-sequence" (symbol-name mh-unseen-seq) "-add"))
419
420 ;; Generate scan lines for the hits.
421 (mh-visit-folder index-folder () (list folder-results-map origin-map))
422
423 (goto-char (point-min))
424 (forward-line)
425 (mh-update-sequences)
426 (mh-recenter nil)
427
428 ;; Maintain history
429 (when (or (and redo-search-flag previous-search) window-config)
430 (setq mh-previous-window-config old-window-config))
431 (setq mh-index-previous-search (list folder search-regexp))
432
433 (message "%s found %s matches in %s folders"
434 (upcase-initials (symbol-name mh-indexer))
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
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.
461 All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by AND, OR and
462 NOT 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
557 ;;;###mh-autoload
558 (defun mh-index-next-folder (&optional backward-flag)
559 "Jump to the next folder marker.
560 The function is only applicable to folders displaying index search results.
561 With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
562 results."
563 (interactive "P")
564 (if (null mh-index-data)
565 (message "Only applicable in an MH-E index search buffer")
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."
585 (interactive)
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.
603 If the folder NAME already exists then check if NAME<2> exists. If it doesn't
604 then it is created and returned. Otherwise try NAME<3>. This is repeated till
605 we 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)
618 (mh-remove-from-sub-folders-cache chosen-name)
619 (when (boundp 'mh-speed-folder-map)
620 (mh-speed-add-folder chosen-name))
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)
630 (goto-char (point-min))
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
642 ;;;###mh-autoload
643 (defun mh-index-group-by-folder ()
644 "Partition the messages based on source folder.
645 Returns an alist with the the folder names in the car and the cdr being the
646 list of messages originally from that folder."
647 (save-excursion
648 (goto-char (point-min))
649 (let ((result-table (make-hash-table)))
650 (loop for msg being hash-keys of mh-index-msg-checksum-map
651 do (push msg (gethash (car (gethash
652 (gethash msg mh-index-msg-checksum-map)
653 mh-index-checksum-origin-map))
654 result-table)))
655 (loop for x being the hash-keys of result-table
656 collect (cons x (nreverse (gethash x result-table)))))))
657
658 ;;;###mh-autoload
659 (defun mh-index-delete-folder-headers ()
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))
664 (while (and (not cur-msg) (not (eobp)))
665 (forward-line)
666 (setq cur-msg (mh-get-msg-num nil)))
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)))
671 (forward-line)))
672 (when cur-msg (mh-goto-msg cur-msg t t))
673 (set-buffer-modified-p old-buffer-modified-flag)))
674
675 ;;;###mh-autoload
676 (defun mh-index-visit-folder ()
677 "Visit original folder from where the message at point was found."
678 (interactive)
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))))
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'.
702 Also `mh-update-unseen' is called in the original folder, if we have it open."
703 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
704 (folder-msg-pair (gethash checksum mh-index-checksum-origin-map))
705 (orig-folder (car folder-msg-pair))
706 (orig-msg (cdr folder-msg-pair)))
707 (when (mh-index-match-checksum orig-msg orig-folder checksum)
708 (when (get-buffer orig-folder)
709 (save-excursion
710 (set-buffer orig-folder)
711 (unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))
712 (mh-update-unseen)))
713 (mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)
714 "-sequence" (symbol-name mh-unseen-seq) "-del"))))
715
716 (defun mh-index-match-checksum (msg folder checksum)
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.
728 The copies in the searched folder are then deleted/refiled to get the desired
729 result. Before deleting the messages we make sure that the message being
730 deleted 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)))
743
744 \f
745
746 ;; Glimpse interface
747
748 (defvar mh-glimpse-binary (executable-find "glimpse"))
749 (defvar mh-glimpse-directory ".glimpse")
750
751 ;;;###mh-autoload
752 (defun mh-glimpse-execute-search (folder-path search-regexp)
753 "Execute glimpse and read the results.
754
755 In the examples below, replace /home/user/Mail with the path to your MH
756 directory.
757
758 First 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
766 ^/home/user/Mail/mhe-index
767
768 If there are any directories you would like to ignore, append lines like the
769 following to .glimpse_exclude:
770
771 ^/home/user/Mail/scripts
772
773 You do not want to index the folders that hold the results of your searches
774 since they tend to be ephemeral and the original messages are indexed anyway.
775 The configuration file above assumes that the results are found in sub-folders
776 of `mh-index-folder' which is +mhe-index by default.
777
778 Use the following command line to generate the glimpse index. Run this
779 daily from cron:
780
781 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
782
783 FOLDER-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
787 ;(format "-%s" fuzz)
788 "-i" "-y"
789 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
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.
796 Parse it and return the message folder, message index and the match. If no
797 other matches left then return nil. If the current record is invalid return
798 'error."
799 (prog1
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)
808 (return 'error))
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))))
826 (forward-line)))
827
828 \f
829
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
838 Unlike the other index search programs \"pick\" only searches messages present
839 in the folder itself and does not descend into any sub-folders that may be
840 present.
841
842 FOLDER-PATH is the directory containing the mails to be searched and
843 SEARCH-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
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.
873 FOLDER-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.
882 Parse it and return the message folder, message index and the match. If no
883 other matches left then return nil. If the current record is invalid return
884 'error."
885 (prog1
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)
894 (return 'error))
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))))
912 (forward-line)))
913
914 \f
915
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
925 In the examples below replace /home/user/Mail with the path to your MH
926 directory.
927
928 First 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
933
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
937
938 vfolder_format=raw
939 database=/home/user/Mail/mairix/database
940
941 Use the following command line to generate the mairix index. Run this daily
942 from cron:
943
944 mairix -f /home/user/Mail/.mairix/config
945
946 FOLDER-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) ?/)
968 (return 'error))
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.
993 REGEXP-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
1050 ;; Interface to unseen messages script
1051
1052 (defvar mh-flists-search-folders)
1053
1054 (defun mh-flists-execute (&rest args)
1055 "Search for unseen messages in `mh-flists-search-folders'.
1056 If `mh-recursive-folders-flag' is t, then the folders are searched
1057 recursively. All parameters ARGS are ignored."
1058 (set-buffer (get-buffer-create mh-index-temp-buffer))
1059 (erase-buffer)
1060 (unless (executable-find "sh")
1061 (error "Didn't find sh"))
1062 (with-temp-buffer
1063 (let ((unseen (symbol-name mh-unseen-seq)))
1064 (insert "for folder in `flists "
1065 (cond ((eq mh-flists-search-folders t) mh-inbox)
1066 ((eq mh-flists-search-folders nil) "")
1067 ((listp mh-flists-search-folders)
1068 (loop for folder in mh-flists-search-folders
1069 concat (concat " " folder))))
1070 (if mh-recursive-folders-flag " -recurse" "")
1071 " -sequence " unseen " -noshowzero -fast` ; do\n"
1072 "mhpath \"+$folder\" " unseen "\n" "done\n"))
1073 (call-process-region
1074 (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer))))
1075
1076 ;;;###mh-autoload
1077 (defun mh-index-new-messages (folders)
1078 "Display new messages.
1079 All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed.
1080 By default the folders specified by `mh-index-new-messages-folders' are
1081 searched. With a prefix argument, enter a space-separated list of folders, or
1082 nothing to search all folders."
1083 (interactive
1084 (list (if current-prefix-arg
1085 (split-string (read-string "Folders to search: "))
1086 mh-index-new-messages-folders)))
1087 (let* ((mh-flists-search-folders folders)
1088 (mh-indexer 'flists)
1089 (mh-index-execute-search-function 'mh-flists-execute)
1090 (mh-index-next-result-function 'mh-mairix-next-result)
1091 (mh-mairix-folder mh-user-path)
1092 (mh-index-regexp-builder nil)
1093 (new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder))
1094 (window-config (if (equal new-folder mh-current-folder)
1095 mh-previous-window-config
1096 (current-window-configuration)))
1097 (redo-flag nil))
1098 (cond ((buffer-live-p (get-buffer new-folder))
1099 ;; The destination folder is being visited. Trick `mh-index-search'
1100 ;; into thinking that the folder was the result of a previous search.
1101 (set-buffer new-folder)
1102 (setq mh-index-previous-search (list "+" mh-flists-results-folder))
1103 (setq redo-flag t))
1104 ((mh-folder-exists-p new-folder)
1105 ;; Folder exists but we don't have it open. That means they are
1106 ;; stale results from a old flists search. Clear it out.
1107 (mh-exec-cmd-quiet nil "rmf" new-folder)))
1108 (mh-index-search redo-flag "+" mh-flists-results-folder window-config t)))
1109
1110 \f
1111
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
1118 ;;;###mh-autoload
1119 (defun mh-swish-execute-search (folder-path search-regexp)
1120 "Execute swish-e and read the results.
1121
1122 In the examples below, replace /home/user/Mail with the path to your MH
1123 directory.
1124
1125 First 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
1145 FileRules pathname contains /home/user/Mail/mhe-index
1146 FileRules filename is index
1147 FileRules filename is \\..*
1148 FileRules filename is #.*
1149 FileRules filename is ,.*
1150 FileRules filename is .*~
1151
1152 If there are any directories you would like to ignore, append lines like the
1153 following to config:
1154
1155 FileRules pathname contains /home/user/Mail/scripts
1156
1157 You do not want to index the folders that hold the results of your searches
1158 since they tend to be ephemeral and the original messages are indexed anyway.
1159 The configuration file above assumes that the results are found in sub-folders
1160 of `mh-index-folder' which is +mhe-index by default.
1161
1162 Use the following command line to generate the swish index. Run this
1163 daily from cron:
1164
1165 swish-e -c /home/user/Mail/.swish/config
1166
1167 FOLDER-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++")
1219 (executable-find "search")))
1220 (defvar mh-swish++-directory ".swish++")
1221
1222 ;;;###mh-autoload
1223 (defun mh-swish++-execute-search (folder-path search-regexp)
1224 "Execute swish++ and read the results.
1225
1226 In the examples below, replace /home/user/Mail with the path to your MH
1227 directory.
1228
1229 First create the directory /home/user/Mail/.swish++. Then create the file
1230 /home/user/Mail/.swish++/swish++.conf with the following contents:
1231
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
1237
1238 Use the following command line to generate the swish index. Run this
1239 daily from cron:
1240
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
1246 You do not want to index the folders that hold the results of your searches
1247 since they tend to be ephemeral and the original messages are indexed anyway.
1248 The command above assumes that the results are found in sub-folders of
1249 `mh-index-folder' which is +mhe-index by default.
1250
1251 On some systems (Debian GNU/Linux, for example), use index++ instead of index.
1252
1253 FOLDER-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
1272 (defun mh-swish++-regexp-builder (regexp-list)
1273 "Generate query for swish++.
1274 REGEXP-LIST is an alist of fields and values."
1275 (let ((regexp ""))
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
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
1303 ;;;###mh-autoload
1304 (defun mh-namazu-execute-search (folder-path search-regexp)
1305 "Execute namazu and read the results.
1306
1307 In the examples below, replace /home/user/Mail with the path to your MH
1308 directory.
1309
1310 First 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]*\";
1316 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
1317
1318 In the above example configuration, none of the mail files contained in the
1319 directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
1320
1321 You do not want to index the folders that hold the results of your searches
1322 since they tend to be ephemeral and the original messages are indexed anyway.
1323 The configuration file above assumes that the results are found in sub-folders
1324 of `mh-index-folder' which is +mhe-index by default.
1325
1326 Use the following command line to generate the namazu index. Run this
1327 daily from cron:
1328
1329 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
1330 /home/user/Mail
1331
1332 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1333 (let ((namazu-index-directory
1334 (format "%s%s" mh-user-path mh-namazu-directory)))
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)))
1363 (mark (mh-search-from-end ?/ folder/msg)))
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
1376 ;;;###mh-autoload
1377 (defun mh-index-choose ()
1378 "Choose an indexing function.
1379 The side-effects of this function are that the variables `mh-indexer',
1380 `mh-index-execute-search-function', and `mh-index-next-result-function' are
1381 set according to the first indexer in `mh-indexer-choices' present on the
1382 system."
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
1389 (assoc mh-index-program mh-indexer-choices)))
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))
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))
1401 (return mh-indexer))))
1402 nil)))
1403
1404 \f
1405
1406 (provide 'mh-index)
1407
1408 ;;; Local Variables:
1409 ;;; indent-tabs-mode: nil
1410 ;;; sentence-end-double-space: nil
1411 ;;; End:
1412
1413 ;;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47
1414 ;;; mh-index ends here