Mercurial > emacs
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 |