Commit | Line | Data |
---|---|---|
bdcfe844 BW |
1 | ;;; mh-index -- MH-E interface to indexing programs |
2 | ||
924df208 | 3 | ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. |
bdcfe844 | 4 | |
c3d9274a | 5 | ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
bdcfe844 BW |
6 | ;; Maintainer: Bill Wohler <wohler@newt.com> |
7 | ;; Keywords: mail | |
8 | ;; See: mh-e.el | |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
26 | ||
27 | ;;; Commentary: | |
28 | ||
29 | ;;; (1) The following search engines are supported: | |
30 | ;;; swish++ | |
31 | ;;; swish-e | |
924df208 | 32 | ;;; mairix |
bdcfe844 BW |
33 | ;;; namazu |
34 | ;;; glimpse | |
35 | ;;; grep | |
a1506d29 | 36 | ;;; |
bdcfe844 BW |
37 | ;;; (2) To use this package, you first have to build an index. Please read |
38 | ;;; the documentation for `mh-index-search' to get started. That | |
39 | ;;; documentation will direct you to the specific instructions for your | |
40 | ;;; particular indexer. | |
bdcfe844 BW |
41 | |
42 | ;;; Change Log: | |
43 | ||
bdcfe844 BW |
44 | ;;; Code: |
45 | ||
46 | (require 'cl) | |
47 | (require 'mh-e) | |
48 | (require 'mh-mime) | |
3d7ca223 | 49 | (require 'mh-pick) |
bdcfe844 | 50 | |
bdcfe844 BW |
51 | (autoload 'gnus-local-map-property "gnus-util") |
52 | (autoload 'gnus-eval-format "gnus-spec") | |
53 | (autoload 'widget-convert-button "wid-edit") | |
54 | (autoload 'executable-find "executable") | |
55 | ||
bdcfe844 BW |
56 | ;; Support different indexing programs |
57 | (defvar mh-indexer-choices | |
58 | '((swish++ | |
3d7ca223 BW |
59 | mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result |
60 | mh-swish++-regexp-builder) | |
bdcfe844 | 61 | (swish |
3d7ca223 BW |
62 | mh-swish-binary mh-swish-execute-search mh-swish-next-result nil) |
63 | (mairix | |
64 | mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result | |
65 | mh-mairix-regexp-builder) | |
bdcfe844 | 66 | (namazu |
3d7ca223 | 67 | mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil) |
bdcfe844 | 68 | (glimpse |
3d7ca223 BW |
69 | mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil) |
70 | (pick | |
71 | mh-pick-binary mh-pick-execute-search mh-pick-next-result | |
72 | mh-pick-regexp-builder) | |
bdcfe844 | 73 | (grep |
3d7ca223 | 74 | mh-grep-binary mh-grep-execute-search mh-grep-next-result nil)) |
bdcfe844 BW |
75 | "List of possible indexer choices.") |
76 | (defvar mh-indexer nil | |
77 | "Chosen index program.") | |
78 | (defvar mh-index-execute-search-function nil | |
79 | "Function which executes the search program.") | |
80 | (defvar mh-index-next-result-function nil | |
81 | "Function to parse the next line of output.") | |
3d7ca223 BW |
82 | (defvar mh-index-regexp-builder nil |
83 | "Function used to construct search regexp.") | |
bdcfe844 | 84 | |
c3d9274a BW |
85 | ;; FIXME: This should be a defcustom... |
86 | (defvar mh-index-folder "+mhe-index" | |
87 | "Folder that contains the folders resulting from the index searches.") | |
88 | ||
89 | ;; Temporary buffers for search results | |
bdcfe844 | 90 | (defvar mh-index-temp-buffer " *mh-index-temp*") |
c3d9274a BW |
91 | (defvar mh-checksum-buffer " *mh-checksum-buffer*") |
92 | ||
93 | \f | |
bdcfe844 | 94 | |
c3d9274a BW |
95 | ;;; A few different checksum programs are supported. The supported programs |
96 | ;;; are: | |
97 | ;;; 1. md5sum | |
98 | ;;; 2. md5 | |
99 | ;;; 3. openssl | |
100 | ;;; | |
101 | ;;; To add support for your favorite checksum program add a clause to the cond | |
102 | ;;; statement in mh-checksum-choose. This should set the variable | |
103 | ;;; mh-checksum-cmd to the command line needed to run the checsum program and | |
104 | ;;; should set mh-checksum-parser to a function which returns a cons cell | |
105 | ;;; containing the message number and checksum string. | |
106 | ||
107 | (defvar mh-checksum-cmd) | |
108 | (defvar mh-checksum-parser) | |
109 | ||
110 | (defun mh-checksum-choose () | |
111 | "Check if a program to create a checksum is present." | |
112 | (unless (boundp 'mh-checksum-cmd) | |
113 | (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path))) | |
114 | (cond ((executable-find "md5sum") | |
115 | (setq mh-checksum-cmd (list (executable-find "md5sum"))) | |
116 | (setq mh-checksum-parser #'mh-md5sum-parser)) | |
117 | ((executable-find "openssl") | |
118 | (setq mh-checksum-cmd (list (executable-find "openssl") "md5")) | |
119 | (setq mh-checksum-parser #'mh-openssl-parser)) | |
120 | ((executable-find "md5") | |
121 | (setq mh-checksum-cmd (list (executable-find "md5"))) | |
122 | (setq mh-checksum-parser #'mh-md5-parser)) | |
123 | (t (error "No suitable checksum program")))))) | |
124 | ||
125 | (defun mh-md5sum-parser () | |
126 | "Parse md5sum output." | |
127 | (let ((begin (line-beginning-position)) | |
128 | (end (line-end-position)) | |
129 | first-space last-slash) | |
130 | (setq first-space (search-forward " " end t)) | |
131 | (goto-char end) | |
132 | (setq last-slash (search-backward "/" begin t)) | |
133 | (cond ((and first-space last-slash) | |
134 | (cons (car (read-from-string (buffer-substring-no-properties | |
135 | (1+ last-slash) end))) | |
136 | (buffer-substring-no-properties begin (1- first-space)))) | |
137 | (t (cons nil nil))))) | |
138 | ||
139 | (defun mh-openssl-parser () | |
140 | "Parse openssl output." | |
141 | (let ((begin (line-beginning-position)) | |
142 | (end (line-end-position)) | |
143 | last-space last-slash) | |
144 | (goto-char end) | |
145 | (setq last-space (search-backward " " begin t)) | |
146 | (setq last-slash (search-backward "/" begin t)) | |
147 | (cond ((and last-slash last-space) | |
148 | (cons (car (read-from-string (buffer-substring-no-properties | |
149 | (1+ last-slash) (1- last-space)))) | |
150 | (buffer-substring-no-properties (1+ last-space) end)))))) | |
151 | ||
152 | (defalias 'mh-md5-parser 'mh-openssl-parser) | |
bdcfe844 BW |
153 | |
154 | \f | |
155 | ||
c3d9274a | 156 | ;;; Make sure that we don't produce too long a command line. |
bdcfe844 | 157 | |
c3d9274a BW |
158 | (defvar mh-index-max-cmdline-args 500 |
159 | "Maximum number of command line args.") | |
160 | ||
161 | (defun mh-index-execute (cmd &rest args) | |
162 | "Partial imitation of xargs. | |
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)) | |
924df208 BW |
167 | (let ((current-buffer (current-buffer))) |
168 | (with-temp-buffer | |
169 | (let ((out (current-buffer))) | |
170 | (set-buffer current-buffer) | |
171 | (while (not (eobp)) | |
172 | (let ((arg-list (reverse args)) | |
173 | (count 0)) | |
174 | (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) | |
175 | (push (buffer-substring-no-properties (point) (line-end-position)) | |
176 | arg-list) | |
177 | (incf count) | |
178 | (forward-line)) | |
179 | (apply #'call-process cmd nil (list out nil) nil | |
180 | (nreverse arg-list)))) | |
181 | (erase-buffer) | |
182 | (insert-buffer-substring out))))) | |
bdcfe844 BW |
183 | |
184 | \f | |
185 | ||
c3d9274a BW |
186 | (defun mh-index-update-single-msg (msg checksum origin-map) |
187 | "Update various maps for one message. | |
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 | |
924df208 BW |
233 | (cond ((not (string-match "^[0-9]*$" msg))) |
234 | ((eolp) | |
c3d9274a BW |
235 | ;; need to compute checksum |
236 | (set-buffer mh-checksum-buffer) | |
237 | (insert mh-user-path (substring folder 1) "/" msg "\n")) | |
238 | (t | |
239 | ;; update maps | |
240 | (setq checksum (buffer-substring-no-properties | |
241 | (point) (line-end-position))) | |
242 | (let ((msg (car (read-from-string msg)))) | |
243 | (set-buffer folder) | |
244 | (mh-index-update-single-msg msg checksum origin-map))))) | |
245 | (forward-line)))) | |
246 | ;; Run checksum program if needed | |
247 | (unless (and (eobp) (bobp)) | |
248 | (apply #'mh-index-execute mh-checksum-cmd) | |
249 | (goto-char (point-min)) | |
250 | (while (not (eobp)) | |
251 | (let* ((intermediate (funcall mh-checksum-parser)) | |
252 | (msg (car intermediate)) | |
253 | (checksum (cdr intermediate))) | |
254 | (when msg | |
255 | ;; annotate | |
256 | (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum" | |
257 | "-nodate" "-text" checksum "-inplace") | |
258 | ;; update maps | |
259 | (save-excursion | |
260 | (set-buffer folder) | |
261 | (mh-index-update-single-msg msg checksum origin-map))) | |
262 | (forward-line)))))) | |
263 | ||
924df208 BW |
264 | (defvar mh-flists-results-folder "new" |
265 | "Subfolder for `mh-index-folder' where flists output is placed.") | |
266 | ||
c3d9274a BW |
267 | (defun mh-index-generate-pretty-name (string) |
268 | "Given STRING generate a name which is suitable for use as a folder name. | |
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 | |
3d7ca223 BW |
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." | |
c3d9274a | 273 | (with-temp-buffer |
3d7ca223 BW |
274 | (if (stringp string) |
275 | (insert string) | |
276 | (when (car string) (insert (car string))) | |
277 | (dolist (s (cdr string)) | |
278 | (insert "_" s))) | |
279 | (setq string (mh-replace-string "-lbrace" " ")) | |
280 | (setq string (mh-replace-string "-rbrace" " ")) | |
281 | (subst-char-in-region (point-min) (point-max) ?( ? t) | |
282 | (subst-char-in-region (point-min) (point-max) ?) ? t) | |
283 | (subst-char-in-region (point-min) (point-max) ?- ? t) | |
c3d9274a | 284 | (goto-char (point-min)) |
3d7ca223 | 285 | (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_))) |
c3d9274a BW |
286 | (delete-char 1)) |
287 | (goto-char (point-max)) | |
3d7ca223 | 288 | (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_))) |
c3d9274a | 289 | (delete-backward-char 1)) |
3d7ca223 | 290 | (subst-char-in-region (point-min) (point-max) ? ?_ t) |
c3d9274a BW |
291 | (subst-char-in-region (point-min) (point-max) ?\t ?_ t) |
292 | (subst-char-in-region (point-min) (point-max) ?\n ?_ t) | |
293 | (subst-char-in-region (point-min) (point-max) ?\r ?_ t) | |
294 | (subst-char-in-region (point-min) (point-max) ?/ ?$ t) | |
924df208 BW |
295 | (let ((out (truncate-string-to-width (buffer-string) 20))) |
296 | (cond ((eq mh-indexer 'flists) mh-flists-results-folder) | |
297 | ((equal out mh-flists-results-folder) (concat out "1")) | |
298 | (t out))))) | |
c3d9274a BW |
299 | |
300 | ;;;###mh-autoload | |
3d7ca223 | 301 | (defun* mh-index-search (redo-search-flag folder search-regexp |
924df208 | 302 | &optional window-config unseen-flag) |
bdcfe844 | 303 | "Perform an indexed search in an MH mail folder. |
924df208 | 304 | Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. |
bdcfe844 | 305 | |
c3d9274a BW |
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 | |
3d7ca223 BW |
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 | |
924df208 BW |
311 | folder containing the index search results. If optional argument UNSEEN-FLAG |
312 | is non-nil, then all the messages are marked as unseen. | |
bdcfe844 BW |
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' | |
3d7ca223 | 324 | - `mh-mairix-execute-search' |
bdcfe844 | 325 | - `mh-namazu-execute-search' |
c3d9274a BW |
326 | - `mh-glimpse-execute-search' |
327 | ||
3d7ca223 BW |
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 | ||
c3d9274a BW |
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." | |
bdcfe844 | 343 | (interactive |
c3d9274a BW |
344 | (list current-prefix-arg |
345 | (progn | |
bdcfe844 | 346 | (unless mh-find-path-run (mh-find-path)) |
c3d9274a | 347 | (or (and current-prefix-arg (car mh-index-previous-search)) |
3d7ca223 | 348 | (mh-prompt-for-folder "Search" "+" nil "all" t))) |
bdcfe844 BW |
349 | (progn |
350 | ;; Yes, we do want to call mh-index-choose every time in case the | |
351 | ;; user has switched the indexer manually. | |
352 | (unless (mh-index-choose) (error "No indexing program found")) | |
c3d9274a | 353 | (or (and current-prefix-arg (cadr mh-index-previous-search)) |
3d7ca223 | 354 | mh-index-regexp-builder |
c3d9274a BW |
355 | (read-string (format "%s regexp: " |
356 | (upcase-initials | |
3d7ca223 BW |
357 | (symbol-name mh-indexer)))))) |
358 | (if (and (not | |
359 | (and current-prefix-arg (cadr mh-index-previous-search))) | |
360 | mh-index-regexp-builder) | |
361 | (current-window-configuration) | |
362 | nil))) | |
363 | (when (symbolp search-regexp) | |
364 | (mh-search-folder folder window-config) | |
365 | (setq mh-searching-function 'mh-index-do-search) | |
366 | (return-from mh-index-search)) | |
c3d9274a BW |
367 | (mh-checksum-choose) |
368 | (let ((result-count 0) | |
3d7ca223 | 369 | (old-window-config (or window-config mh-previous-window-config)) |
c3d9274a BW |
370 | (previous-search mh-index-previous-search) |
371 | (index-folder (format "%s/%s" mh-index-folder | |
372 | (mh-index-generate-pretty-name search-regexp)))) | |
373 | ;; Create a new folder for the search results or recreate the old one... | |
374 | (if (and redo-search-flag mh-index-previous-search) | |
375 | (let ((buffer-name (buffer-name (current-buffer)))) | |
376 | (mh-process-or-undo-commands buffer-name) | |
377 | (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name)) | |
378 | (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name) | |
379 | (setq index-folder buffer-name)) | |
380 | (setq index-folder (mh-index-new-folder index-folder))) | |
381 | ||
382 | (let ((folder-path (format "%s%s" mh-user-path (substring folder 1))) | |
383 | (folder-results-map (make-hash-table :test #'equal)) | |
384 | (origin-map (make-hash-table :test #'equal))) | |
bdcfe844 | 385 | ;; Run search program... |
c3d9274a | 386 | (message "Executing %s... " mh-indexer) |
bdcfe844 BW |
387 | (funcall mh-index-execute-search-function folder-path search-regexp) |
388 | ||
c3d9274a | 389 | ;; Parse indexer output |
bdcfe844 BW |
390 | (message "Processing %s output... " mh-indexer) |
391 | (goto-char (point-min)) | |
c3d9274a | 392 | (loop for next-result = (funcall mh-index-next-result-function) |
924df208 | 393 | while next-result |
c3d9274a BW |
394 | do (unless (eq next-result 'error) |
395 | (unless (gethash (car next-result) folder-results-map) | |
396 | (setf (gethash (car next-result) folder-results-map) | |
397 | (make-hash-table :test #'equal))) | |
398 | (setf (gethash (cadr next-result) | |
399 | (gethash (car next-result) folder-results-map)) | |
400 | t))) | |
401 | ||
402 | ;; Copy the search results over | |
403 | (maphash #'(lambda (folder msgs) | |
404 | (let ((msgs (sort (loop for msg being the hash-keys of msgs | |
405 | collect msg) | |
406 | #'<))) | |
407 | (mh-exec-cmd "refile" msgs "-src" folder | |
408 | "-link" index-folder) | |
409 | (loop for msg in msgs | |
410 | do (incf result-count) | |
411 | (setf (gethash result-count origin-map) | |
412 | (cons folder msg))))) | |
413 | folder-results-map) | |
bdcfe844 | 414 | |
924df208 BW |
415 | ;; Mark messages as unseen (if needed) |
416 | (when (and unseen-flag (> result-count 0)) | |
417 | (mh-exec-cmd "mark" index-folder "all" | |
418 | "-sequence" (symbol-name mh-unseen-seq) "-add")) | |
419 | ||
bdcfe844 | 420 | ;; Generate scan lines for the hits. |
924df208 | 421 | (mh-visit-folder index-folder () (list folder-results-map origin-map)) |
c3d9274a | 422 | |
bdcfe844 BW |
423 | (goto-char (point-min)) |
424 | (forward-line) | |
c3d9274a BW |
425 | (mh-update-sequences) |
426 | (mh-recenter nil) | |
427 | ||
428 | ;; Maintain history | |
3d7ca223 | 429 | (when (or (and redo-search-flag previous-search) window-config) |
c3d9274a BW |
430 | (setq mh-previous-window-config old-window-config)) |
431 | (setq mh-index-previous-search (list folder search-regexp)) | |
bdcfe844 | 432 | |
bdcfe844 BW |
433 | (message "%s found %s matches in %s folders" |
434 | (upcase-initials (symbol-name mh-indexer)) | |
c3d9274a BW |
435 | (loop for msg-hash being hash-values of mh-index-data |
436 | sum (hash-table-count msg-hash)) | |
437 | (loop for msg-hash being hash-values of mh-index-data | |
438 | count (> (hash-table-count msg-hash) 0)))))) | |
439 | ||
3d7ca223 BW |
440 | ;;;###mh-autoload |
441 | (defun mh-index-do-search () | |
442 | "Construct appropriate regexp and call `mh-index-search'." | |
443 | (interactive) | |
444 | (unless (mh-index-choose) (error "No indexing program found")) | |
445 | (let* ((regexp-list (mh-pick-parse-search-buffer)) | |
446 | (pattern (funcall mh-index-regexp-builder regexp-list))) | |
447 | (if pattern | |
448 | (mh-index-search nil mh-current-folder pattern | |
449 | mh-previous-window-config) | |
450 | (error "No search terms")))) | |
451 | ||
452 | (defun mh-replace-string (old new) | |
453 | "Replace all occurrences of OLD with NEW in the current buffer." | |
454 | (goto-char (point-min)) | |
455 | (while (search-forward old nil t) | |
456 | (replace-match new))) | |
457 | ||
458 | ;;;###mh-autoload | |
459 | (defun mh-index-parse-search-regexp (input-string) | |
460 | "Construct parse tree for INPUT-STRING. | |
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 | ||
c3d9274a BW |
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") | |
924df208 BW |
564 | (if (null mh-index-data) |
565 | (message "Only applicable in an MH-E index search buffer") | |
c3d9274a BW |
566 | (let ((point (point))) |
567 | (forward-line (if backward-flag -1 1)) | |
568 | (cond ((if backward-flag | |
569 | (re-search-backward "^+" (point-min) t) | |
570 | (re-search-forward "^+" (point-max) t)) | |
571 | (beginning-of-line)) | |
572 | ((and (if backward-flag | |
573 | (goto-char (point-max)) | |
574 | (goto-char (point-min))) | |
575 | nil)) | |
576 | ((if backward-flag | |
577 | (re-search-backward "^+" (point-min) t) | |
578 | (re-search-forward "^+" (point-max) t)) | |
579 | (beginning-of-line)) | |
580 | (t (goto-char point)))))) | |
581 | ||
582 | ;;;###mh-autoload | |
583 | (defun mh-index-previous-folder () | |
584 | "Jump to the previous folder marker." | |
bdcfe844 | 585 | (interactive) |
c3d9274a BW |
586 | (mh-index-next-folder t)) |
587 | ||
588 | (defun mh-folder-exists-p (folder) | |
589 | "Check if FOLDER exists." | |
590 | (and (mh-folder-name-p folder) | |
591 | (save-excursion | |
592 | (with-temp-buffer | |
593 | (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder) | |
594 | (goto-char (point-min)) | |
595 | (not (eobp)))))) | |
596 | ||
597 | (defun mh-msg-exists-p (msg folder) | |
598 | "Check if MSG exists in FOLDER." | |
599 | (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg))) | |
600 | ||
601 | (defun mh-index-new-folder (name) | |
602 | "Create and return an MH folder name based on NAME. | |
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) | |
3d7ca223 | 618 | (mh-remove-from-sub-folders-cache chosen-name) |
c3d9274a BW |
619 | (when (boundp 'mh-speed-folder-map) |
620 | (mh-speed-add-folder chosen-name)) | |
c3d9274a BW |
621 | chosen-name)) |
622 | ||
623 | ;;;###mh-autoload | |
624 | (defun mh-index-insert-folder-headers () | |
625 | "Annotate the search results with original folder names." | |
626 | (let ((cur-msg (mh-get-msg-num nil)) | |
627 | (old-buffer-modified-flag (buffer-modified-p)) | |
628 | (buffer-read-only nil) | |
629 | current-folder last-folder) | |
bdcfe844 | 630 | (goto-char (point-min)) |
c3d9274a BW |
631 | (while (not (eobp)) |
632 | (setq current-folder (car (gethash (gethash (mh-get-msg-num nil) | |
633 | mh-index-msg-checksum-map) | |
634 | mh-index-checksum-origin-map))) | |
635 | (when (and current-folder (not (eq current-folder last-folder))) | |
636 | (insert (if last-folder "\n" "") current-folder "\n") | |
637 | (setq last-folder current-folder)) | |
638 | (forward-line)) | |
639 | (when cur-msg (mh-goto-msg cur-msg t)) | |
640 | (set-buffer-modified-p old-buffer-modified-flag))) | |
641 | ||
924df208 BW |
642 | ;;;###mh-autoload |
643 | (defun mh-index-group-by-folder () | |
644 | "Partition the messages based on source folder. | |
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 | ||
c3d9274a BW |
658 | ;;;###mh-autoload |
659 | (defun mh-index-delete-folder-headers () | |
660 | "Delete the folder headers." | |
661 | (let ((cur-msg (mh-get-msg-num nil)) | |
662 | (old-buffer-modified-flag (buffer-modified-p)) | |
663 | (buffer-read-only nil)) | |
3d7ca223 BW |
664 | (while (and (not cur-msg) (not (eobp))) |
665 | (forward-line) | |
666 | (setq cur-msg (mh-get-msg-num nil))) | |
c3d9274a BW |
667 | (goto-char (point-min)) |
668 | (while (not (eobp)) | |
669 | (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10)) | |
670 | (delete-region (point) (progn (forward-line) (point))) | |
bdcfe844 | 671 | (forward-line))) |
c3d9274a BW |
672 | (when cur-msg (mh-goto-msg cur-msg t t)) |
673 | (set-buffer-modified-p old-buffer-modified-flag))) | |
bdcfe844 | 674 | |
c3d9274a BW |
675 | ;;;###mh-autoload |
676 | (defun mh-index-visit-folder () | |
677 | "Visit original folder from where the message at point was found." | |
bdcfe844 | 678 | (interactive) |
c3d9274a BW |
679 | (unless mh-index-data |
680 | (error "Not in an index folder")) | |
681 | (let (folder msg) | |
682 | (save-excursion | |
683 | (cond ((and (bolp) (eolp)) | |
684 | (ignore-errors (forward-line -1)) | |
685 | (setq msg (mh-get-msg-num t))) | |
686 | ((equal (char-after (line-beginning-position)) ?+) | |
687 | (setq folder (buffer-substring-no-properties | |
688 | (line-beginning-position) (line-end-position)))) | |
689 | (t (setq msg (mh-get-msg-num t))))) | |
690 | (when (not folder) | |
691 | (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) | |
692 | mh-index-checksum-origin-map)))) | |
924df208 BW |
693 | (when (or (not (get-buffer folder)) |
694 | (y-or-n-p (format "Reuse buffer displaying %s? " folder))) | |
695 | (mh-visit-folder | |
696 | folder (loop for x being the hash-keys of (gethash folder mh-index-data) | |
697 | when (mh-msg-exists-p x folder) collect x))))) | |
698 | ||
699 | ;;;###mh-autoload | |
700 | (defun mh-index-update-unseen (msg) | |
701 | "Remove counterpart of MSG in source folder from `mh-unseen-seq'. | |
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")))) | |
c3d9274a BW |
715 | |
716 | (defun mh-index-match-checksum (msg folder checksum) | |
717 | "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." | |
718 | (with-temp-buffer | |
719 | (mh-exec-cmd-output mh-scan-prog nil "-width" "80" | |
720 | "-format" "%{x-mhe-checksum}\n" folder msg) | |
721 | (goto-char (point-min)) | |
722 | (string-equal (buffer-substring-no-properties (point) (line-end-position)) | |
723 | checksum))) | |
724 | ||
725 | ;;;###mh-autoload | |
726 | (defun mh-index-execute-commands () | |
727 | "Delete/refile the actual messages. | |
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))) | |
bdcfe844 BW |
743 | |
744 | \f | |
745 | ||
746 | ;; Glimpse interface | |
747 | ||
748 | (defvar mh-glimpse-binary (executable-find "glimpse")) | |
749 | (defvar mh-glimpse-directory ".glimpse") | |
750 | ||
c3d9274a | 751 | ;;;###mh-autoload |
bdcfe844 BW |
752 | (defun mh-glimpse-execute-search (folder-path search-regexp) |
753 | "Execute glimpse and read the results. | |
754 | ||
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 | |
c3d9274a | 766 | ^/home/user/Mail/mhe-index |
bdcfe844 BW |
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 | ||
c3d9274a BW |
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 | ||
bdcfe844 BW |
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 | |
c3d9274a | 787 | ;(format "-%s" fuzz) |
bdcfe844 | 788 | "-i" "-y" |
c3d9274a | 789 | "-H" (format "%s%s" mh-user-path mh-glimpse-directory) |
bdcfe844 BW |
790 | "-F" (format "^%s" folder-path) |
791 | search-regexp) | |
792 | (goto-char (point-min))) | |
793 | ||
794 | (defun mh-glimpse-next-result () | |
795 | "Read the next result. | |
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 | |
c3d9274a BW |
800 | (block nil |
801 | (when (eobp) | |
802 | (return nil)) | |
803 | (let ((eol-pos (line-end-position)) | |
804 | (bol-pos (line-beginning-position)) | |
805 | folder-start msg-end) | |
806 | (goto-char bol-pos) | |
807 | (unless (search-forward mh-user-path eol-pos t) | |
bdcfe844 | 808 | (return 'error)) |
c3d9274a BW |
809 | (setq folder-start (point)) |
810 | (unless (search-forward ": " eol-pos t) | |
811 | (return 'error)) | |
812 | (let ((match (buffer-substring-no-properties (point) eol-pos))) | |
813 | (forward-char -2) | |
814 | (setq msg-end (point)) | |
815 | (unless (search-backward "/" folder-start t) | |
816 | (return 'error)) | |
817 | (list (format "+%s" (buffer-substring-no-properties | |
818 | folder-start (point))) | |
819 | (let ((val (ignore-errors (read-from-string | |
820 | (buffer-substring-no-properties | |
821 | (1+ (point)) msg-end))))) | |
822 | (if (and (consp val) (integerp (car val))) | |
823 | (car val) | |
824 | (return 'error))) | |
825 | match)))) | |
bdcfe844 BW |
826 | (forward-line))) |
827 | ||
828 | \f | |
829 | ||
3d7ca223 BW |
830 | ;; Pick interface |
831 | ||
832 | (defvar mh-index-pick-folder) | |
833 | (defvar mh-pick-binary "pick") | |
834 | ||
835 | (defun mh-pick-execute-search (folder-path search-regexp) | |
836 | "Execute pick. | |
837 | ||
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 | ||
bdcfe844 BW |
867 | ;; Grep interface |
868 | ||
869 | (defvar mh-grep-binary (executable-find "grep")) | |
870 | ||
871 | (defun mh-grep-execute-search (folder-path search-regexp) | |
872 | "Execute grep and read the results. | |
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 | |
c3d9274a BW |
886 | (block nil |
887 | (when (eobp) | |
888 | (return nil)) | |
889 | (let ((eol-pos (line-end-position)) | |
890 | (bol-pos (line-beginning-position)) | |
891 | folder-start msg-end) | |
892 | (goto-char bol-pos) | |
893 | (unless (search-forward mh-user-path eol-pos t) | |
bdcfe844 | 894 | (return 'error)) |
c3d9274a BW |
895 | (setq folder-start (point)) |
896 | (unless (search-forward ":" eol-pos t) | |
897 | (return 'error)) | |
898 | (let ((match (buffer-substring-no-properties (point) eol-pos))) | |
899 | (forward-char -1) | |
900 | (setq msg-end (point)) | |
901 | (unless (search-backward "/" folder-start t) | |
902 | (return 'error)) | |
903 | (list (format "+%s" (buffer-substring-no-properties | |
904 | folder-start (point))) | |
905 | (let ((val (ignore-errors (read-from-string | |
906 | (buffer-substring-no-properties | |
907 | (1+ (point)) msg-end))))) | |
908 | (if (and (consp val) (integerp (car val))) | |
909 | (car val) | |
910 | (return 'error))) | |
911 | match)))) | |
bdcfe844 BW |
912 | (forward-line))) |
913 | ||
914 | \f | |
915 | ||
3d7ca223 BW |
916 | ;; Mairix interface |
917 | ||
918 | (defvar mh-mairix-binary (executable-find "mairix")) | |
919 | (defvar mh-mairix-directory ".mairix") | |
920 | (defvar mh-mairix-folder nil) | |
921 | ||
922 | (defun mh-mairix-execute-search (folder-path search-regexp-list) | |
923 | "Execute mairix and read the results. | |
924 | ||
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 | |
a1506d29 | 933 | |
3d7ca223 BW |
934 | # List of folders that should be indexed. 3 dots at the end means there are |
935 | # subfolders within the folder | |
936 | mh_folders=archive...:inbox:drafts:news:sent:trash | |
a1506d29 | 937 | |
3d7ca223 BW |
938 | vfolder_format=raw |
939 | database=/home/user/Mail/mairix/database | |
940 | ||
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) ?/) | |
924df208 | 968 | (return 'error)) |
3d7ca223 BW |
969 | (let ((start (point)) |
970 | end msg-start) | |
971 | (setq end (line-end-position)) | |
972 | (unless (search-forward mh-mairix-folder end t) | |
973 | (return 'error)) | |
974 | (goto-char (match-beginning 0)) | |
975 | (unless (equal (point) start) | |
976 | (return 'error)) | |
977 | (goto-char end) | |
978 | (unless (search-backward "/" start t) | |
979 | (return 'error)) | |
980 | (setq msg-start (1+ (point))) | |
981 | (goto-char start) | |
982 | (unless (search-forward mh-user-path end t) | |
983 | (return 'error)) | |
984 | (list (format "+%s" (buffer-substring-no-properties | |
985 | (point) (1- msg-start))) | |
986 | (car (read-from-string | |
987 | (buffer-substring-no-properties msg-start end))) | |
988 | ()))) | |
989 | (forward-line))) | |
990 | ||
991 | (defun mh-mairix-regexp-builder (regexp-list) | |
992 | "Generate query for mairix. | |
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 | ||
924df208 BW |
1050 | ;; Interface to unseen messages script |
1051 | ||
1052 | (defvar mh-flists-search-folders) | |
1053 | ||
1054 | (defun mh-flists-execute (&rest args) | |
1055 | "Search for unseen messages in `mh-flists-search-folders'. | |
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 | ||
bdcfe844 BW |
1112 | ;; Swish interface |
1113 | ||
1114 | (defvar mh-swish-binary (executable-find "swish-e")) | |
1115 | (defvar mh-swish-directory ".swish") | |
1116 | (defvar mh-swish-folder nil) | |
1117 | ||
c3d9274a | 1118 | ;;;###mh-autoload |
bdcfe844 BW |
1119 | (defun mh-swish-execute-search (folder-path search-regexp) |
1120 | "Execute swish-e and read the results. | |
1121 | ||
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 | |
c3d9274a | 1145 | FileRules pathname contains /home/user/Mail/mhe-index |
bdcfe844 | 1146 | FileRules filename is index |
3d7ca223 | 1147 | FileRules filename is \\..* |
bdcfe844 BW |
1148 | FileRules filename is #.* |
1149 | FileRules filename is ,.* | |
1150 | FileRules filename is .*~ | |
1151 | ||
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 | ||
c3d9274a BW |
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 | ||
bdcfe844 BW |
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++") | |
c3d9274a | 1219 | (executable-find "search"))) |
bdcfe844 BW |
1220 | (defvar mh-swish++-directory ".swish++") |
1221 | ||
c3d9274a | 1222 | ;;;###mh-autoload |
bdcfe844 BW |
1223 | (defun mh-swish++-execute-search (folder-path search-regexp) |
1224 | "Execute swish++ and read the results. | |
1225 | ||
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 | ||
c3d9274a BW |
1232 | IncludeMeta Bcc Cc Comments Content-Description From Keywords |
1233 | IncludeMeta Newsgroups Resent-To Subject To | |
1234 | IncludeMeta Message-Id References In-Reply-To | |
1235 | IncludeFile Mail * | |
1236 | IndexFile /home/user/Mail/.swish++/swish++.index | |
bdcfe844 BW |
1237 | |
1238 | Use the following command line to generate the swish index. Run this | |
1239 | daily from cron: | |
1240 | ||
c3d9274a BW |
1241 | find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\ |
1242 | -o -path /home/user/Mail/.swish++ -prune \\ | |
1243 | -o -name \"[0-9]*\" -print \\ | |
1244 | | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail | |
1245 | ||
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. | |
bdcfe844 BW |
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 | ||
3d7ca223 BW |
1272 | (defun mh-swish++-regexp-builder (regexp-list) |
1273 | "Generate query for swish++. | |
1274 | REGEXP-LIST is an alist of fields and values." | |
924df208 | 1275 | (let ((regexp "")) |
3d7ca223 BW |
1276 | (dolist (elem regexp-list) |
1277 | (when (cdr elem) | |
1278 | (setq regexp (concat regexp " and " | |
1279 | (if (car elem) "(" "") | |
1280 | (if (car elem) (symbol-name (car elem)) "") | |
1281 | (if (car elem) " = " "") | |
1282 | (mh-swish++-print-regexp (cdr elem)) | |
1283 | (if (car elem) ")" ""))))) | |
1284 | (substring regexp 4))) | |
1285 | ||
1286 | (defun mh-swish++-print-regexp (expr) | |
1287 | "Return infix expression corresponding to EXPR." | |
1288 | (cond ((atom expr) (format "%s" expr)) | |
1289 | ((eq (car expr) 'not) | |
1290 | (format "(not %s)" (mh-swish++-print-regexp (cadr expr)))) | |
1291 | (t (format "(%s %s %s)" (mh-swish++-print-regexp (cadr expr)) | |
1292 | (symbol-name (car expr)) | |
1293 | (mh-swish++-print-regexp (caddr expr)))))) | |
1294 | ||
bdcfe844 BW |
1295 | \f |
1296 | ||
1297 | ;; Namazu interface | |
1298 | ||
1299 | (defvar mh-namazu-binary (executable-find "namazu")) | |
1300 | (defvar mh-namazu-directory ".namazu") | |
1301 | (defvar mh-namazu-folder nil) | |
1302 | ||
c3d9274a | 1303 | ;;;###mh-autoload |
bdcfe844 BW |
1304 | (defun mh-namazu-execute-search (folder-path search-regexp) |
1305 | "Execute namazu and read the results. | |
1306 | ||
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]*\"; | |
c3d9274a BW |
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. | |
bdcfe844 BW |
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 | |
c3d9274a | 1334 | (format "%s%s" mh-user-path mh-namazu-directory))) |
bdcfe844 BW |
1335 | (unless (file-exists-p namazu-index-directory) |
1336 | (error "Namazu directory %s not present" namazu-index-directory)) | |
1337 | (unless (executable-find mh-namazu-binary) | |
1338 | (error "Set mh-namazu-binary appropriately")) | |
1339 | (set-buffer (get-buffer-create mh-index-temp-buffer)) | |
1340 | (erase-buffer) | |
1341 | (call-process mh-namazu-binary nil '(t nil) nil | |
1342 | "-alR" search-regexp namazu-index-directory) | |
1343 | (goto-char (point-min)) | |
1344 | (setq mh-namazu-folder | |
1345 | (let ((last (substring folder-path (1- (length folder-path))))) | |
1346 | (if (equal last "/") | |
1347 | folder-path | |
1348 | (format "%s/" folder-path)))))) | |
1349 | ||
1350 | (defun mh-namazu-next-result () | |
1351 | "Get the next result from namazu output." | |
1352 | (prog1 | |
1353 | (block nil | |
1354 | (when (eobp) (return nil)) | |
1355 | (let ((file-name (buffer-substring-no-properties | |
1356 | (point) (line-end-position)))) | |
1357 | (unless (equal (string-match mh-namazu-folder file-name) 0) | |
1358 | (return 'error)) | |
1359 | (unless (file-exists-p file-name) | |
1360 | (return 'error)) | |
1361 | (string-match mh-user-path file-name) | |
1362 | (let* ((folder/msg (substring file-name (match-end 0))) | |
c3d9274a | 1363 | (mark (mh-search-from-end ?/ folder/msg))) |
bdcfe844 BW |
1364 | (unless mark (return 'error)) |
1365 | (list (format "+%s" (substring folder/msg 0 mark)) | |
1366 | (let ((n (ignore-errors (read-from-string | |
1367 | (substring folder/msg (1+ mark)))))) | |
1368 | (if (and (consp n) (numberp (car n))) | |
1369 | (car n) | |
1370 | (return 'error))) | |
1371 | nil)))) | |
1372 | (forward-line))) | |
1373 | ||
1374 | \f | |
1375 | ||
924df208 | 1376 | ;;;###mh-autoload |
bdcfe844 BW |
1377 | (defun mh-index-choose () |
1378 | "Choose an indexing function. | |
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 | |
c3d9274a | 1389 | (assoc mh-index-program mh-indexer-choices))) |
bdcfe844 BW |
1390 | (mh-indexer |
1391 | (list (assoc mh-indexer mh-indexer-choices))) | |
1392 | (t mh-indexer-choices)))) | |
1393 | (while program-alist | |
1394 | (let* ((current (pop program-alist)) | |
1395 | (executable (symbol-value (cadr current)))) | |
1396 | (when executable | |
1397 | (setq mh-indexer (car current)) | |
3d7ca223 BW |
1398 | (setq mh-index-execute-search-function (nth 2 current)) |
1399 | (setq mh-index-next-result-function (nth 3 current)) | |
1400 | (setq mh-index-regexp-builder (nth 4 current)) | |
bdcfe844 BW |
1401 | (return mh-indexer)))) |
1402 | nil))) | |
1403 | ||
1404 | \f | |
1405 | ||
bdcfe844 BW |
1406 | (provide 'mh-index) |
1407 | ||
1408 | ;;; Local Variables: | |
c3d9274a | 1409 | ;;; indent-tabs-mode: nil |
bdcfe844 BW |
1410 | ;;; sentence-end-double-space: nil |
1411 | ;;; End: | |
1412 | ||
6b61353c | 1413 | ;;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47 |
bdcfe844 | 1414 | ;;; mh-index ends here |