Commit | Line | Data |
---|---|---|
bdcfe844 BW |
1 | ;;; mh-index -- MH-E interface to indexing programs |
2 | ||
af435184 | 3 | ;; Copyright (C) 2002, 2003, 2004, 2005, 2006 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 | |
3a35cf56 LK |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
bdcfe844 BW |
26 | |
27 | ;;; Commentary: | |
28 | ||
cee9f5c6 BW |
29 | ;; (1) The following search engines are supported: |
30 | ;; swish++ | |
31 | ;; swish-e | |
32 | ;; mairix | |
33 | ;; namazu | |
34 | ;; pick | |
35 | ;; grep | |
36 | ;; | |
37 | ;; (2) To use this package, you first have to build an index. Please read | |
38 | ;; the documentation for `mh-index-search' to get started. That | |
39 | ;; documentation will direct you to the specific instructions for your | |
40 | ;; particular indexer. | |
bdcfe844 BW |
41 | |
42 | ;;; Change Log: | |
43 | ||
bdcfe844 BW |
44 | ;;; Code: |
45 | ||
f0d73c14 | 46 | (eval-when-compile (require 'mh-acros)) |
a66894d8 | 47 | (mh-require-cl) |
7094eefe | 48 | |
9c2cf222 | 49 | (require 'mh-buffers) |
bdcfe844 BW |
50 | (require 'mh-e) |
51 | (require 'mh-mime) | |
3d7ca223 | 52 | (require 'mh-pick) |
bdcfe844 | 53 | |
bdcfe844 BW |
54 | (autoload 'gnus-local-map-property "gnus-util") |
55 | (autoload 'gnus-eval-format "gnus-spec") | |
56 | (autoload 'widget-convert-button "wid-edit") | |
bdcfe844 | 57 | |
bdcfe844 BW |
58 | ;; Support different indexing programs |
59 | (defvar mh-indexer-choices | |
60 | '((swish++ | |
3d7ca223 BW |
61 | mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result |
62 | mh-swish++-regexp-builder) | |
bdcfe844 | 63 | (swish |
3d7ca223 BW |
64 | mh-swish-binary mh-swish-execute-search mh-swish-next-result nil) |
65 | (mairix | |
66 | mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result | |
67 | mh-mairix-regexp-builder) | |
bdcfe844 | 68 | (namazu |
3d7ca223 | 69 | mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil) |
3d7ca223 BW |
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 | ||
c3d9274a | 89 | \f |
bdcfe844 | 90 | |
cee9f5c6 BW |
91 | ;; A few different checksum programs are supported. The supported programs |
92 | ;; are: | |
93 | ;; 1. md5sum | |
94 | ;; 2. md5 | |
95 | ;; 3. openssl | |
96 | ;; | |
97 | ;; To add support for your favorite checksum program add a clause to the cond | |
98 | ;; statement in mh-checksum-choose. This should set the variable | |
99 | ;; mh-checksum-cmd to the command line needed to run the checsum program and | |
100 | ;; should set mh-checksum-parser to a function which returns a cons cell | |
101 | ;; containing the message number and checksum string. | |
c3d9274a BW |
102 | |
103 | (defvar mh-checksum-cmd) | |
104 | (defvar mh-checksum-parser) | |
105 | ||
106 | (defun mh-checksum-choose () | |
107 | "Check if a program to create a checksum is present." | |
108 | (unless (boundp 'mh-checksum-cmd) | |
109 | (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path))) | |
110 | (cond ((executable-find "md5sum") | |
111 | (setq mh-checksum-cmd (list (executable-find "md5sum"))) | |
112 | (setq mh-checksum-parser #'mh-md5sum-parser)) | |
113 | ((executable-find "openssl") | |
114 | (setq mh-checksum-cmd (list (executable-find "openssl") "md5")) | |
115 | (setq mh-checksum-parser #'mh-openssl-parser)) | |
116 | ((executable-find "md5") | |
117 | (setq mh-checksum-cmd (list (executable-find "md5"))) | |
118 | (setq mh-checksum-parser #'mh-md5-parser)) | |
119 | (t (error "No suitable checksum program")))))) | |
120 | ||
121 | (defun mh-md5sum-parser () | |
122 | "Parse md5sum output." | |
123 | (let ((begin (line-beginning-position)) | |
124 | (end (line-end-position)) | |
125 | first-space last-slash) | |
126 | (setq first-space (search-forward " " end t)) | |
127 | (goto-char end) | |
128 | (setq last-slash (search-backward "/" begin t)) | |
129 | (cond ((and first-space last-slash) | |
130 | (cons (car (read-from-string (buffer-substring-no-properties | |
131 | (1+ last-slash) end))) | |
132 | (buffer-substring-no-properties begin (1- first-space)))) | |
133 | (t (cons nil nil))))) | |
134 | ||
135 | (defun mh-openssl-parser () | |
136 | "Parse openssl output." | |
137 | (let ((begin (line-beginning-position)) | |
138 | (end (line-end-position)) | |
139 | last-space last-slash) | |
140 | (goto-char end) | |
141 | (setq last-space (search-backward " " begin t)) | |
142 | (setq last-slash (search-backward "/" begin t)) | |
143 | (cond ((and last-slash last-space) | |
144 | (cons (car (read-from-string (buffer-substring-no-properties | |
145 | (1+ last-slash) (1- last-space)))) | |
146 | (buffer-substring-no-properties (1+ last-space) end)))))) | |
147 | ||
148 | (defalias 'mh-md5-parser 'mh-openssl-parser) | |
bdcfe844 BW |
149 | |
150 | \f | |
151 | ||
cee9f5c6 | 152 | ;; Make sure that we don't produce too long a command line. |
c3d9274a BW |
153 | (defvar mh-index-max-cmdline-args 500 |
154 | "Maximum number of command line args.") | |
155 | ||
156 | (defun mh-index-execute (cmd &rest args) | |
157 | "Partial imitation of xargs. | |
2dcf34f9 BW |
158 | The current buffer contains a list of strings, one on each line. |
159 | The function will execute CMD with ARGS and pass the first | |
160 | `mh-index-max-cmdline-args' strings to it. This is repeated till | |
161 | all the strings have been used." | |
c3d9274a | 162 | (goto-char (point-min)) |
924df208 BW |
163 | (let ((current-buffer (current-buffer))) |
164 | (with-temp-buffer | |
165 | (let ((out (current-buffer))) | |
166 | (set-buffer current-buffer) | |
167 | (while (not (eobp)) | |
168 | (let ((arg-list (reverse args)) | |
169 | (count 0)) | |
170 | (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) | |
171 | (push (buffer-substring-no-properties (point) (line-end-position)) | |
172 | arg-list) | |
173 | (incf count) | |
174 | (forward-line)) | |
175 | (apply #'call-process cmd nil (list out nil) nil | |
176 | (nreverse arg-list)))) | |
177 | (erase-buffer) | |
178 | (insert-buffer-substring out))))) | |
bdcfe844 BW |
179 | |
180 | \f | |
181 | ||
c3d9274a BW |
182 | (defun mh-index-update-single-msg (msg checksum origin-map) |
183 | "Update various maps for one message. | |
2dcf34f9 BW |
184 | MSG is a index folder message, CHECKSUM its MD5 hash and |
185 | ORIGIN-MAP, if non-nil, a hashtable containing which maps each | |
186 | message in the index folder to the folder and message that it was | |
187 | copied from. The function updates the hash tables | |
188 | `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'. | |
189 | ||
190 | This function should only be called in the appropriate index | |
191 | folder buffer." | |
c3d9274a BW |
192 | (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map)) |
193 | (let* ((intermediate (gethash msg origin-map)) | |
194 | (ofolder (car intermediate)) | |
195 | (omsg (cdr intermediate))) | |
196 | ;; This is most probably a duplicate. So eliminate it. | |
197 | (call-process "rm" nil nil nil | |
198 | (format "%s%s/%s" mh-user-path | |
199 | (substring mh-current-folder 1) msg)) | |
f0d73c14 BW |
200 | (when (gethash ofolder mh-index-data) |
201 | (remhash omsg (gethash ofolder mh-index-data))))) | |
c3d9274a BW |
202 | (t |
203 | (setf (gethash msg mh-index-msg-checksum-map) checksum) | |
204 | (when origin-map | |
205 | (setf (gethash checksum mh-index-checksum-origin-map) | |
206 | (gethash msg origin-map)))))) | |
207 | ||
208 | ;;;###mh-autoload | |
209 | (defun mh-index-update-maps (folder &optional origin-map) | |
210 | "Annotate all as yet unannotated messages in FOLDER with their MD5 hash. | |
2dcf34f9 BW |
211 | As a side effect msg -> checksum map is updated. Optional |
212 | argument ORIGIN-MAP is a hashtable which maps each message in the | |
213 | index folder to the original folder and message from whence it | |
214 | was copied. If present the checksum -> (origin-folder, | |
215 | origin-index) map is updated too." | |
c3d9274a BW |
216 | (clrhash mh-index-msg-checksum-map) |
217 | (save-excursion | |
218 | ;; Clear temp buffer | |
9c2cf222 | 219 | (set-buffer (get-buffer-create mh-temp-checksum-buffer)) |
c3d9274a BW |
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 | 235 | ;; need to compute checksum |
9c2cf222 | 236 | (set-buffer mh-temp-checksum-buffer) |
c3d9274a BW |
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))) | |
a66894d8 BW |
262 | (forward-line))))) |
263 | (mh-index-write-data)) | |
c3d9274a | 264 | |
a66894d8 BW |
265 | (defvar mh-unpropagated-sequences '(cur range subject search) |
266 | "List of sequences that aren't preserved.") | |
267 | ||
268 | (defun mh-unpropagated-sequences () | |
269 | "Return a list of sequences that aren't propagated to the source folders. | |
2dcf34f9 BW |
270 | It is just the sequences in the variable |
271 | `mh-unpropagated-sequences' in addition to the | |
272 | Previous-Sequence (see mh-profile 5)." | |
a66894d8 BW |
273 | (if mh-previous-seq |
274 | (cons mh-previous-seq mh-unpropagated-sequences) | |
275 | mh-unpropagated-sequences)) | |
276 | ||
277 | ;;;###mh-autoload | |
278 | (defun mh-create-sequence-map (seq-list) | |
279 | "Return a map from msg number to list of sequences in which it is present. | |
2dcf34f9 BW |
280 | SEQ-LIST is an assoc list whose keys are sequence names and whose |
281 | cdr is the list of messages in that sequence." | |
a66894d8 BW |
282 | (loop with map = (make-hash-table) |
283 | for seq in seq-list | |
284 | when (and (not (memq (car seq) (mh-unpropagated-sequences))) | |
285 | (mh-valid-seq-p (car seq))) | |
286 | do (loop for msg in (cdr seq) | |
287 | do (push (car seq) (gethash msg map))) | |
288 | finally return map)) | |
289 | ||
290 | ;;;###mh-autoload | |
291 | (defun mh-index-create-sequences () | |
292 | "Mirror sequences present in source folders in index folder." | |
293 | (let ((seq-hash (make-hash-table :test #'equal)) | |
294 | (seq-list ())) | |
295 | (loop for folder being the hash-keys of mh-index-data | |
296 | do (setf (gethash folder seq-hash) | |
297 | (mh-create-sequence-map | |
298 | (mh-read-folder-sequences folder nil)))) | |
299 | (dolist (msg (mh-translate-range mh-current-folder "all")) | |
300 | (let* ((checksum (gethash msg mh-index-msg-checksum-map)) | |
301 | (pair (gethash checksum mh-index-checksum-origin-map)) | |
302 | (ofolder (car pair)) | |
303 | (omsg (cdr pair))) | |
f0d73c14 BW |
304 | (loop for seq in (ignore-errors |
305 | (gethash omsg (gethash ofolder seq-hash))) | |
a66894d8 BW |
306 | do (if (assoc seq seq-list) |
307 | (push msg (cdr (assoc seq seq-list))) | |
308 | (push (list seq msg) seq-list))))) | |
309 | (loop for seq in seq-list | |
310 | do (apply #'mh-exec-cmd "mark" mh-current-folder | |
311 | "-sequence" (symbol-name (car seq)) "-add" | |
312 | (mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) | |
313 | ||
314 | (defvar mh-flists-results-folder "sequence" | |
924df208 | 315 | "Subfolder for `mh-index-folder' where flists output is placed.") |
a66894d8 BW |
316 | (defvar mh-flists-sequence) |
317 | (defvar mh-flists-called-flag nil) | |
924df208 | 318 | |
c3d9274a BW |
319 | (defun mh-index-generate-pretty-name (string) |
320 | "Given STRING generate a name which is suitable for use as a folder name. | |
2dcf34f9 BW |
321 | White space from the beginning and end are removed. All spaces in |
322 | the name are replaced with underscores and all / are replaced | |
323 | with $. If STRING is longer than 20 it is truncated too. STRING | |
324 | could be a list of strings in which case they are concatenated to | |
325 | construct the base name." | |
c3d9274a | 326 | (with-temp-buffer |
3d7ca223 BW |
327 | (if (stringp string) |
328 | (insert string) | |
329 | (when (car string) (insert (car string))) | |
330 | (dolist (s (cdr string)) | |
331 | (insert "_" s))) | |
332 | (setq string (mh-replace-string "-lbrace" " ")) | |
333 | (setq string (mh-replace-string "-rbrace" " ")) | |
334 | (subst-char-in-region (point-min) (point-max) ?( ? t) | |
335 | (subst-char-in-region (point-min) (point-max) ?) ? t) | |
336 | (subst-char-in-region (point-min) (point-max) ?- ? t) | |
c3d9274a | 337 | (goto-char (point-min)) |
3d7ca223 | 338 | (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_))) |
c3d9274a BW |
339 | (delete-char 1)) |
340 | (goto-char (point-max)) | |
3d7ca223 | 341 | (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_))) |
c3d9274a | 342 | (delete-backward-char 1)) |
3d7ca223 | 343 | (subst-char-in-region (point-min) (point-max) ? ?_ t) |
c3d9274a BW |
344 | (subst-char-in-region (point-min) (point-max) ?\t ?_ t) |
345 | (subst-char-in-region (point-min) (point-max) ?\n ?_ t) | |
346 | (subst-char-in-region (point-min) (point-max) ?\r ?_ t) | |
347 | (subst-char-in-region (point-min) (point-max) ?/ ?$ t) | |
924df208 | 348 | (let ((out (truncate-string-to-width (buffer-string) 20))) |
a66894d8 BW |
349 | (cond ((eq mh-indexer 'flists) |
350 | (format "%s/%s" mh-flists-results-folder mh-flists-sequence)) | |
924df208 BW |
351 | ((equal out mh-flists-results-folder) (concat out "1")) |
352 | (t out))))) | |
c3d9274a BW |
353 | |
354 | ;;;###mh-autoload | |
3d7ca223 | 355 | (defun* mh-index-search (redo-search-flag folder search-regexp |
a66894d8 | 356 | &optional window-config) |
bdcfe844 | 357 | "Perform an indexed search in an MH mail folder. |
2dcf34f9 | 358 | |
af435184 | 359 | Use a prefix argument to repeat the last search. |
e495eaec | 360 | |
af435184 BW |
361 | Unlike regular searches, the prompt for the folder to search can |
362 | be \"all\" to search all folders; in addition, the search works | |
363 | recursively on the listed folder. The search criteria are entered | |
364 | in an MH-Pick buffer as described in `mh-search-folder'.\\<mh-pick-mode-map> | |
2dcf34f9 | 365 | |
af435184 BW |
366 | To perform the search, type \\[mh-do-search]. Another difference |
367 | from the regular searches is that because the search operates on | |
368 | more than one folder, the messages that are found are put in a | |
369 | temporary sub-folder of \"+mhe-index\" and are displayed in an | |
370 | MH-Folder buffer. This buffer is special because it displays | |
2dcf34f9 | 371 | messages from multiple folders; each set of messages from a given |
af435184 BW |
372 | folder has a heading with the folder name.\\<mh-folder-mode-map> |
373 | ||
374 | The appearance of the heading can be modified by customizing the | |
375 | face `mh-index-folder'. You can jump back and forth between the | |
376 | headings using the commands \\[mh-index-next-folder] and | |
377 | \\[mh-index-previous-folder]. | |
378 | ||
379 | In addition, the command \\[mh-index-visit-folder] can be used to | |
380 | visit the folder of the message at point. Initially, only the | |
381 | messages that matched the search criteria are displayed in the | |
382 | folder. While the temporary buffer has its own set of message | |
383 | numbers, the actual messages numbers are shown in the visited | |
384 | folder. Thus, the command \\[mh-index-visit-folder] is useful to | |
385 | find the actual message number of an interesting message, or to | |
386 | view surrounding messages with the command \\[mh-rescan-folder]. | |
387 | ||
388 | Because this folder is temporary, you'll probably get in the | |
389 | habit of killing it when you're done with | |
390 | \\[mh-kill-folder]. | |
391 | ||
392 | If you have run the command \\[mh-search-folder], but change your | |
393 | mind while entering the search criteria and actually want to run | |
394 | an indexed search, then you can use the command | |
395 | \\<mh-pick-mode-map>\\[mh-index-do-search] in the MH-Pick | |
396 | buffer.\\<mh-folder-mode-map> | |
397 | ||
398 | The command \\[mh-index-search] runs the command defined by the | |
399 | option `mh-index-program'. The default value is \"Auto-detect\" | |
400 | which means that MH-E will automatically choose one of | |
2dcf34f9 | 401 | \"swish++\", \"swish-e\", \"mairix\", \"namazu\", \"pick\" and |
af435184 BW |
402 | \"grep\" in that order. If, for example, you have both |
403 | \"swish++\" and \"mairix\" installed and you want to use | |
404 | \"mairix\", then you can set this option to \"mairix\". | |
e495eaec BW |
405 | |
406 | *NOTE* | |
407 | ||
2dcf34f9 BW |
408 | The \"pick\" and \"grep\" commands do not perform a |
409 | recursive search on the given folder. | |
e495eaec | 410 | |
2dcf34f9 BW |
411 | This command uses an \"X-MHE-Checksum:\" header field to cache |
412 | the MD5 checksum of a message. This means that if an incoming | |
413 | message already contains an \"X-MHE-Checksum:\" field, that | |
414 | message might not be found by this command. The following | |
415 | \"procmail\" recipe avoids this problem by renaming the existing | |
e495eaec BW |
416 | header field: |
417 | ||
418 | :0 wf | |
419 | | formail -R \"X-MHE-Checksum\" \"X-Old-MHE-Checksum\" | |
420 | ||
2dcf34f9 BW |
421 | The documentation for the following commands describe how to set |
422 | up the various indexing programs to use with MH-E. The \"pick\" | |
423 | and \"grep\" commands do not require additional configuration. | |
bdcfe844 BW |
424 | |
425 | - `mh-swish++-execute-search' | |
426 | - `mh-swish-execute-search' | |
3d7ca223 | 427 | - `mh-mairix-execute-search' |
bdcfe844 | 428 | - `mh-namazu-execute-search' |
3d7ca223 BW |
429 | - `mh-pick-execute-search' |
430 | - `mh-grep-execute-search' | |
431 | ||
2dcf34f9 BW |
432 | In a program, if REDO-SEARCH-FLAG is non-nil and the current |
433 | folder buffer was generated by a index search, then the search is | |
434 | repeated. Otherwise, FOLDER is searched with SEARCH-REGEXP and | |
435 | the results are presented in an MH-E folder. If FOLDER is \"+\" | |
436 | then mail in all folders are searched. Optional argument | |
437 | WINDOW-CONFIG stores the window configuration that will be | |
438 | restored after the user quits the folder containing the index | |
439 | search results." | |
bdcfe844 | 440 | (interactive |
c3d9274a BW |
441 | (list current-prefix-arg |
442 | (progn | |
191c8741 | 443 | (mh-find-path) |
a66894d8 BW |
444 | (or (and current-prefix-arg mh-index-sequence-search-flag) |
445 | (and current-prefix-arg (car mh-index-previous-search)) | |
3d7ca223 | 446 | (mh-prompt-for-folder "Search" "+" nil "all" t))) |
bdcfe844 BW |
447 | (progn |
448 | ;; Yes, we do want to call mh-index-choose every time in case the | |
449 | ;; user has switched the indexer manually. | |
450 | (unless (mh-index-choose) (error "No indexing program found")) | |
c3d9274a | 451 | (or (and current-prefix-arg (cadr mh-index-previous-search)) |
3d7ca223 | 452 | mh-index-regexp-builder |
c3d9274a BW |
453 | (read-string (format "%s regexp: " |
454 | (upcase-initials | |
3d7ca223 BW |
455 | (symbol-name mh-indexer)))))) |
456 | (if (and (not | |
457 | (and current-prefix-arg (cadr mh-index-previous-search))) | |
458 | mh-index-regexp-builder) | |
459 | (current-window-configuration) | |
460 | nil))) | |
a66894d8 BW |
461 | ;; Redoing a sequence search? |
462 | (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag | |
463 | (not mh-flists-called-flag)) | |
464 | (let ((mh-flists-called-flag t)) | |
465 | (apply #'mh-index-sequenced-messages mh-index-previous-search)) | |
466 | (return-from mh-index-search)) | |
467 | ;; We have fancy query parsing | |
3d7ca223 BW |
468 | (when (symbolp search-regexp) |
469 | (mh-search-folder folder window-config) | |
470 | (setq mh-searching-function 'mh-index-do-search) | |
471 | (return-from mh-index-search)) | |
c3d9274a BW |
472 | (mh-checksum-choose) |
473 | (let ((result-count 0) | |
3d7ca223 | 474 | (old-window-config (or window-config mh-previous-window-config)) |
c3d9274a BW |
475 | (previous-search mh-index-previous-search) |
476 | (index-folder (format "%s/%s" mh-index-folder | |
477 | (mh-index-generate-pretty-name search-regexp)))) | |
478 | ;; Create a new folder for the search results or recreate the old one... | |
479 | (if (and redo-search-flag mh-index-previous-search) | |
480 | (let ((buffer-name (buffer-name (current-buffer)))) | |
481 | (mh-process-or-undo-commands buffer-name) | |
482 | (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name)) | |
483 | (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name) | |
484 | (setq index-folder buffer-name)) | |
f0d73c14 | 485 | (setq index-folder (mh-index-new-folder index-folder search-regexp))) |
c3d9274a BW |
486 | |
487 | (let ((folder-path (format "%s%s" mh-user-path (substring folder 1))) | |
488 | (folder-results-map (make-hash-table :test #'equal)) | |
489 | (origin-map (make-hash-table :test #'equal))) | |
bdcfe844 | 490 | ;; Run search program... |
c3d9274a | 491 | (message "Executing %s... " mh-indexer) |
bdcfe844 BW |
492 | (funcall mh-index-execute-search-function folder-path search-regexp) |
493 | ||
c3d9274a | 494 | ;; Parse indexer output |
bdcfe844 BW |
495 | (message "Processing %s output... " mh-indexer) |
496 | (goto-char (point-min)) | |
c3d9274a | 497 | (loop for next-result = (funcall mh-index-next-result-function) |
924df208 | 498 | while next-result |
c3d9274a BW |
499 | do (unless (eq next-result 'error) |
500 | (unless (gethash (car next-result) folder-results-map) | |
501 | (setf (gethash (car next-result) folder-results-map) | |
502 | (make-hash-table :test #'equal))) | |
503 | (setf (gethash (cadr next-result) | |
504 | (gethash (car next-result) folder-results-map)) | |
505 | t))) | |
506 | ||
507 | ;; Copy the search results over | |
508 | (maphash #'(lambda (folder msgs) | |
a66894d8 BW |
509 | (let ((cur (car (mh-translate-range folder "cur"))) |
510 | (msgs (sort (loop for msg being the hash-keys of msgs | |
c3d9274a BW |
511 | collect msg) |
512 | #'<))) | |
513 | (mh-exec-cmd "refile" msgs "-src" folder | |
514 | "-link" index-folder) | |
a66894d8 BW |
515 | ;; Restore cur to old value, that refile changed |
516 | (when cur | |
517 | (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" | |
518 | "-sequence" "cur" (format "%s" cur))) | |
c3d9274a BW |
519 | (loop for msg in msgs |
520 | do (incf result-count) | |
521 | (setf (gethash result-count origin-map) | |
522 | (cons folder msg))))) | |
523 | folder-results-map) | |
bdcfe844 | 524 | |
a66894d8 | 525 | ;; Vist the results folder |
924df208 | 526 | (mh-visit-folder index-folder () (list folder-results-map origin-map)) |
c3d9274a | 527 | |
bdcfe844 BW |
528 | (goto-char (point-min)) |
529 | (forward-line) | |
c3d9274a BW |
530 | (mh-update-sequences) |
531 | (mh-recenter nil) | |
532 | ||
a66894d8 BW |
533 | ;; Update the speedbar, if needed |
534 | (when (mh-speed-flists-active-p) | |
535 | (mh-speed-flists t mh-current-folder)) | |
536 | ||
c3d9274a | 537 | ;; Maintain history |
3d7ca223 | 538 | (when (or (and redo-search-flag previous-search) window-config) |
c3d9274a BW |
539 | (setq mh-previous-window-config old-window-config)) |
540 | (setq mh-index-previous-search (list folder search-regexp)) | |
bdcfe844 | 541 | |
a66894d8 BW |
542 | ;; Write out data to disk |
543 | (unless mh-flists-called-flag (mh-index-write-data)) | |
544 | ||
bdcfe844 BW |
545 | (message "%s found %s matches in %s folders" |
546 | (upcase-initials (symbol-name mh-indexer)) | |
c3d9274a BW |
547 | (loop for msg-hash being hash-values of mh-index-data |
548 | sum (hash-table-count msg-hash)) | |
549 | (loop for msg-hash being hash-values of mh-index-data | |
550 | count (> (hash-table-count msg-hash) 0)))))) | |
551 | ||
a66894d8 BW |
552 | \f |
553 | ||
554 | ;;; Functions to serialize index data... | |
555 | ||
556 | (defun mh-index-write-data () | |
557 | "Write index data to file." | |
558 | (ignore-errors | |
559 | (unless (eq major-mode 'mh-folder-mode) | |
5a4aad03 | 560 | (error "Can't be called from folder in \"%s\"" major-mode)) |
a66894d8 BW |
561 | (let ((data mh-index-data) |
562 | (msg-checksum-map mh-index-msg-checksum-map) | |
563 | (checksum-origin-map mh-index-checksum-origin-map) | |
564 | (previous-search mh-index-previous-search) | |
565 | (sequence-search-flag mh-index-sequence-search-flag) | |
566 | (outfile (concat buffer-file-name mh-index-data-file)) | |
567 | (print-length nil) | |
568 | (print-level nil)) | |
569 | (with-temp-file outfile | |
570 | (mh-index-write-hashtable | |
571 | data (lambda (x) (loop for y being the hash-keys of x collect y))) | |
572 | (mh-index-write-hashtable msg-checksum-map #'identity) | |
573 | (mh-index-write-hashtable checksum-origin-map #'identity) | |
574 | (pp previous-search (current-buffer)) (insert "\n") | |
575 | (pp sequence-search-flag (current-buffer)) (insert "\n"))))) | |
576 | ||
577 | ;;;###mh-autoload | |
578 | (defun mh-index-read-data () | |
579 | "Read index data from file." | |
580 | (ignore-errors | |
581 | (unless (eq major-mode 'mh-folder-mode) | |
5a4aad03 | 582 | (error "Can't be called from folder in \"%s\"" major-mode)) |
a66894d8 BW |
583 | (let ((infile (concat buffer-file-name mh-index-data-file)) |
584 | t1 t2 t3 t4 t5) | |
585 | (with-temp-buffer | |
586 | (insert-file-contents-literally infile) | |
587 | (goto-char (point-min)) | |
588 | (setq t1 (mh-index-read-hashtable | |
589 | (lambda (data) | |
590 | (loop with table = (make-hash-table :test #'equal) | |
591 | for x in data do (setf (gethash x table) t) | |
592 | finally return table))) | |
593 | t2 (mh-index-read-hashtable #'identity) | |
594 | t3 (mh-index-read-hashtable #'identity) | |
595 | t4 (read (current-buffer)) | |
596 | t5 (read (current-buffer)))) | |
597 | (setq mh-index-data t1 | |
598 | mh-index-msg-checksum-map t2 | |
599 | mh-index-checksum-origin-map t3 | |
600 | mh-index-previous-search t4 | |
601 | mh-index-sequence-search-flag t5)))) | |
602 | ||
603 | (defun mh-index-write-hashtable (table proc) | |
604 | "Write TABLE to `current-buffer'. | |
2dcf34f9 BW |
605 | PROC is used to serialize the values corresponding to the hash |
606 | table keys." | |
a66894d8 BW |
607 | (pp (loop for x being the hash-keys of table |
608 | collect (cons x (funcall proc (gethash x table)))) | |
609 | (current-buffer)) | |
610 | (insert "\n")) | |
611 | ||
612 | (defun mh-index-read-hashtable (proc) | |
613 | "From BUFFER read a hash table serialized as a list. | |
614 | PROC is used to convert the value to actual data." | |
615 | (loop with table = (make-hash-table :test #'equal) | |
616 | for pair in (read (current-buffer)) | |
617 | do (setf (gethash (car pair) table) (funcall proc (cdr pair))) | |
618 | finally return table)) | |
619 | ||
620 | ;;;###mh-autoload | |
621 | (defun mh-index-p () | |
622 | "Non-nil means that this folder was generated by an index search." | |
623 | mh-index-data) | |
624 | ||
3d7ca223 BW |
625 | ;;;###mh-autoload |
626 | (defun mh-index-do-search () | |
af435184 | 627 | "Find messages that match the qualifications in the current pattern buffer." |
3d7ca223 BW |
628 | (interactive) |
629 | (unless (mh-index-choose) (error "No indexing program found")) | |
630 | (let* ((regexp-list (mh-pick-parse-search-buffer)) | |
631 | (pattern (funcall mh-index-regexp-builder regexp-list))) | |
632 | (if pattern | |
633 | (mh-index-search nil mh-current-folder pattern | |
634 | mh-previous-window-config) | |
635 | (error "No search terms")))) | |
636 | ||
3d7ca223 BW |
637 | ;;;###mh-autoload |
638 | (defun mh-index-parse-search-regexp (input-string) | |
639 | "Construct parse tree for INPUT-STRING. | |
2dcf34f9 BW |
640 | All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by |
641 | AND, OR and NOT as appropriate. Then the resulting string is | |
642 | parsed." | |
3d7ca223 BW |
643 | (let (input) |
644 | (with-temp-buffer | |
645 | (insert input-string) | |
3d7ca223 BW |
646 | ;; replace tabs |
647 | (mh-replace-string "\t" " ") | |
648 | ;; synonyms of AND | |
a66894d8 | 649 | (mh-replace-string " AND " " and ") |
3d7ca223 BW |
650 | (mh-replace-string "&" " and ") |
651 | (mh-replace-string " -and " " and ") | |
652 | ;; synonyms of OR | |
a66894d8 | 653 | (mh-replace-string " OR " " or ") |
3d7ca223 BW |
654 | (mh-replace-string "|" " or ") |
655 | (mh-replace-string " -or " " or ") | |
656 | ;; synonyms of NOT | |
a66894d8 | 657 | (mh-replace-string " NOT " " not ") |
3d7ca223 BW |
658 | (mh-replace-string "!" " not ") |
659 | (mh-replace-string "~" " not ") | |
660 | (mh-replace-string " -not " " not ") | |
661 | ;; synonyms of left brace | |
662 | (mh-replace-string "(" " ( ") | |
663 | (mh-replace-string " -lbrace " " ( ") | |
664 | ;; synonyms of right brace | |
665 | (mh-replace-string ")" " ) ") | |
666 | (mh-replace-string " -rbrace " " ) ") | |
667 | ;; get the normalized input | |
668 | (setq input (format "( %s )" (buffer-substring (point-min) (point-max))))) | |
669 | ||
670 | (let ((tokens (mh-index-add-implicit-ops (split-string input))) | |
671 | (op-stack ()) | |
672 | (operand-stack ()) | |
673 | oper1) | |
674 | (dolist (token tokens) | |
675 | (cond ((equal token "(") (push 'paren op-stack)) | |
676 | ((equal token "not") (push 'not op-stack)) | |
677 | ((equal token "or") (push 'or op-stack)) | |
678 | ((equal token "and") (push 'and op-stack)) | |
679 | ((equal token ")") | |
680 | (multiple-value-setq (op-stack operand-stack) | |
681 | (mh-index-evaluate op-stack operand-stack)) | |
682 | (when (eq (car op-stack) 'not) | |
a66894d8 | 683 | (setq op-stack (cdr op-stack)) |
3d7ca223 BW |
684 | (push `(not ,(pop operand-stack)) operand-stack)) |
685 | (when (eq (car op-stack) 'and) | |
a66894d8 | 686 | (setq op-stack (cdr op-stack)) |
3d7ca223 BW |
687 | (setq oper1 (pop operand-stack)) |
688 | (push `(and ,(pop operand-stack) ,oper1) operand-stack))) | |
689 | ((eq (car op-stack) 'not) | |
a66894d8 | 690 | (setq op-stack (cdr op-stack)) |
3d7ca223 BW |
691 | (push `(not ,token) operand-stack) |
692 | (when (eq (car op-stack) 'and) | |
a66894d8 | 693 | (setq op-stack (cdr op-stack)) |
3d7ca223 BW |
694 | (setq oper1 (pop operand-stack)) |
695 | (push `(and ,(pop operand-stack) ,oper1) operand-stack))) | |
696 | ((eq (car op-stack) 'and) | |
a66894d8 | 697 | (setq op-stack (cdr op-stack)) |
3d7ca223 BW |
698 | (push `(and ,(pop operand-stack) ,token) operand-stack)) |
699 | (t (push token operand-stack)))) | |
700 | (prog1 (pop operand-stack) | |
701 | (when (or op-stack operand-stack) | |
702 | (error "Invalid regexp: %s" input)))))) | |
703 | ||
704 | (defun mh-index-add-implicit-ops (tokens) | |
705 | "Add implicit operators in the list TOKENS." | |
706 | (let ((result ()) | |
707 | (literal-seen nil) | |
708 | current) | |
709 | (while tokens | |
710 | (setq current (pop tokens)) | |
711 | (cond ((or (equal current ")") (equal current "and") (equal current "or")) | |
712 | (setq literal-seen nil) | |
713 | (push current result)) | |
714 | ((and literal-seen | |
715 | (push "and" result) | |
716 | (setq literal-seen nil) | |
717 | nil)) | |
718 | (t | |
719 | (push current result) | |
720 | (unless (or (equal current "(") (equal current "not")) | |
721 | (setq literal-seen t))))) | |
722 | (nreverse result))) | |
723 | ||
724 | (defun mh-index-evaluate (op-stack operand-stack) | |
725 | "Read expression till starting paren based on OP-STACK and OPERAND-STACK." | |
726 | (block mh-index-evaluate | |
727 | (let (op oper1) | |
728 | (while op-stack | |
729 | (setq op (pop op-stack)) | |
730 | (cond ((eq op 'paren) | |
731 | (return-from mh-index-evaluate (values op-stack operand-stack))) | |
732 | ((eq op 'not) | |
733 | (push `(not ,(pop operand-stack)) operand-stack)) | |
734 | ((or (eq op 'and) (eq op 'or)) | |
735 | (setq oper1 (pop operand-stack)) | |
736 | (push `(,op ,(pop operand-stack) ,oper1) operand-stack)))) | |
737 | (error "Ran out of tokens")))) | |
738 | ||
c3d9274a BW |
739 | ;;;###mh-autoload |
740 | (defun mh-index-next-folder (&optional backward-flag) | |
741 | "Jump to the next folder marker. | |
af435184 | 742 | |
2dcf34f9 BW |
743 | With non-nil optional argument BACKWARD-FLAG, jump to the previous |
744 | group of results." | |
c3d9274a | 745 | (interactive "P") |
924df208 BW |
746 | (if (null mh-index-data) |
747 | (message "Only applicable in an MH-E index search buffer") | |
c3d9274a | 748 | (let ((point (point))) |
2898111c | 749 | (forward-line (if backward-flag 0 1)) |
c3d9274a BW |
750 | (cond ((if backward-flag |
751 | (re-search-backward "^+" (point-min) t) | |
752 | (re-search-forward "^+" (point-max) t)) | |
753 | (beginning-of-line)) | |
754 | ((and (if backward-flag | |
755 | (goto-char (point-max)) | |
756 | (goto-char (point-min))) | |
757 | nil)) | |
758 | ((if backward-flag | |
759 | (re-search-backward "^+" (point-min) t) | |
760 | (re-search-forward "^+" (point-max) t)) | |
761 | (beginning-of-line)) | |
762 | (t (goto-char point)))))) | |
763 | ||
764 | ;;;###mh-autoload | |
765 | (defun mh-index-previous-folder () | |
766 | "Jump to the previous folder marker." | |
bdcfe844 | 767 | (interactive) |
c3d9274a BW |
768 | (mh-index-next-folder t)) |
769 | ||
770 | (defun mh-folder-exists-p (folder) | |
771 | "Check if FOLDER exists." | |
772 | (and (mh-folder-name-p folder) | |
773 | (save-excursion | |
774 | (with-temp-buffer | |
775 | (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder) | |
776 | (goto-char (point-min)) | |
777 | (not (eobp)))))) | |
778 | ||
779 | (defun mh-msg-exists-p (msg folder) | |
780 | "Check if MSG exists in FOLDER." | |
781 | (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg))) | |
782 | ||
f0d73c14 BW |
783 | (defun mh-index-new-folder (name search-regexp) |
784 | "Return a folder name based on NAME for search results of SEARCH-REGEXP. | |
785 | ||
2dcf34f9 BW |
786 | If folder NAME already exists and was generated for the same |
787 | SEARCH-REGEXP then it is reused. | |
f0d73c14 | 788 | |
2dcf34f9 BW |
789 | Otherwise if the folder NAME was generated from a different |
790 | search then check if NAME<2> can be used. Otherwise try NAME<3>. | |
791 | This is repeated till we find a new folder name. | |
f0d73c14 BW |
792 | |
793 | If the folder returned doesn't exist then it is created." | |
c3d9274a BW |
794 | (unless (mh-folder-name-p name) |
795 | (error "The argument should be a valid MH folder name")) | |
f0d73c14 BW |
796 | (let ((chosen-name |
797 | (loop for i from 1 | |
798 | for candidate = (if (equal i 1) name (format "%s<%s>" name i)) | |
799 | when (or (not (mh-folder-exists-p candidate)) | |
800 | (equal (mh-index-folder-search-regexp candidate) | |
801 | search-regexp)) | |
802 | return candidate))) | |
803 | ;; Do pending refiles/deletes... | |
804 | (when (get-buffer chosen-name) | |
805 | (mh-process-or-undo-commands chosen-name)) | |
806 | ;; Recreate folder... | |
807 | (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name)) | |
c3d9274a | 808 | (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) |
3d7ca223 | 809 | (mh-remove-from-sub-folders-cache chosen-name) |
c3d9274a BW |
810 | (when (boundp 'mh-speed-folder-map) |
811 | (mh-speed-add-folder chosen-name)) | |
c3d9274a BW |
812 | chosen-name)) |
813 | ||
f0d73c14 BW |
814 | (defun mh-index-folder-search-regexp (folder) |
815 | "If FOLDER was created by a index search, return the search regexp. | |
2dcf34f9 BW |
816 | Return nil if FOLDER doesn't exist or the .mhe_index file is |
817 | garbled." | |
f0d73c14 BW |
818 | (ignore-errors |
819 | (with-temp-buffer | |
820 | (insert-file-contents | |
821 | (format "%s%s/%s" mh-user-path (substring folder 1) mh-index-data-file)) | |
822 | (goto-char (point-min)) | |
823 | (forward-list 3) | |
824 | (cadr (read (current-buffer)))))) | |
825 | ||
c3d9274a BW |
826 | ;;;###mh-autoload |
827 | (defun mh-index-insert-folder-headers () | |
828 | "Annotate the search results with original folder names." | |
829 | (let ((cur-msg (mh-get-msg-num nil)) | |
830 | (old-buffer-modified-flag (buffer-modified-p)) | |
831 | (buffer-read-only nil) | |
832 | current-folder last-folder) | |
bdcfe844 | 833 | (goto-char (point-min)) |
c3d9274a BW |
834 | (while (not (eobp)) |
835 | (setq current-folder (car (gethash (gethash (mh-get-msg-num nil) | |
836 | mh-index-msg-checksum-map) | |
837 | mh-index-checksum-origin-map))) | |
a66894d8 | 838 | (when (and current-folder (not (equal current-folder last-folder))) |
c3d9274a BW |
839 | (insert (if last-folder "\n" "") current-folder "\n") |
840 | (setq last-folder current-folder)) | |
841 | (forward-line)) | |
f0d73c14 BW |
842 | (when cur-msg |
843 | (mh-notate-cur) | |
844 | (mh-goto-msg cur-msg t)) | |
845 | (set-buffer-modified-p old-buffer-modified-flag)) | |
846 | (mh-index-create-imenu-index)) | |
847 | ||
848 | ;;;###mh-autoload | |
849 | (defun mh-index-create-imenu-index () | |
850 | "Create alist of folder names and positions in index folder buffers." | |
851 | (save-excursion | |
852 | (setq which-func-mode t) | |
853 | (let ((alist ())) | |
854 | (goto-char (point-min)) | |
855 | (while (re-search-forward "^+" nil t) | |
856 | (save-excursion | |
857 | (beginning-of-line) | |
858 | (push (cons (buffer-substring-no-properties | |
859 | (point) (line-end-position)) | |
860 | (set-marker (make-marker) (point))) | |
861 | alist))) | |
862 | (setq imenu--index-alist (nreverse alist))))) | |
c3d9274a | 863 | |
924df208 BW |
864 | ;;;###mh-autoload |
865 | (defun mh-index-group-by-folder () | |
866 | "Partition the messages based on source folder. | |
2dcf34f9 BW |
867 | Returns an alist with the the folder names in the car and the cdr |
868 | being the list of messages originally from that folder." | |
924df208 BW |
869 | (save-excursion |
870 | (goto-char (point-min)) | |
a66894d8 | 871 | (let ((result-table (make-hash-table :test #'equal))) |
924df208 BW |
872 | (loop for msg being hash-keys of mh-index-msg-checksum-map |
873 | do (push msg (gethash (car (gethash | |
874 | (gethash msg mh-index-msg-checksum-map) | |
875 | mh-index-checksum-origin-map)) | |
876 | result-table))) | |
877 | (loop for x being the hash-keys of result-table | |
878 | collect (cons x (nreverse (gethash x result-table))))))) | |
879 | ||
c3d9274a BW |
880 | ;;;###mh-autoload |
881 | (defun mh-index-delete-folder-headers () | |
882 | "Delete the folder headers." | |
883 | (let ((cur-msg (mh-get-msg-num nil)) | |
884 | (old-buffer-modified-flag (buffer-modified-p)) | |
885 | (buffer-read-only nil)) | |
3d7ca223 BW |
886 | (while (and (not cur-msg) (not (eobp))) |
887 | (forward-line) | |
888 | (setq cur-msg (mh-get-msg-num nil))) | |
c3d9274a BW |
889 | (goto-char (point-min)) |
890 | (while (not (eobp)) | |
891 | (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10)) | |
892 | (delete-region (point) (progn (forward-line) (point))) | |
bdcfe844 | 893 | (forward-line))) |
c3d9274a BW |
894 | (when cur-msg (mh-goto-msg cur-msg t t)) |
895 | (set-buffer-modified-p old-buffer-modified-flag))) | |
bdcfe844 | 896 | |
c3d9274a BW |
897 | ;;;###mh-autoload |
898 | (defun mh-index-visit-folder () | |
899 | "Visit original folder from where the message at point was found." | |
bdcfe844 | 900 | (interactive) |
c3d9274a BW |
901 | (unless mh-index-data |
902 | (error "Not in an index folder")) | |
903 | (let (folder msg) | |
904 | (save-excursion | |
905 | (cond ((and (bolp) (eolp)) | |
906 | (ignore-errors (forward-line -1)) | |
907 | (setq msg (mh-get-msg-num t))) | |
908 | ((equal (char-after (line-beginning-position)) ?+) | |
909 | (setq folder (buffer-substring-no-properties | |
910 | (line-beginning-position) (line-end-position)))) | |
911 | (t (setq msg (mh-get-msg-num t))))) | |
912 | (when (not folder) | |
913 | (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) | |
914 | mh-index-checksum-origin-map)))) | |
924df208 BW |
915 | (when (or (not (get-buffer folder)) |
916 | (y-or-n-p (format "Reuse buffer displaying %s? " folder))) | |
917 | (mh-visit-folder | |
918 | folder (loop for x being the hash-keys of (gethash folder mh-index-data) | |
919 | when (mh-msg-exists-p x folder) collect x))))) | |
920 | ||
c3d9274a BW |
921 | (defun mh-index-match-checksum (msg folder checksum) |
922 | "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." | |
923 | (with-temp-buffer | |
924 | (mh-exec-cmd-output mh-scan-prog nil "-width" "80" | |
925 | "-format" "%{x-mhe-checksum}\n" folder msg) | |
926 | (goto-char (point-min)) | |
927 | (string-equal (buffer-substring-no-properties (point) (line-end-position)) | |
928 | checksum))) | |
929 | ||
a66894d8 BW |
930 | (defun mh-index-matching-source-msgs (msgs &optional delete-from-index-data) |
931 | "Return a table of original messages and folders for messages in MSGS. | |
2dcf34f9 BW |
932 | If optional argument DELETE-FROM-INDEX-DATA is non-nil, then each |
933 | of the messages, whose counter-part is found in some source | |
934 | folder, is removed from `mh-index-data'." | |
a66894d8 BW |
935 | (let ((table (make-hash-table :test #'equal))) |
936 | (dolist (msg msgs) | |
937 | (let* ((checksum (gethash msg mh-index-msg-checksum-map)) | |
938 | (pair (gethash checksum mh-index-checksum-origin-map))) | |
939 | (when (and checksum (car pair) (cdr pair) | |
940 | (mh-index-match-checksum (cdr pair) (car pair) checksum)) | |
941 | (push (cdr pair) (gethash (car pair) table)) | |
942 | (when delete-from-index-data | |
943 | (remhash (cdr pair) (gethash (car pair) mh-index-data)))))) | |
944 | table)) | |
945 | ||
c3d9274a BW |
946 | ;;;###mh-autoload |
947 | (defun mh-index-execute-commands () | |
948 | "Delete/refile the actual messages. | |
2dcf34f9 BW |
949 | The copies in the searched folder are then deleted/refiled to get |
950 | the desired result. Before deleting the messages we make sure | |
951 | that the message being deleted is identical to the one that the | |
952 | user has marked in the index buffer." | |
a66894d8 BW |
953 | (save-excursion |
954 | (let ((folders ()) | |
955 | (mh-speed-flists-inhibit-flag t)) | |
956 | (maphash | |
957 | (lambda (folder msgs) | |
958 | (push folder folders) | |
959 | (if (not (get-buffer folder)) | |
960 | ;; If source folder not open, just delete the messages... | |
961 | (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)) | |
962 | ;; Otherwise delete the messages in the source buffer... | |
963 | (save-excursion | |
964 | (set-buffer folder) | |
965 | (let ((old-refile-list mh-refile-list) | |
966 | (old-delete-list mh-delete-list)) | |
967 | (setq mh-refile-list nil | |
968 | mh-delete-list msgs) | |
969 | (unwind-protect (mh-execute-commands) | |
970 | (setq mh-refile-list | |
971 | (mapcar (lambda (x) | |
972 | (cons (car x) | |
973 | (loop for y in (cdr x) | |
974 | unless (memq y msgs) collect y))) | |
975 | old-refile-list) | |
976 | mh-delete-list | |
977 | (loop for x in old-delete-list | |
978 | unless (memq x msgs) collect x)) | |
979 | (mh-set-folder-modified-p (mh-outstanding-commands-p)) | |
980 | (when (mh-outstanding-commands-p) | |
981 | (mh-notate-deleted-and-refiled))))))) | |
982 | (mh-index-matching-source-msgs (append (loop for x in mh-refile-list | |
983 | append (cdr x)) | |
984 | mh-delete-list) | |
985 | t)) | |
986 | folders))) | |
987 | ||
988 | ;;;###mh-autoload | |
989 | (defun mh-index-add-to-sequence (seq msgs) | |
990 | "Add to SEQ the messages in the list MSGS. | |
2dcf34f9 BW |
991 | This function updates the source folder sequences. Also makes an |
992 | attempt to update the source folder buffer if we have it open." | |
a66894d8 BW |
993 | ;; Don't need to do anything for cur |
994 | (save-excursion | |
995 | (when (and (not (memq seq (mh-unpropagated-sequences))) | |
996 | (mh-valid-seq-p seq)) | |
997 | (let ((folders ()) | |
998 | (mh-speed-flists-inhibit-flag t)) | |
999 | (maphash (lambda (folder msgs) | |
1000 | (push folder folders) | |
1001 | ;; Add messages to sequence in source folder... | |
1002 | (apply #'mh-exec-cmd-quiet nil "mark" folder | |
1003 | "-add" "-nozero" "-sequence" (symbol-name seq) | |
1004 | (mapcar (lambda (x) (format "%s" x)) | |
1005 | (mh-coalesce-msg-list msgs))) | |
1006 | ;; Update source folder buffer if we have it open... | |
1007 | (when (get-buffer folder) | |
1008 | (save-excursion | |
1009 | (set-buffer folder) | |
1010 | (mh-put-msg-in-seq msgs seq)))) | |
1011 | (mh-index-matching-source-msgs msgs)) | |
1012 | folders)))) | |
1013 | ||
1014 | ;;;###mh-autoload | |
1015 | (defun mh-index-delete-from-sequence (seq msgs) | |
1016 | "Delete from SEQ the messages in MSGS. | |
2dcf34f9 BW |
1017 | This function updates the source folder sequences. Also makes an |
1018 | attempt to update the source folder buffer if present." | |
a66894d8 BW |
1019 | (save-excursion |
1020 | (when (and (not (memq seq (mh-unpropagated-sequences))) | |
1021 | (mh-valid-seq-p seq)) | |
1022 | (let ((folders ()) | |
1023 | (mh-speed-flists-inhibit-flag t)) | |
1024 | (maphash (lambda (folder msgs) | |
1025 | (push folder folders) | |
1026 | ;; Remove messages from sequence in source folder... | |
1027 | (apply #'mh-exec-cmd-quiet nil "mark" folder | |
1028 | "-del" "-nozero" "-sequence" (symbol-name seq) | |
1029 | (mapcar (lambda (x) (format "%s" x)) | |
1030 | (mh-coalesce-msg-list msgs))) | |
1031 | ;; Update source folder buffer if we have it open... | |
1032 | (when (get-buffer folder) | |
1033 | (save-excursion | |
1034 | (set-buffer folder) | |
1035 | (mh-delete-msg-from-seq msgs seq t)))) | |
1036 | (mh-index-matching-source-msgs msgs)) | |
1037 | folders)))) | |
bdcfe844 BW |
1038 | |
1039 | \f | |
1040 | ||
3d7ca223 BW |
1041 | ;; Pick interface |
1042 | ||
1043 | (defvar mh-index-pick-folder) | |
1044 | (defvar mh-pick-binary "pick") | |
1045 | ||
1046 | (defun mh-pick-execute-search (folder-path search-regexp) | |
1047 | "Execute pick. | |
1048 | ||
2dcf34f9 BW |
1049 | Unlike the other index search programs \"pick\" only searches |
1050 | messages present in the folder itself and does not descend into | |
1051 | any sub-folders that may be present. | |
3d7ca223 | 1052 | |
2dcf34f9 BW |
1053 | In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP |
1054 | is used to search." | |
9c2cf222 | 1055 | (set-buffer (get-buffer-create mh-temp-index-buffer)) |
3d7ca223 BW |
1056 | (erase-buffer) |
1057 | (setq mh-index-pick-folder | |
1058 | (concat "+" (substring folder-path (length mh-user-path)))) | |
1059 | (apply #'call-process (expand-file-name "pick" mh-progs) nil '(t nil) nil | |
1060 | mh-index-pick-folder "-list" search-regexp) | |
1061 | (goto-char (point-min))) | |
1062 | ||
1063 | (defun mh-pick-next-result () | |
1064 | "Return the next pick search result." | |
1065 | (prog1 (block nil | |
1066 | (when (eobp) (return nil)) | |
1067 | (unless (re-search-forward "^[1-9][0-9]*$" (line-end-position) t) | |
1068 | (return 'error)) | |
1069 | (list mh-index-pick-folder | |
1070 | (car (read-from-string (buffer-substring-no-properties | |
1071 | (line-beginning-position) | |
1072 | (line-end-position)))) | |
1073 | nil)) | |
1074 | (forward-line))) | |
1075 | ||
1076 | \f | |
1077 | ||
bdcfe844 BW |
1078 | ;; Grep interface |
1079 | ||
1080 | (defvar mh-grep-binary (executable-find "grep")) | |
1081 | ||
1082 | (defun mh-grep-execute-search (folder-path search-regexp) | |
1083 | "Execute grep and read the results. | |
e495eaec | 1084 | |
2dcf34f9 BW |
1085 | Unlike the other index search programs \"grep\" only searches |
1086 | messages present in the folder itself and does not descend into | |
1087 | any sub-folders that may be present. | |
e495eaec | 1088 | |
2dcf34f9 BW |
1089 | In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP |
1090 | is used to search." | |
9c2cf222 | 1091 | (set-buffer (get-buffer-create mh-temp-index-buffer)) |
bdcfe844 BW |
1092 | (erase-buffer) |
1093 | (call-process mh-grep-binary nil '(t nil) nil | |
1094 | "-i" "-r" search-regexp folder-path) | |
1095 | (goto-char (point-min))) | |
1096 | ||
1097 | (defun mh-grep-next-result () | |
1098 | "Read the next result. | |
2dcf34f9 BW |
1099 | Parse it and return the message folder, message index and the |
1100 | match. If no other matches left then return nil. If the current | |
1101 | record is invalid return 'error." | |
bdcfe844 | 1102 | (prog1 |
c3d9274a BW |
1103 | (block nil |
1104 | (when (eobp) | |
1105 | (return nil)) | |
1106 | (let ((eol-pos (line-end-position)) | |
1107 | (bol-pos (line-beginning-position)) | |
1108 | folder-start msg-end) | |
1109 | (goto-char bol-pos) | |
1110 | (unless (search-forward mh-user-path eol-pos t) | |
bdcfe844 | 1111 | (return 'error)) |
c3d9274a BW |
1112 | (setq folder-start (point)) |
1113 | (unless (search-forward ":" eol-pos t) | |
1114 | (return 'error)) | |
1115 | (let ((match (buffer-substring-no-properties (point) eol-pos))) | |
1116 | (forward-char -1) | |
1117 | (setq msg-end (point)) | |
1118 | (unless (search-backward "/" folder-start t) | |
1119 | (return 'error)) | |
1120 | (list (format "+%s" (buffer-substring-no-properties | |
1121 | folder-start (point))) | |
1122 | (let ((val (ignore-errors (read-from-string | |
1123 | (buffer-substring-no-properties | |
1124 | (1+ (point)) msg-end))))) | |
1125 | (if (and (consp val) (integerp (car val))) | |
1126 | (car val) | |
1127 | (return 'error))) | |
1128 | match)))) | |
bdcfe844 BW |
1129 | (forward-line))) |
1130 | ||
1131 | \f | |
1132 | ||
3d7ca223 BW |
1133 | ;; Mairix interface |
1134 | ||
1135 | (defvar mh-mairix-binary (executable-find "mairix")) | |
1136 | (defvar mh-mairix-directory ".mairix") | |
1137 | (defvar mh-mairix-folder nil) | |
1138 | ||
1139 | (defun mh-mairix-execute-search (folder-path search-regexp-list) | |
1140 | "Execute mairix and read the results. | |
1141 | ||
2dcf34f9 BW |
1142 | In the examples below, replace \"/home/user/Mail\" with the path |
1143 | to your MH directory. | |
3d7ca223 | 1144 | |
2dcf34f9 BW |
1145 | First create the directory \"/home/user/Mail/.mairix\". Then |
1146 | create the file \"/home/user/Mail/.mairix/config\" with the | |
1147 | following contents: | |
3d7ca223 | 1148 | |
e495eaec | 1149 | base=/home/user/Mail |
a1506d29 | 1150 | |
e495eaec BW |
1151 | # List of folders that should be indexed. 3 dots at the end means there |
1152 | # are subfolders within the folder | |
1153 | mh=archive...:inbox:drafts:news:sent:trash | |
a1506d29 | 1154 | |
e495eaec BW |
1155 | vfolder_format=raw |
1156 | database=/home/user/Mail/mairix/database | |
3d7ca223 | 1157 | |
2dcf34f9 BW |
1158 | Use the following command line to generate the mairix index. Run |
1159 | this daily from cron: | |
3d7ca223 | 1160 | |
e495eaec | 1161 | mairix -f /home/user/Mail/.mairix/config |
3d7ca223 | 1162 | |
2dcf34f9 BW |
1163 | In a program, FOLDER-PATH is the directory in which |
1164 | SEARCH-REGEXP-LIST is used to search." | |
9c2cf222 | 1165 | (set-buffer (get-buffer-create mh-temp-index-buffer)) |
3d7ca223 BW |
1166 | (erase-buffer) |
1167 | (unless mh-mairix-binary | |
836f2863 | 1168 | (error "Set `mh-mairix-binary' appropriately")) |
3d7ca223 | 1169 | (apply #'call-process mh-mairix-binary nil '(t nil) nil |
e495eaec | 1170 | "-r" "-f" (format "%s%s/config" mh-user-path mh-mairix-directory) |
3d7ca223 BW |
1171 | search-regexp-list) |
1172 | (goto-char (point-min)) | |
1173 | (setq mh-mairix-folder | |
1174 | (let ((last-char (substring folder-path (1- (length folder-path))))) | |
1175 | (if (equal last-char "/") | |
1176 | folder-path | |
1177 | (format "%s/" folder-path))))) | |
1178 | ||
1179 | (defun mh-mairix-next-result () | |
1180 | "Return next result from mairix output." | |
1181 | (prog1 | |
1182 | (block nil | |
1183 | (when (or (eobp) (and (bolp) (eolp))) | |
1184 | (return nil)) | |
1185 | (unless (eq (char-after) ?/) | |
924df208 | 1186 | (return 'error)) |
3d7ca223 BW |
1187 | (let ((start (point)) |
1188 | end msg-start) | |
1189 | (setq end (line-end-position)) | |
1190 | (unless (search-forward mh-mairix-folder end t) | |
1191 | (return 'error)) | |
1192 | (goto-char (match-beginning 0)) | |
1193 | (unless (equal (point) start) | |
1194 | (return 'error)) | |
1195 | (goto-char end) | |
1196 | (unless (search-backward "/" start t) | |
1197 | (return 'error)) | |
1198 | (setq msg-start (1+ (point))) | |
1199 | (goto-char start) | |
1200 | (unless (search-forward mh-user-path end t) | |
1201 | (return 'error)) | |
1202 | (list (format "+%s" (buffer-substring-no-properties | |
1203 | (point) (1- msg-start))) | |
1204 | (car (read-from-string | |
1205 | (buffer-substring-no-properties msg-start end))) | |
1206 | ()))) | |
1207 | (forward-line))) | |
1208 | ||
1209 | (defun mh-mairix-regexp-builder (regexp-list) | |
1210 | "Generate query for mairix. | |
1211 | REGEXP-LIST is an alist of fields and values." | |
1212 | (let ((result ())) | |
1213 | (dolist (pair regexp-list) | |
1214 | (when (cdr pair) | |
1215 | (push | |
1216 | (concat | |
1217 | (cond ((eq (car pair) 'to) "t:") | |
1218 | ((eq (car pair) 'from) "f:") | |
1219 | ((eq (car pair) 'cc) "c:") | |
1220 | ((eq (car pair) 'subject) "s:") | |
1221 | ((eq (car pair) 'date) "d:") | |
1222 | (t "")) | |
1223 | (let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair)))) | |
1224 | (final "")) | |
1225 | (dolist (conjunct sop) | |
1226 | (let ((expr-list (cdr conjunct)) | |
1227 | (expr-string "")) | |
1228 | (dolist (e expr-list) | |
e495eaec | 1229 | (setq expr-string (concat expr-string "," |
3d7ca223 BW |
1230 | (if (atom e) "" "~") |
1231 | (if (atom e) e (cadr e))))) | |
e495eaec | 1232 | (setq final (concat final "/" (substring expr-string 1))))) |
3d7ca223 BW |
1233 | (substring final 1))) |
1234 | result))) | |
1235 | result)) | |
1236 | ||
1237 | (defun mh-mairix-convert-to-sop* (expr) | |
1238 | "Convert EXPR to sum of product form." | |
1239 | (cond ((atom expr) `(or (and ,expr))) | |
1240 | ((eq (car expr) 'or) | |
1241 | (cons 'or | |
1242 | (loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr)) | |
1243 | append (cdr e)))) | |
1244 | ((eq (car expr) 'and) | |
1245 | (let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr))) | |
1246 | result next-factor) | |
1247 | (setq result (pop conjuncts)) | |
1248 | (while conjuncts | |
1249 | (setq next-factor (pop conjuncts)) | |
1250 | (setq result (let ((res ())) | |
1251 | (dolist (t1 (cdr result)) | |
1252 | (dolist (t2 (cdr next-factor)) | |
1253 | (push `(and ,@(cdr t1) ,@(cdr t2)) res))) | |
1254 | (cons 'or res)))) | |
1255 | result)) | |
1256 | ((atom (cadr expr)) `(or (and ,expr))) | |
1257 | ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr))) | |
1258 | ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop* | |
1259 | `(or ,@(mapcar #'(lambda (x) `(not ,x)) | |
1260 | (cdadr expr))))) | |
1261 | ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop* | |
1262 | `(and ,@(mapcar #'(lambda (x) `(not ,x)) | |
1263 | (cdadr expr))))) | |
1264 | (t (error "Unreachable: %s" expr)))) | |
1265 | ||
1266 | \f | |
1267 | ||
924df208 BW |
1268 | ;; Interface to unseen messages script |
1269 | ||
1270 | (defvar mh-flists-search-folders) | |
1271 | ||
a66894d8 BW |
1272 | ;; XXX: This should probably be in mh-utils.el and used in other places where |
1273 | ;; MH-E calls out to /bin/sh. | |
1274 | (defun mh-index-quote-for-shell (string) | |
1275 | "Quote STRING for /bin/sh." | |
1276 | (concat "\"" | |
1277 | (loop for x across string | |
1278 | concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) | |
1279 | "\"")) | |
1280 | ||
924df208 | 1281 | (defun mh-flists-execute (&rest args) |
a66894d8 | 1282 | "Execute flists. |
2dcf34f9 BW |
1283 | Search for messages belonging to `mh-flists-sequence' in the |
1284 | folders specified by `mh-flists-search-folders'. If | |
1285 | `mh-recursive-folders-flag' is t, then the folders are searched | |
1286 | recursively. All parameters ARGS are ignored." | |
9c2cf222 | 1287 | (set-buffer (get-buffer-create mh-temp-index-buffer)) |
924df208 BW |
1288 | (erase-buffer) |
1289 | (unless (executable-find "sh") | |
1290 | (error "Didn't find sh")) | |
1291 | (with-temp-buffer | |
a66894d8 BW |
1292 | (let ((seq (symbol-name mh-flists-sequence))) |
1293 | (insert "for folder in `" (expand-file-name "flists" mh-progs) " " | |
1294 | (cond ((eq mh-flists-search-folders t) | |
1295 | (mh-index-quote-for-shell mh-inbox)) | |
924df208 BW |
1296 | ((eq mh-flists-search-folders nil) "") |
1297 | ((listp mh-flists-search-folders) | |
1298 | (loop for folder in mh-flists-search-folders | |
a66894d8 BW |
1299 | concat |
1300 | (concat " " (mh-index-quote-for-shell folder))))) | |
924df208 | 1301 | (if mh-recursive-folders-flag " -recurse" "") |
a66894d8 BW |
1302 | " -sequence " seq " -noshowzero -fast` ; do\n" |
1303 | (expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n" | |
1304 | "done\n")) | |
924df208 | 1305 | (call-process-region |
9c2cf222 | 1306 | (point-min) (point-max) "sh" nil (get-buffer mh-temp-index-buffer)))) |
924df208 BW |
1307 | |
1308 | ;;;###mh-autoload | |
a66894d8 | 1309 | (defun mh-index-sequenced-messages (folders sequence) |
af435184 BW |
1310 | "Display messages in any sequence. |
1311 | ||
1312 | All messages from the FOLDERS in `mh-new-messages-folders' in the | |
1313 | SEQUENCE you provide are listed. With a prefix argument, enter a | |
1314 | space-separated list of folders at the prompt, or nothing to | |
1315 | search all folders." | |
924df208 BW |
1316 | (interactive |
1317 | (list (if current-prefix-arg | |
a8a47814 BW |
1318 | (split-string (read-string "Search folder(s) (default all): ")) |
1319 | mh-new-messages-folders) | |
a66894d8 BW |
1320 | (mh-read-seq-default "Search" nil))) |
1321 | (unless sequence (setq sequence mh-unseen-seq)) | |
924df208 | 1322 | (let* ((mh-flists-search-folders folders) |
a66894d8 BW |
1323 | (mh-flists-sequence sequence) |
1324 | (mh-flists-called-flag t) | |
924df208 BW |
1325 | (mh-indexer 'flists) |
1326 | (mh-index-execute-search-function 'mh-flists-execute) | |
1327 | (mh-index-next-result-function 'mh-mairix-next-result) | |
1328 | (mh-mairix-folder mh-user-path) | |
1329 | (mh-index-regexp-builder nil) | |
a66894d8 BW |
1330 | (new-folder (format "%s/%s/%s" mh-index-folder |
1331 | mh-flists-results-folder sequence)) | |
924df208 BW |
1332 | (window-config (if (equal new-folder mh-current-folder) |
1333 | mh-previous-window-config | |
1334 | (current-window-configuration))) | |
a66894d8 BW |
1335 | (redo-flag nil) |
1336 | message) | |
924df208 BW |
1337 | (cond ((buffer-live-p (get-buffer new-folder)) |
1338 | ;; The destination folder is being visited. Trick `mh-index-search' | |
a66894d8 | 1339 | ;; into thinking that the folder resulted from a previous search. |
924df208 | 1340 | (set-buffer new-folder) |
a66894d8 | 1341 | (setq mh-index-previous-search (list folders sequence)) |
924df208 BW |
1342 | (setq redo-flag t)) |
1343 | ((mh-folder-exists-p new-folder) | |
1344 | ;; Folder exists but we don't have it open. That means they are | |
1345 | ;; stale results from a old flists search. Clear it out. | |
1346 | (mh-exec-cmd-quiet nil "rmf" new-folder))) | |
a66894d8 BW |
1347 | (setq message (mh-index-search redo-flag "+" mh-flists-results-folder |
1348 | window-config) | |
1349 | mh-index-sequence-search-flag t | |
1350 | mh-index-previous-search (list folders sequence)) | |
1351 | (mh-index-write-data) | |
47570699 | 1352 | (when (stringp message) (message "%s" message)))) |
a66894d8 BW |
1353 | |
1354 | ;;;###mh-autoload | |
1355 | (defun mh-index-new-messages (folders) | |
1356 | "Display unseen messages. | |
a8a47814 | 1357 | |
5a4aad03 | 1358 | If you use a program such as \"procmail\" to use \"rcvstore\" to file |
2dcf34f9 | 1359 | your incoming mail automatically, you can display new, unseen, |
5a4aad03 | 1360 | messages using this command. All messages in the \"unseen\" |
2dcf34f9 BW |
1361 | sequence from the folders in `mh-new-messages-folders' are |
1362 | listed. | |
a8a47814 | 1363 | |
2dcf34f9 BW |
1364 | With a prefix argument, enter a space-separated list of FOLDERS, |
1365 | or nothing to search all folders." | |
a66894d8 BW |
1366 | (interactive |
1367 | (list (if current-prefix-arg | |
a8a47814 BW |
1368 | (split-string (read-string "Search folder(s) (default all): ")) |
1369 | mh-new-messages-folders))) | |
a66894d8 BW |
1370 | (mh-index-sequenced-messages folders mh-unseen-seq)) |
1371 | ||
1372 | ;;;###mh-autoload | |
1373 | (defun mh-index-ticked-messages (folders) | |
1374 | "Display ticked messages. | |
a8a47814 | 1375 | |
2dcf34f9 BW |
1376 | All messages in `mh-tick-seq' from the folders in |
1377 | `mh-ticked-messages-folders' are listed. | |
a8a47814 | 1378 | |
2dcf34f9 BW |
1379 | With a prefix argument, enter a space-separated list of FOLDERS, |
1380 | or nothing to search all folders." | |
a66894d8 BW |
1381 | (interactive |
1382 | (list (if current-prefix-arg | |
a8a47814 BW |
1383 | (split-string (read-string "Search folder(s) (default all): ")) |
1384 | mh-ticked-messages-folders))) | |
a66894d8 | 1385 | (mh-index-sequenced-messages folders mh-tick-seq)) |
924df208 BW |
1386 | |
1387 | \f | |
1388 | ||
bdcfe844 BW |
1389 | ;; Swish interface |
1390 | ||
1391 | (defvar mh-swish-binary (executable-find "swish-e")) | |
1392 | (defvar mh-swish-directory ".swish") | |
1393 | (defvar mh-swish-folder nil) | |
1394 | ||
c3d9274a | 1395 | ;;;###mh-autoload |
bdcfe844 BW |
1396 | (defun mh-swish-execute-search (folder-path search-regexp) |
1397 | "Execute swish-e and read the results. | |
1398 | ||
2dcf34f9 BW |
1399 | In the examples below, replace \"/home/user/Mail\" with the path |
1400 | to your MH directory. | |
e495eaec | 1401 | |
2dcf34f9 BW |
1402 | First create the directory \"/home/user/Mail/.swish\". Then |
1403 | create the file \"/home/user/Mail/.swish/config\" with the | |
1404 | following contents: | |
e495eaec BW |
1405 | |
1406 | DefaultContents TXT* | |
1407 | IndexDir /home/user/Mail | |
1408 | IndexFile /home/user/Mail/.swish/index | |
1409 | IndexName \"Mail Index\" | |
1410 | IndexDescription \"Mail Index\" | |
1411 | IndexPointer \"http://nowhere\" | |
1412 | IndexAdmin \"nobody\" | |
1413 | #MetaNames automatic | |
1414 | IndexReport 3 | |
1415 | FollowSymLinks no | |
1416 | UseStemming no | |
1417 | IgnoreTotalWordCountWhenRanking yes | |
1418 | WordCharacters abcdefghijklmnopqrstuvwxyz0123456789- | |
1419 | BeginCharacters abcdefghijklmnopqrstuvwxyz | |
1420 | EndCharacters abcdefghijklmnopqrstuvwxyz0123456789 | |
1421 | IgnoreLimit 50 1000 | |
1422 | IndexComments 0 | |
1423 | FileRules filename contains \\D | |
1424 | FileRules pathname contains /home/user/Mail/.swish | |
1425 | FileRules pathname contains /home/user/Mail/mhe-index | |
1426 | ||
2dcf34f9 BW |
1427 | This configuration does not index the folders that hold the |
1428 | results of your searches in \"+mhe-index\" since they tend to be | |
1429 | ephemeral and the original messages are indexed anyway. | |
bdcfe844 | 1430 | |
2dcf34f9 BW |
1431 | If there are any directories you would like to ignore, append |
1432 | lines like the following to \"config\": | |
bdcfe844 | 1433 | |
e495eaec | 1434 | FileRules pathname contains /home/user/Mail/scripts |
c3d9274a | 1435 | |
2dcf34f9 BW |
1436 | Use the following command line to generate the swish index. Run |
1437 | this daily from cron: | |
bdcfe844 | 1438 | |
e495eaec | 1439 | swish-e -c /home/user/Mail/.swish/config |
bdcfe844 | 1440 | |
2dcf34f9 BW |
1441 | In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP |
1442 | is used to search." | |
9c2cf222 | 1443 | (set-buffer (get-buffer-create mh-temp-index-buffer)) |
bdcfe844 BW |
1444 | (erase-buffer) |
1445 | (unless mh-swish-binary | |
f9c53c97 | 1446 | (error "Set `mh-swish-binary' appropriately")) |
bdcfe844 BW |
1447 | (call-process mh-swish-binary nil '(t nil) nil |
1448 | "-w" search-regexp | |
1449 | "-f" (format "%s%s/index" mh-user-path mh-swish-directory)) | |
1450 | (goto-char (point-min)) | |
1451 | (setq mh-swish-folder | |
1452 | (let ((last-char (substring folder-path (1- (length folder-path))))) | |
1453 | (if (equal last-char "/") | |
1454 | folder-path | |
1455 | (format "%s/" folder-path))))) | |
1456 | ||
1457 | (defun mh-swish-next-result () | |
1458 | "Get the next result from swish output." | |
1459 | (prog1 | |
1460 | (block nil | |
1461 | (when (or (eobp) (equal (char-after (point)) ?.)) | |
1462 | (return nil)) | |
1463 | (when (equal (char-after (point)) ?#) | |
1464 | (return 'error)) | |
1465 | (let* ((start (search-forward " " (line-end-position) t)) | |
1466 | (end (search-forward " " (line-end-position) t))) | |
1467 | (unless (and start end) | |
1468 | (return 'error)) | |
1469 | (setq end (1- end)) | |
1470 | (unless (file-exists-p (buffer-substring-no-properties start end)) | |
1471 | (return 'error)) | |
1472 | (unless (search-backward "/" start t) | |
1473 | (return 'error)) | |
1474 | (list (let* ((s (buffer-substring-no-properties start (1+ (point))))) | |
1475 | (unless (string-match mh-swish-folder s) | |
1476 | (return 'error)) | |
e495eaec BW |
1477 | (if (and (string-match mh-user-path s) |
1478 | (< (match-end 0) (1- (length s)))) | |
bdcfe844 BW |
1479 | (format "+%s" |
1480 | (substring s (match-end 0) (1- (length s)))) | |
1481 | (return 'error))) | |
1482 | (let* ((s (buffer-substring-no-properties (1+ (point)) end)) | |
1483 | (val (ignore-errors (read-from-string s)))) | |
1484 | (if (and (consp val) (numberp (car val))) | |
1485 | (car val) | |
1486 | (return 'error))) | |
1487 | nil))) | |
1488 | (forward-line))) | |
1489 | ||
1490 | \f | |
1491 | ||
1492 | ;; Swish++ interface | |
1493 | ||
1494 | (defvar mh-swish++-binary (or (executable-find "search++") | |
c3d9274a | 1495 | (executable-find "search"))) |
bdcfe844 BW |
1496 | (defvar mh-swish++-directory ".swish++") |
1497 | ||
c3d9274a | 1498 | ;;;###mh-autoload |
bdcfe844 BW |
1499 | (defun mh-swish++-execute-search (folder-path search-regexp) |
1500 | "Execute swish++ and read the results. | |
1501 | ||
2dcf34f9 BW |
1502 | In the examples below, replace \"/home/user/Mail\" with the path to |
1503 | your MH directory. | |
bdcfe844 | 1504 | |
2dcf34f9 BW |
1505 | First create the directory \"/home/user/Mail/.swish++\". Then create |
1506 | the file \"/home/user/Mail/.swish++/swish++.conf\" with the following | |
1507 | contents: | |
bdcfe844 | 1508 | |
e495eaec BW |
1509 | IncludeMeta Bcc Cc Comments Content-Description From Keywords |
1510 | IncludeMeta Newsgroups Resent-To Subject To | |
1511 | IncludeMeta Message-Id References In-Reply-To | |
1512 | IncludeFile Mail * | |
1513 | IndexFile /home/user/Mail/.swish++/swish++.index | |
bdcfe844 | 1514 | |
2dcf34f9 BW |
1515 | Use the following command line to generate the swish index. Run |
1516 | this daily from cron: | |
bdcfe844 | 1517 | |
e495eaec BW |
1518 | find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\ |
1519 | -o -path /home/user/Mail/.swish++ -prune \\ | |
1520 | -o -name \"[0-9]*\" -print \\ | |
1521 | | index -c /home/user/Mail/.swish++/swish++.conf - | |
c3d9274a | 1522 | |
2dcf34f9 BW |
1523 | This command does not index the folders that hold the results of your |
1524 | searches in \"+mhe-index\" since they tend to be ephemeral and the | |
1525 | original messages are indexed anyway. | |
bdcfe844 | 1526 | |
2dcf34f9 BW |
1527 | On some systems (Debian GNU/Linux, for example), use \"index++\" |
1528 | instead of \"index\". | |
bdcfe844 | 1529 | |
2dcf34f9 BW |
1530 | In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP is |
1531 | used to search." | |
9c2cf222 | 1532 | (set-buffer (get-buffer-create mh-temp-index-buffer)) |
bdcfe844 BW |
1533 | (erase-buffer) |
1534 | (unless mh-swish++-binary | |
f9c53c97 | 1535 | (error "Set `mh-swish++-binary' appropriately")) |
bdcfe844 BW |
1536 | (call-process mh-swish++-binary nil '(t nil) nil |
1537 | "-m" "10000" | |
1538 | (format "-i%s%s/swish++.index" | |
1539 | mh-user-path mh-swish++-directory) | |
1540 | search-regexp) | |
1541 | (goto-char (point-min)) | |
1542 | (setq mh-swish-folder | |
1543 | (let ((last-char (substring folder-path (1- (length folder-path))))) | |
1544 | (if (equal last-char "/") | |
1545 | folder-path | |
1546 | (format "%s/" folder-path))))) | |
1547 | ||
1548 | (defalias 'mh-swish++-next-result 'mh-swish-next-result) | |
1549 | ||
3d7ca223 BW |
1550 | (defun mh-swish++-regexp-builder (regexp-list) |
1551 | "Generate query for swish++. | |
1552 | REGEXP-LIST is an alist of fields and values." | |
924df208 | 1553 | (let ((regexp "")) |
3d7ca223 BW |
1554 | (dolist (elem regexp-list) |
1555 | (when (cdr elem) | |
1556 | (setq regexp (concat regexp " and " | |
1557 | (if (car elem) "(" "") | |
1558 | (if (car elem) (symbol-name (car elem)) "") | |
1559 | (if (car elem) " = " "") | |
1560 | (mh-swish++-print-regexp (cdr elem)) | |
1561 | (if (car elem) ")" ""))))) | |
1562 | (substring regexp 4))) | |
1563 | ||
1564 | (defun mh-swish++-print-regexp (expr) | |
1565 | "Return infix expression corresponding to EXPR." | |
1566 | (cond ((atom expr) (format "%s" expr)) | |
1567 | ((eq (car expr) 'not) | |
1568 | (format "(not %s)" (mh-swish++-print-regexp (cadr expr)))) | |
1569 | (t (format "(%s %s %s)" (mh-swish++-print-regexp (cadr expr)) | |
1570 | (symbol-name (car expr)) | |
1571 | (mh-swish++-print-regexp (caddr expr)))))) | |
1572 | ||
bdcfe844 BW |
1573 | \f |
1574 | ||
1575 | ;; Namazu interface | |
1576 | ||
1577 | (defvar mh-namazu-binary (executable-find "namazu")) | |
1578 | (defvar mh-namazu-directory ".namazu") | |
1579 | (defvar mh-namazu-folder nil) | |
1580 | ||
c3d9274a | 1581 | ;;;###mh-autoload |
bdcfe844 BW |
1582 | (defun mh-namazu-execute-search (folder-path search-regexp) |
1583 | "Execute namazu and read the results. | |
1584 | ||
2dcf34f9 BW |
1585 | In the examples below, replace \"/home/user/Mail\" with the path to |
1586 | your MH directory. | |
bdcfe844 | 1587 | |
2dcf34f9 BW |
1588 | First create the directory \"/home/user/Mail/.namazu\". Then create |
1589 | the file \"/home/user/Mail/.namazu/mknmzrc\" with the following | |
1590 | contents: | |
bdcfe844 | 1591 | |
e495eaec BW |
1592 | package conf; # Don't remove this line! |
1593 | $ADDRESS = 'user@localhost'; | |
1594 | $ALLOW_FILE = \"[0-9]*\"; | |
1595 | $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\"; | |
c3d9274a | 1596 | |
2dcf34f9 BW |
1597 | This configuration does not index the folders that hold the results of |
1598 | your searches in \"+mhe-index\" since they tend to be ephemeral and | |
1599 | the original messages are indexed anyway. | |
c3d9274a | 1600 | |
2dcf34f9 BW |
1601 | Use the following command line to generate the namazu index. Run this |
1602 | daily from cron: | |
bdcfe844 | 1603 | |
e495eaec BW |
1604 | mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\ |
1605 | /home/user/Mail | |
bdcfe844 | 1606 | |
2dcf34f9 BW |
1607 | In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP |
1608 | is used to search." | |
bdcfe844 | 1609 | (let ((namazu-index-directory |
c3d9274a | 1610 | (format "%s%s" mh-user-path mh-namazu-directory))) |
bdcfe844 BW |
1611 | (unless (file-exists-p namazu-index-directory) |
1612 | (error "Namazu directory %s not present" namazu-index-directory)) | |
1613 | (unless (executable-find mh-namazu-binary) | |
f9c53c97 | 1614 | (error "Set `mh-namazu-binary' appropriately")) |
9c2cf222 | 1615 | (set-buffer (get-buffer-create mh-temp-index-buffer)) |
bdcfe844 BW |
1616 | (erase-buffer) |
1617 | (call-process mh-namazu-binary nil '(t nil) nil | |
1618 | "-alR" search-regexp namazu-index-directory) | |
1619 | (goto-char (point-min)) | |
1620 | (setq mh-namazu-folder | |
1621 | (let ((last (substring folder-path (1- (length folder-path))))) | |
1622 | (if (equal last "/") | |
1623 | folder-path | |
1624 | (format "%s/" folder-path)))))) | |
1625 | ||
1626 | (defun mh-namazu-next-result () | |
1627 | "Get the next result from namazu output." | |
1628 | (prog1 | |
1629 | (block nil | |
1630 | (when (eobp) (return nil)) | |
1631 | (let ((file-name (buffer-substring-no-properties | |
1632 | (point) (line-end-position)))) | |
1633 | (unless (equal (string-match mh-namazu-folder file-name) 0) | |
1634 | (return 'error)) | |
1635 | (unless (file-exists-p file-name) | |
1636 | (return 'error)) | |
1637 | (string-match mh-user-path file-name) | |
1638 | (let* ((folder/msg (substring file-name (match-end 0))) | |
c3d9274a | 1639 | (mark (mh-search-from-end ?/ folder/msg))) |
bdcfe844 BW |
1640 | (unless mark (return 'error)) |
1641 | (list (format "+%s" (substring folder/msg 0 mark)) | |
1642 | (let ((n (ignore-errors (read-from-string | |
1643 | (substring folder/msg (1+ mark)))))) | |
1644 | (if (and (consp n) (numberp (car n))) | |
1645 | (car n) | |
1646 | (return 'error))) | |
1647 | nil)))) | |
1648 | (forward-line))) | |
1649 | ||
1650 | \f | |
1651 | ||
924df208 | 1652 | ;;;###mh-autoload |
bdcfe844 BW |
1653 | (defun mh-index-choose () |
1654 | "Choose an indexing function. | |
2dcf34f9 BW |
1655 | The side-effects of this function are that the variables |
1656 | `mh-indexer', `mh-index-execute-search-function', and | |
1657 | `mh-index-next-result-function' are set according to the first | |
1658 | indexer in `mh-indexer-choices' present on the system." | |
bdcfe844 BW |
1659 | (block nil |
1660 | ;; The following favors the user's preference; otherwise, the last | |
1661 | ;; automatically chosen indexer is used for efficiency rather than going | |
1662 | ;; through the list. | |
1663 | (let ((program-alist (cond (mh-index-program | |
1664 | (list | |
c3d9274a | 1665 | (assoc mh-index-program mh-indexer-choices))) |
bdcfe844 BW |
1666 | (mh-indexer |
1667 | (list (assoc mh-indexer mh-indexer-choices))) | |
1668 | (t mh-indexer-choices)))) | |
1669 | (while program-alist | |
1670 | (let* ((current (pop program-alist)) | |
1671 | (executable (symbol-value (cadr current)))) | |
1672 | (when executable | |
1673 | (setq mh-indexer (car current)) | |
3d7ca223 BW |
1674 | (setq mh-index-execute-search-function (nth 2 current)) |
1675 | (setq mh-index-next-result-function (nth 3 current)) | |
1676 | (setq mh-index-regexp-builder (nth 4 current)) | |
bdcfe844 BW |
1677 | (return mh-indexer)))) |
1678 | nil))) | |
1679 | ||
1680 | \f | |
1681 | ||
bdcfe844 BW |
1682 | (provide 'mh-index) |
1683 | ||
cee9f5c6 BW |
1684 | ;; Local Variables: |
1685 | ;; indent-tabs-mode: nil | |
1686 | ;; sentence-end-double-space: nil | |
1687 | ;; End: | |
bdcfe844 | 1688 | |
cee9f5c6 | 1689 | ;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47 |
bdcfe844 | 1690 | ;;; mh-index ends here |