comparison lisp/mh-e/mh-index.el @ 49459:06b77df47802

* mh-e: Created directory. ChangeLog will appear in a week when we release version 7.2. * lisp/mail/mh-alias.el, lisp/mail/mh-comp.el, lisp/mail/mh-customize.el, lisp/mail/mh-e.el, lisp/mail/mh-funcs.el, lisp/mail/mh-identity.el, lisp/mail/mh-index.el, lisp/mail/mh-loaddefs.el, lisp/mail/mh-mime.el, lisp/mail/mh-pick.el, lisp/mail/mh-seq.el, lisp/mail/mh-speed.el, lisp/mail/mh-utils.el, lisp/mail/mh-xemacs-compat.el: Moved to mh-e. Note that reply2.pbm and reply2.xpm, which were created by the MH-E package, were left in mail since they can probably be used by other mail packages. * makefile.w32-in (WINS): Added mh-e. * makefile.nt (WINS): Added mh-e.
author Bill Wohler <wohler@newt.com>
date Sun, 26 Jan 2003 02:38:37 +0000
parents
children b35587af8747
comparison
equal deleted inserted replaced
49458:5ddabc4c81b0 49459:06b77df47802
1 ;;; mh-index -- MH-E interface to indexing programs
2
3 ;; Copyright (C) 2002 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 ;;; namazu
33 ;;; glimpse
34 ;;; grep
35 ;;;
36 ;;; (2) To use this package, you first have to build an index. Please read
37 ;;; the documentation for `mh-index-search' to get started. That
38 ;;; documentation will direct you to the specific instructions for your
39 ;;; particular indexer.
40
41 ;;; Change Log:
42
43 ;; $Id: mh-index.el,v 1.2 2003/01/08 23:21:16 wohler Exp $
44
45 ;;; Code:
46
47 (require 'cl)
48 (require 'mh-e)
49 (require 'mh-mime)
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 (swish
61 mh-swish-binary mh-swish-execute-search mh-swish-next-result)
62 (namazu
63 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result)
64 (glimpse
65 mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result)
66 (grep
67 mh-grep-binary mh-grep-execute-search mh-grep-next-result))
68 "List of possible indexer choices.")
69 (defvar mh-indexer nil
70 "Chosen index program.")
71 (defvar mh-index-execute-search-function nil
72 "Function which executes the search program.")
73 (defvar mh-index-next-result-function nil
74 "Function to parse the next line of output.")
75
76 ;; FIXME: This should be a defcustom...
77 (defvar mh-index-folder "+mhe-index"
78 "Folder that contains the folders resulting from the index searches.")
79
80 ;; Temporary buffers for search results
81 (defvar mh-index-temp-buffer " *mh-index-temp*")
82 (defvar mh-checksum-buffer " *mh-checksum-buffer*")
83
84
85
86 ;;; A few different checksum programs are supported. The supported programs
87 ;;; are:
88 ;;; 1. md5sum
89 ;;; 2. md5
90 ;;; 3. openssl
91 ;;;
92 ;;; To add support for your favorite checksum program add a clause to the cond
93 ;;; statement in mh-checksum-choose. This should set the variable
94 ;;; mh-checksum-cmd to the command line needed to run the checsum program and
95 ;;; should set mh-checksum-parser to a function which returns a cons cell
96 ;;; containing the message number and checksum string.
97
98 (defvar mh-checksum-cmd)
99 (defvar mh-checksum-parser)
100
101 (defun mh-checksum-choose ()
102 "Check if a program to create a checksum is present."
103 (unless (boundp 'mh-checksum-cmd)
104 (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
105 (cond ((executable-find "md5sum")
106 (setq mh-checksum-cmd (list (executable-find "md5sum")))
107 (setq mh-checksum-parser #'mh-md5sum-parser))
108 ((executable-find "openssl")
109 (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
110 (setq mh-checksum-parser #'mh-openssl-parser))
111 ((executable-find "md5")
112 (setq mh-checksum-cmd (list (executable-find "md5")))
113 (setq mh-checksum-parser #'mh-md5-parser))
114 (t (error "No suitable checksum program"))))))
115
116 (defun mh-md5sum-parser ()
117 "Parse md5sum output."
118 (let ((begin (line-beginning-position))
119 (end (line-end-position))
120 first-space last-slash)
121 (setq first-space (search-forward " " end t))
122 (goto-char end)
123 (setq last-slash (search-backward "/" begin t))
124 (cond ((and first-space last-slash)
125 (cons (car (read-from-string (buffer-substring-no-properties
126 (1+ last-slash) end)))
127 (buffer-substring-no-properties begin (1- first-space))))
128 (t (cons nil nil)))))
129
130 (defun mh-openssl-parser ()
131 "Parse openssl output."
132 (let ((begin (line-beginning-position))
133 (end (line-end-position))
134 last-space last-slash)
135 (goto-char end)
136 (setq last-space (search-backward " " begin t))
137 (setq last-slash (search-backward "/" begin t))
138 (cond ((and last-slash last-space)
139 (cons (car (read-from-string (buffer-substring-no-properties
140 (1+ last-slash) (1- last-space))))
141 (buffer-substring-no-properties (1+ last-space) end))))))
142
143 (defalias 'mh-md5-parser 'mh-openssl-parser)
144
145
146
147 ;;; Make sure that we don't produce too long a command line.
148
149 (defvar mh-index-max-cmdline-args 500
150 "Maximum number of command line args.")
151
152 (defun mh-index-execute (cmd &rest args)
153 "Partial imitation of xargs.
154 The current buffer contains a list of strings, one on each line. The function
155 will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
156 strings to it. This is repeated till all the strings have been used."
157 (goto-char (point-min))
158 (let ((out (get-buffer-create " *mh-xargs-output*")))
159 (save-excursion
160 (set-buffer out)
161 (erase-buffer))
162 (while (not (eobp))
163 (let ((arg-list (reverse args))
164 (count 0))
165 (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
166 (push (buffer-substring-no-properties (point) (line-end-position))
167 arg-list)
168 (incf count)
169 (forward-line))
170 (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
171 (erase-buffer)
172 (insert-buffer-substring out)))
173
174
175
176 (defun mh-index-update-single-msg (msg checksum origin-map)
177 "Update various maps for one message.
178 MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
179 non-nil, a hashtable containing which maps each message in the index folder to
180 the folder and message that it was copied from. The function updates the hash
181 tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
182
183 This function should only be called in the appropriate index folder buffer."
184 (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
185 (let* ((intermediate (gethash msg origin-map))
186 (ofolder (car intermediate))
187 (omsg (cdr intermediate)))
188 ;; This is most probably a duplicate. So eliminate it.
189 (call-process "rm" nil nil nil
190 (format "%s%s/%s" mh-user-path
191 (substring mh-current-folder 1) msg))
192 (remhash omsg (gethash ofolder mh-index-data))))
193 (t
194 (setf (gethash msg mh-index-msg-checksum-map) checksum)
195 (when origin-map
196 (setf (gethash checksum mh-index-checksum-origin-map)
197 (gethash msg origin-map))))))
198
199 ;;;###mh-autoload
200 (defun mh-index-update-maps (folder &optional origin-map)
201 "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
202 As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
203 is a hashtable which maps each message in the index folder to the original
204 folder and message from whence it was copied. If present the
205 checksum -> (origin-folder, origin-index) map is updated too."
206 (clrhash mh-index-msg-checksum-map)
207 (save-excursion
208 ;; Clear temp buffer
209 (set-buffer (get-buffer-create mh-checksum-buffer))
210 (erase-buffer)
211 ;; Run scan to check if any messages needs MD5 annotations at all
212 (with-temp-buffer
213 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
214 "-format" "%(msg)\n%{x-mhe-checksum}\n"
215 folder "all")
216 (goto-char (point-min))
217 (let (msg checksum)
218 (while (not (eobp))
219 (setq msg (buffer-substring-no-properties
220 (point) (line-end-position)))
221 (forward-line)
222 (save-excursion
223 (cond ((eolp)
224 ;; need to compute checksum
225 (set-buffer mh-checksum-buffer)
226 (insert mh-user-path (substring folder 1) "/" msg "\n"))
227 (t
228 ;; update maps
229 (setq checksum (buffer-substring-no-properties
230 (point) (line-end-position)))
231 (let ((msg (car (read-from-string msg))))
232 (set-buffer folder)
233 (mh-index-update-single-msg msg checksum origin-map)))))
234 (forward-line))))
235 ;; Run checksum program if needed
236 (unless (and (eobp) (bobp))
237 (apply #'mh-index-execute mh-checksum-cmd)
238 (goto-char (point-min))
239 (while (not (eobp))
240 (let* ((intermediate (funcall mh-checksum-parser))
241 (msg (car intermediate))
242 (checksum (cdr intermediate)))
243 (when msg
244 ;; annotate
245 (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
246 "-nodate" "-text" checksum "-inplace")
247 ;; update maps
248 (save-excursion
249 (set-buffer folder)
250 (mh-index-update-single-msg msg checksum origin-map)))
251 (forward-line))))))
252
253 (defun mh-index-generate-pretty-name (string)
254 "Given STRING generate a name which is suitable for use as a folder name.
255 White space from the beginning and end are removed. All spaces in the name are
256 replaced with underscores and all / are replaced with $. If STRING is longer
257 than 20 it is truncated too."
258 (with-temp-buffer
259 (insert string)
260 (goto-char (point-min))
261 (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r)))
262 (delete-char 1))
263 (goto-char (point-max))
264 (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r)))
265 (delete-backward-char 1))
266 (subst-char-in-region (point-min) (point-max) ? ?_ t)
267 (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
268 (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
269 (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
270 (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
271 (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
272
273 ;;;###mh-autoload
274 (defun mh-index-search (redo-search-flag folder search-regexp)
275 "Perform an indexed search in an MH mail folder.
276
277 If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
278 index search, then the search is repeated. Otherwise, FOLDER is searched with
279 SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
280 \"+\" then mail in all folders are searched.
281
282 Four indexing programs are supported; if none of these are present, then grep
283 is used. This function picks the first program that is available on your
284 system. If you would prefer to use a different program, set the customization
285 variable `mh-index-program' accordingly.
286
287 The documentation for the following functions describes how to generate the
288 index for each program:
289
290 - `mh-swish++-execute-search'
291 - `mh-swish-execute-search'
292 - `mh-namazu-execute-search'
293 - `mh-glimpse-execute-search'
294
295 This and related functions use an X-MHE-Checksum header to cache the MD5
296 checksum of a message. This means that already present X-MHE-Checksum headers
297 in the incoming email could result in messages not being found. The following
298 procmail recipe should avoid this:
299
300 :0 wf
301 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
302
303 This has the effect of renaming already present X-MHE-Checksum headers."
304 (interactive
305 (list current-prefix-arg
306 (progn
307 (unless mh-find-path-run (mh-find-path))
308 (or (and current-prefix-arg (car mh-index-previous-search))
309 (mh-prompt-for-folder "Search" "+" nil "all")))
310 (progn
311 ;; Yes, we do want to call mh-index-choose every time in case the
312 ;; user has switched the indexer manually.
313 (unless (mh-index-choose) (error "No indexing program found"))
314 (or (and current-prefix-arg (cadr mh-index-previous-search))
315 (read-string (format "%s regexp: "
316 (upcase-initials
317 (symbol-name mh-indexer))))))))
318 (mh-checksum-choose)
319 (let ((result-count 0)
320 (old-window-config mh-previous-window-config)
321 (previous-search mh-index-previous-search)
322 (index-folder (format "%s/%s" mh-index-folder
323 (mh-index-generate-pretty-name search-regexp))))
324 ;; Create a new folder for the search results or recreate the old one...
325 (if (and redo-search-flag mh-index-previous-search)
326 (let ((buffer-name (buffer-name (current-buffer))))
327 (mh-process-or-undo-commands buffer-name)
328 (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
329 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
330 (setq index-folder buffer-name))
331 (setq index-folder (mh-index-new-folder index-folder)))
332
333 (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
334 (folder-results-map (make-hash-table :test #'equal))
335 (origin-map (make-hash-table :test #'equal)))
336 ;; Run search program...
337 (message "Executing %s... " mh-indexer)
338 (funcall mh-index-execute-search-function folder-path search-regexp)
339
340 ;; Parse indexer output
341 (message "Processing %s output... " mh-indexer)
342 (goto-char (point-min))
343 (loop for next-result = (funcall mh-index-next-result-function)
344 when (null next-result) return nil
345 do (unless (eq next-result 'error)
346 (unless (gethash (car next-result) folder-results-map)
347 (setf (gethash (car next-result) folder-results-map)
348 (make-hash-table :test #'equal)))
349 (setf (gethash (cadr next-result)
350 (gethash (car next-result) folder-results-map))
351 t)))
352
353 ;; Copy the search results over
354 (maphash #'(lambda (folder msgs)
355 (let ((msgs (sort (loop for msg being the hash-keys of msgs
356 collect msg)
357 #'<)))
358 (mh-exec-cmd "refile" msgs "-src" folder
359 "-link" index-folder)
360 (loop for msg in msgs
361 do (incf result-count)
362 (setf (gethash result-count origin-map)
363 (cons folder msg)))))
364 folder-results-map)
365
366 ;; Generate scan lines for the hits.
367 (let ((mh-show-threads-flag nil))
368 (mh-visit-folder index-folder () (list folder-results-map origin-map)))
369
370 (goto-char (point-min))
371 (forward-line)
372 (mh-update-sequences)
373 (mh-recenter nil)
374
375 ;; Maintain history
376 (when (and redo-search-flag previous-search)
377 (setq mh-previous-window-config old-window-config))
378 (setq mh-index-previous-search (list folder search-regexp))
379
380 (message "%s found %s matches in %s folders"
381 (upcase-initials (symbol-name mh-indexer))
382 (loop for msg-hash being hash-values of mh-index-data
383 sum (hash-table-count msg-hash))
384 (loop for msg-hash being hash-values of mh-index-data
385 count (> (hash-table-count msg-hash) 0))))))
386
387 ;;;###mh-autoload
388 (defun mh-index-next-folder (&optional backward-flag)
389 "Jump to the next folder marker.
390 The function is only applicable to folders displaying index search results.
391 With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
392 results."
393 (interactive "P")
394 (if (or (null mh-index-data)
395 (memq 'unthread mh-view-ops))
396 (message "Only applicable in an unthreaded MH-E index search buffer")
397 (let ((point (point)))
398 (forward-line (if backward-flag -1 1))
399 (cond ((if backward-flag
400 (re-search-backward "^+" (point-min) t)
401 (re-search-forward "^+" (point-max) t))
402 (beginning-of-line))
403 ((and (if backward-flag
404 (goto-char (point-max))
405 (goto-char (point-min)))
406 nil))
407 ((if backward-flag
408 (re-search-backward "^+" (point-min) t)
409 (re-search-forward "^+" (point-max) t))
410 (beginning-of-line))
411 (t (goto-char point))))))
412
413 ;;;###mh-autoload
414 (defun mh-index-previous-folder ()
415 "Jump to the previous folder marker."
416 (interactive)
417 (mh-index-next-folder t))
418
419 (defun mh-folder-exists-p (folder)
420 "Check if FOLDER exists."
421 (and (mh-folder-name-p folder)
422 (save-excursion
423 (with-temp-buffer
424 (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
425 (goto-char (point-min))
426 (not (eobp))))))
427
428 (defun mh-msg-exists-p (msg folder)
429 "Check if MSG exists in FOLDER."
430 (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
431
432 (defun mh-index-new-folder (name)
433 "Create and return an MH folder name based on NAME.
434 If the folder NAME already exists then check if NAME<2> exists. If it doesn't
435 then it is created and returned. Otherwise try NAME<3>. This is repeated till
436 we find a new folder name."
437 (unless (mh-folder-name-p name)
438 (error "The argument should be a valid MH folder name"))
439 (let ((chosen-name name))
440 (block unique-name
441 (unless (mh-folder-exists-p name)
442 (return-from unique-name))
443 (loop for index from 2
444 do (let ((new-name (format "%s<%s>" name index)))
445 (unless (mh-folder-exists-p new-name)
446 (setq chosen-name new-name)
447 (return-from unique-name)))))
448 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
449 (when (boundp 'mh-speed-folder-map)
450 (mh-speed-add-folder chosen-name))
451 (push (list chosen-name) mh-folder-list)
452 chosen-name))
453
454 ;;;###mh-autoload
455 (defun mh-index-insert-folder-headers ()
456 "Annotate the search results with original folder names."
457 (let ((cur-msg (mh-get-msg-num nil))
458 (old-buffer-modified-flag (buffer-modified-p))
459 (buffer-read-only nil)
460 current-folder last-folder)
461 (goto-char (point-min))
462 (while (not (eobp))
463 (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
464 mh-index-msg-checksum-map)
465 mh-index-checksum-origin-map)))
466 (when (and current-folder (not (eq current-folder last-folder)))
467 (insert (if last-folder "\n" "") current-folder "\n")
468 (setq last-folder current-folder))
469 (forward-line))
470 (when cur-msg (mh-goto-msg cur-msg t))
471 (set-buffer-modified-p old-buffer-modified-flag)))
472
473 ;;;###mh-autoload
474 (defun mh-index-delete-folder-headers ()
475 "Delete the folder headers."
476 (let ((cur-msg (mh-get-msg-num nil))
477 (old-buffer-modified-flag (buffer-modified-p))
478 (buffer-read-only nil))
479 (goto-char (point-min))
480 (while (not (eobp))
481 (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
482 (delete-region (point) (progn (forward-line) (point)))
483 (forward-line)))
484 (when cur-msg (mh-goto-msg cur-msg t t))
485 (set-buffer-modified-p old-buffer-modified-flag)))
486
487 ;;;###mh-autoload
488 (defun mh-index-visit-folder ()
489 "Visit original folder from where the message at point was found."
490 (interactive)
491 (unless mh-index-data
492 (error "Not in an index folder"))
493 (let (folder msg)
494 (save-excursion
495 (cond ((and (bolp) (eolp))
496 (ignore-errors (forward-line -1))
497 (setq msg (mh-get-msg-num t)))
498 ((equal (char-after (line-beginning-position)) ?+)
499 (setq folder (buffer-substring-no-properties
500 (line-beginning-position) (line-end-position))))
501 (t (setq msg (mh-get-msg-num t)))))
502 (when (not folder)
503 (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
504 mh-index-checksum-origin-map))))
505 (mh-visit-folder
506 folder (loop for x being the hash-keys of (gethash folder mh-index-data)
507 when (mh-msg-exists-p x folder) collect x))))
508
509 (defun mh-index-match-checksum (msg folder checksum)
510 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
511 (with-temp-buffer
512 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
513 "-format" "%{x-mhe-checksum}\n" folder msg)
514 (goto-char (point-min))
515 (string-equal (buffer-substring-no-properties (point) (line-end-position))
516 checksum)))
517
518 ;;;###mh-autoload
519 (defun mh-index-execute-commands ()
520 "Delete/refile the actual messages.
521 The copies in the searched folder are then deleted/refiled to get the desired
522 result. Before deleting the messages we make sure that the message being
523 deleted is identical to the one that the user has marked in the index buffer."
524 (let ((message-table (make-hash-table :test #'equal)))
525 (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
526 (dolist (msg msg-list)
527 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
528 (pair (gethash checksum mh-index-checksum-origin-map)))
529 (when (and checksum (car pair) (cdr pair)
530 (mh-index-match-checksum (cdr pair) (car pair) checksum))
531 (push (cdr pair) (gethash (car pair) message-table))
532 (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
533 (maphash (lambda (folder msgs)
534 (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
535 message-table)))
536
537
538
539 ;; Glimpse interface
540
541 (defvar mh-glimpse-binary (executable-find "glimpse"))
542 (defvar mh-glimpse-directory ".glimpse")
543
544 ;;;###mh-autoload
545 (defun mh-glimpse-execute-search (folder-path search-regexp)
546 "Execute glimpse and read the results.
547
548 In the examples below, replace /home/user/Mail with the path to your MH
549 directory.
550
551 First create the directory /home/user/Mail/.glimpse. Then create the file
552 /home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
553
554 */.*
555 */#*
556 */,*
557 */*~
558 ^/home/user/Mail/.glimpse
559 ^/home/user/Mail/mhe-index
560
561 If there are any directories you would like to ignore, append lines like the
562 following to .glimpse_exclude:
563
564 ^/home/user/Mail/scripts
565
566 You do not want to index the folders that hold the results of your searches
567 since they tend to be ephemeral and the original messages are indexed anyway.
568 The configuration file above assumes that the results are found in sub-folders
569 of `mh-index-folder' which is +mhe-index by default.
570
571 Use the following command line to generate the glimpse index. Run this
572 daily from cron:
573
574 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
575
576 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
577 (set-buffer (get-buffer-create mh-index-temp-buffer))
578 (erase-buffer)
579 (call-process mh-glimpse-binary nil '(t nil) nil
580 ;(format "-%s" fuzz)
581 "-i" "-y"
582 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
583 "-F" (format "^%s" folder-path)
584 search-regexp)
585 (goto-char (point-min)))
586
587 (defun mh-glimpse-next-result ()
588 "Read the next result.
589 Parse it and return the message folder, message index and the match. If no
590 other matches left then return nil. If the current record is invalid return
591 'error."
592 (prog1
593 (block nil
594 (when (eobp)
595 (return nil))
596 (let ((eol-pos (line-end-position))
597 (bol-pos (line-beginning-position))
598 folder-start msg-end)
599 (goto-char bol-pos)
600 (unless (search-forward mh-user-path eol-pos t)
601 (return 'error))
602 (setq folder-start (point))
603 (unless (search-forward ": " eol-pos t)
604 (return 'error))
605 (let ((match (buffer-substring-no-properties (point) eol-pos)))
606 (forward-char -2)
607 (setq msg-end (point))
608 (unless (search-backward "/" folder-start t)
609 (return 'error))
610 (list (format "+%s" (buffer-substring-no-properties
611 folder-start (point)))
612 (let ((val (ignore-errors (read-from-string
613 (buffer-substring-no-properties
614 (1+ (point)) msg-end)))))
615 (if (and (consp val) (integerp (car val)))
616 (car val)
617 (return 'error)))
618 match))))
619 (forward-line)))
620
621
622
623 ;; Grep interface
624
625 (defvar mh-grep-binary (executable-find "grep"))
626
627 (defun mh-grep-execute-search (folder-path search-regexp)
628 "Execute grep and read the results.
629 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
630 (set-buffer (get-buffer-create mh-index-temp-buffer))
631 (erase-buffer)
632 (call-process mh-grep-binary nil '(t nil) nil
633 "-i" "-r" search-regexp folder-path)
634 (goto-char (point-min)))
635
636 (defun mh-grep-next-result ()
637 "Read the next result.
638 Parse it and return the message folder, message index and the match. If no
639 other matches left then return nil. If the current record is invalid return
640 'error."
641 (prog1
642 (block nil
643 (when (eobp)
644 (return nil))
645 (let ((eol-pos (line-end-position))
646 (bol-pos (line-beginning-position))
647 folder-start msg-end)
648 (goto-char bol-pos)
649 (unless (search-forward mh-user-path eol-pos t)
650 (return 'error))
651 (setq folder-start (point))
652 (unless (search-forward ":" eol-pos t)
653 (return 'error))
654 (let ((match (buffer-substring-no-properties (point) eol-pos)))
655 (forward-char -1)
656 (setq msg-end (point))
657 (unless (search-backward "/" folder-start t)
658 (return 'error))
659 (list (format "+%s" (buffer-substring-no-properties
660 folder-start (point)))
661 (let ((val (ignore-errors (read-from-string
662 (buffer-substring-no-properties
663 (1+ (point)) msg-end)))))
664 (if (and (consp val) (integerp (car val)))
665 (car val)
666 (return 'error)))
667 match))))
668 (forward-line)))
669
670
671
672 ;; Swish interface
673
674 (defvar mh-swish-binary (executable-find "swish-e"))
675 (defvar mh-swish-directory ".swish")
676 (defvar mh-swish-folder nil)
677
678 ;;;###mh-autoload
679 (defun mh-swish-execute-search (folder-path search-regexp)
680 "Execute swish-e and read the results.
681
682 In the examples below, replace /home/user/Mail with the path to your MH
683 directory.
684
685 First create the directory /home/user/Mail/.swish. Then create the file
686 /home/user/Mail/.swish/config with the following contents:
687
688 IndexDir /home/user/Mail
689 IndexFile /home/user/Mail/.swish/index
690 IndexName \"Mail Index\"
691 IndexDescription \"Mail Index\"
692 IndexPointer \"http://nowhere\"
693 IndexAdmin \"nobody\"
694 #MetaNames automatic
695 IndexReport 3
696 FollowSymLinks no
697 UseStemming no
698 IgnoreTotalWordCountWhenRanking yes
699 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
700 BeginCharacters abcdefghijklmnopqrstuvwxyz
701 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
702 IgnoreLimit 50 1000
703 IndexComments 0
704 FileRules pathname contains /home/user/Mail/.swish
705 FileRules pathname contains /home/user/Mail/mhe-index
706 FileRules filename is index
707 FileRules filename is \..*
708 FileRules filename is #.*
709 FileRules filename is ,.*
710 FileRules filename is .*~
711
712 If there are any directories you would like to ignore, append lines like the
713 following to config:
714
715 FileRules pathname contains /home/user/Mail/scripts
716
717 You do not want to index the folders that hold the results of your searches
718 since they tend to be ephemeral and the original messages are indexed anyway.
719 The configuration file above assumes that the results are found in sub-folders
720 of `mh-index-folder' which is +mhe-index by default.
721
722 Use the following command line to generate the swish index. Run this
723 daily from cron:
724
725 swish-e -c /home/user/Mail/.swish/config
726
727 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
728 (set-buffer (get-buffer-create mh-index-temp-buffer))
729 (erase-buffer)
730 (unless mh-swish-binary
731 (error "Set mh-swish-binary appropriately"))
732 (call-process mh-swish-binary nil '(t nil) nil
733 "-w" search-regexp
734 "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
735 (goto-char (point-min))
736 (setq mh-swish-folder
737 (let ((last-char (substring folder-path (1- (length folder-path)))))
738 (if (equal last-char "/")
739 folder-path
740 (format "%s/" folder-path)))))
741
742 (defun mh-swish-next-result ()
743 "Get the next result from swish output."
744 (prog1
745 (block nil
746 (when (or (eobp) (equal (char-after (point)) ?.))
747 (return nil))
748 (when (equal (char-after (point)) ?#)
749 (return 'error))
750 (let* ((start (search-forward " " (line-end-position) t))
751 (end (search-forward " " (line-end-position) t)))
752 (unless (and start end)
753 (return 'error))
754 (setq end (1- end))
755 (unless (file-exists-p (buffer-substring-no-properties start end))
756 (return 'error))
757 (unless (search-backward "/" start t)
758 (return 'error))
759 (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
760 (unless (string-match mh-swish-folder s)
761 (return 'error))
762 (if (string-match mh-user-path s)
763 (format "+%s"
764 (substring s (match-end 0) (1- (length s))))
765 (return 'error)))
766 (let* ((s (buffer-substring-no-properties (1+ (point)) end))
767 (val (ignore-errors (read-from-string s))))
768 (if (and (consp val) (numberp (car val)))
769 (car val)
770 (return 'error)))
771 nil)))
772 (forward-line)))
773
774
775
776 ;; Swish++ interface
777
778 (defvar mh-swish++-binary (or (executable-find "search++")
779 (executable-find "search")))
780 (defvar mh-swish++-directory ".swish++")
781
782 ;;;###mh-autoload
783 (defun mh-swish++-execute-search (folder-path search-regexp)
784 "Execute swish++ and read the results.
785
786 In the examples below, replace /home/user/Mail with the path to your MH
787 directory.
788
789 First create the directory /home/user/Mail/.swish++. Then create the file
790 /home/user/Mail/.swish++/swish++.conf with the following contents:
791
792 IncludeMeta Bcc Cc Comments Content-Description From Keywords
793 IncludeMeta Newsgroups Resent-To Subject To
794 IncludeMeta Message-Id References In-Reply-To
795 IncludeFile Mail *
796 IndexFile /home/user/Mail/.swish++/swish++.index
797
798 Use the following command line to generate the swish index. Run this
799 daily from cron:
800
801 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
802 -o -path /home/user/Mail/.swish++ -prune \\
803 -o -name \"[0-9]*\" -print \\
804 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
805
806 You do not want to index the folders that hold the results of your searches
807 since they tend to be ephemeral and the original messages are indexed anyway.
808 The command above assumes that the results are found in sub-folders of
809 `mh-index-folder' which is +mhe-index by default.
810
811 On some systems (Debian GNU/Linux, for example), use index++ instead of index.
812
813 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
814 (set-buffer (get-buffer-create mh-index-temp-buffer))
815 (erase-buffer)
816 (unless mh-swish++-binary
817 (error "Set mh-swish++-binary appropriately"))
818 (call-process mh-swish++-binary nil '(t nil) nil
819 "-m" "10000"
820 (format "-i%s%s/swish++.index"
821 mh-user-path mh-swish++-directory)
822 search-regexp)
823 (goto-char (point-min))
824 (setq mh-swish-folder
825 (let ((last-char (substring folder-path (1- (length folder-path)))))
826 (if (equal last-char "/")
827 folder-path
828 (format "%s/" folder-path)))))
829
830 (defalias 'mh-swish++-next-result 'mh-swish-next-result)
831
832
833
834 ;; Namazu interface
835
836 (defvar mh-namazu-binary (executable-find "namazu"))
837 (defvar mh-namazu-directory ".namazu")
838 (defvar mh-namazu-folder nil)
839
840 ;;;###mh-autoload
841 (defun mh-namazu-execute-search (folder-path search-regexp)
842 "Execute namazu and read the results.
843
844 In the examples below, replace /home/user/Mail with the path to your MH
845 directory.
846
847 First create the directory /home/user/Mail/.namazu. Then create the file
848 /home/user/Mail/.namazu/mknmzrc with the following contents:
849
850 package conf; # Don't remove this line!
851 $ADDRESS = 'user@localhost';
852 $ALLOW_FILE = \"[0-9]*\";
853 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
854
855 In the above example configuration, none of the mail files contained in the
856 directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
857
858 You do not want to index the folders that hold the results of your searches
859 since they tend to be ephemeral and the original messages are indexed anyway.
860 The configuration file above assumes that the results are found in sub-folders
861 of `mh-index-folder' which is +mhe-index by default.
862
863 Use the following command line to generate the namazu index. Run this
864 daily from cron:
865
866 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
867 /home/user/Mail
868
869 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
870 (let ((namazu-index-directory
871 (format "%s%s" mh-user-path mh-namazu-directory)))
872 (unless (file-exists-p namazu-index-directory)
873 (error "Namazu directory %s not present" namazu-index-directory))
874 (unless (executable-find mh-namazu-binary)
875 (error "Set mh-namazu-binary appropriately"))
876 (set-buffer (get-buffer-create mh-index-temp-buffer))
877 (erase-buffer)
878 (call-process mh-namazu-binary nil '(t nil) nil
879 "-alR" search-regexp namazu-index-directory)
880 (goto-char (point-min))
881 (setq mh-namazu-folder
882 (let ((last (substring folder-path (1- (length folder-path)))))
883 (if (equal last "/")
884 folder-path
885 (format "%s/" folder-path))))))
886
887 (defun mh-namazu-next-result ()
888 "Get the next result from namazu output."
889 (prog1
890 (block nil
891 (when (eobp) (return nil))
892 (let ((file-name (buffer-substring-no-properties
893 (point) (line-end-position))))
894 (unless (equal (string-match mh-namazu-folder file-name) 0)
895 (return 'error))
896 (unless (file-exists-p file-name)
897 (return 'error))
898 (string-match mh-user-path file-name)
899 (let* ((folder/msg (substring file-name (match-end 0)))
900 (mark (mh-search-from-end ?/ folder/msg)))
901 (unless mark (return 'error))
902 (list (format "+%s" (substring folder/msg 0 mark))
903 (let ((n (ignore-errors (read-from-string
904 (substring folder/msg (1+ mark))))))
905 (if (and (consp n) (numberp (car n)))
906 (car n)
907 (return 'error)))
908 nil))))
909 (forward-line)))
910
911
912
913 (defun mh-index-choose ()
914 "Choose an indexing function.
915 The side-effects of this function are that the variables `mh-indexer',
916 `mh-index-execute-search-function', and `mh-index-next-result-function' are
917 set according to the first indexer in `mh-indexer-choices' present on the
918 system."
919 (block nil
920 ;; The following favors the user's preference; otherwise, the last
921 ;; automatically chosen indexer is used for efficiency rather than going
922 ;; through the list.
923 (let ((program-alist (cond (mh-index-program
924 (list
925 (assoc mh-index-program mh-indexer-choices)))
926 (mh-indexer
927 (list (assoc mh-indexer mh-indexer-choices)))
928 (t mh-indexer-choices))))
929 (while program-alist
930 (let* ((current (pop program-alist))
931 (executable (symbol-value (cadr current))))
932 (when executable
933 (setq mh-indexer (car current))
934 (setq mh-index-execute-search-function (caddr current))
935 (setq mh-index-next-result-function (cadddr current))
936 (return mh-indexer))))
937 nil)))
938
939
940
941 (provide 'mh-index)
942
943 ;;; Local Variables:
944 ;;; indent-tabs-mode: nil
945 ;;; sentence-end-double-space: nil
946 ;;; End:
947
948 ;;; mh-index ends here