Mercurial > emacs
comparison lisp/mh-e/mh-search.el @ 68163:3b7532a82079
* mh-search.el: New file containing contents of mh-index.el and
mh-pick.el. C-c C-c launches your mh-index-program; C-c C-p runs pick.
Pick no longer sets the "search" sequence. Instead, it brings up a
folder view that we're accustomed to. (closes SF #829207).
(mh-index-search): Rename to mh-search.
(mh-pick-menu): Rename menu from Pick to Search. Rename Execute the
Search to Perform Search and call mh-do-search. Add Search with Pick
menu item.
(mh-do-search): Delete.
(mh-search-mode): Rename from mh-pick-mode.
(MH-Search): Rename mode from MH-Pick.
(mh-search-mode-map): Rename from mh-pick-mode-map.
(mh-search-mode-help-messages): Rename from
mh-pick-mode-help-messages.
(mh-index-choose): Don't reuse the last value of mh-indexer; when
mh-pick-do-search sets it to 'pick, we don't necessarily want to stay
with that choice!
* mh-index.el: mh-pick.el: Merge into mh-search.el and delete.
* mh-customize.el (mh-index-program): Change mh-index-search to
mh-search in docstring.
(mh-tool-bar-search-function): Change default from mh-search-folder to
mh-search. Remove mh-search-folder as choice and rename
mh-index-search choice to mh-search. Fix docstring.
(mh-pick-mode-hook): Rename to mh-search-mode-hook and change
mh-search-folder to mh-search in docstring.
* mh-e.el (mh-folder-folder-menu): Delete Search a Folder. Change
Indexed Search to Search. Use mh-search instead of mh-index-search.
(mh-folder-map): Delete i (mh-index-search) keybinding. Change s from
mh-show-search-folder to mh-search.
* mh-seq.el (mh-put-msg-in-seq): Fix docstring now that
mh-search-folder no longer creates the search sequence.
* mh-utils.el (mh-show-search-folder): Delete.
(mh-show-folder-map): Delete i (mh-index-search) keybinding. Change s
from mh-show-search-folder to mh-search.
(mh-show-folder-menu): Delete Search a Folder. Change Indexed Search
to Search. Use mh-search instead of mh-index-search.
(mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell): Move here
from deleted mh-index.el.
author | Bill Wohler <wohler@newt.com> |
---|---|
date | Fri, 13 Jan 2006 06:40:14 +0000 |
parents | |
children | dcf226991252 |
comparison
equal
deleted
inserted
replaced
68162:0d459faeff1a | 68163:3b7532a82079 |
---|---|
1 ;;; mh-search -- MH-E search | |
2 | |
3 ;; Copyright (C) 1993, 1995, | |
4 ;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Indexed search by Satyaki Das <satyaki@theforce.stanford.edu> | |
7 ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 ;; Keywords: mail | |
9 ;; See: mh-e.el | |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 ;; it under the terms of the GNU General Public License as published by | |
15 ;; the Free Software Foundation; either version 2, or (at your option) | |
16 ;; any later version. | |
17 | |
18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 ;; GNU General Public License for more details. | |
22 | |
23 ;; You should have received a copy of the GNU General Public License | |
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
26 ;; Boston, MA 02110-1301, USA. | |
27 | |
28 ;;; Commentary: | |
29 | |
30 ;; (1) The following search engines are supported: | |
31 ;; swish++ | |
32 ;; swish-e | |
33 ;; mairix | |
34 ;; namazu | |
35 ;; pick | |
36 ;; grep | |
37 ;; | |
38 ;; (2) To use this package, you first have to build an index. Please | |
39 ;; read the documentation for `mh-search' to get started. That | |
40 ;; documentation will direct you to the specific instructions for | |
41 ;; your particular indexer. | |
42 | |
43 ;;; Change Log: | |
44 | |
45 ;;; Code: | |
46 | |
47 (eval-when-compile (require 'mh-acros)) | |
48 (mh-require-cl) | |
49 | |
50 (require 'gnus-util) | |
51 (require 'mh-buffers) | |
52 (require 'mh-e) | |
53 | |
54 (defvar mh-indexer nil | |
55 "Cached value of chosen index program.") | |
56 | |
57 (defvar mh-index-execute-search-function nil | |
58 "Function which executes the search program.") | |
59 | |
60 (defvar mh-index-next-result-function nil | |
61 "Function to parse the next line of output.") | |
62 | |
63 (defvar mh-index-regexp-builder nil | |
64 "Function used to construct search regexp.") | |
65 | |
66 (defvar mh-index-folder "+mhe-index" | |
67 "Folder that contains the folders resulting from the index searches.") | |
68 | |
69 (defvar mh-flists-results-folder "sequence" | |
70 "Subfolder for `mh-index-folder' where flists output is placed.") | |
71 | |
72 (defvar mh-flists-sequence) | |
73 | |
74 (defvar mh-flists-called-flag nil) | |
75 | |
76 | |
77 | |
78 ;;; MH-Search mode | |
79 | |
80 ;;;###mh-autoload | |
81 (defun* mh-search (redo-search-flag folder search-regexp | |
82 &optional window-config) | |
83 "Search your MH mail. | |
84 | |
85 With this command, you can search for messages to or from a | |
86 particular person or about a particular subject. In fact, you can | |
87 also search for messages containing selected strings in any | |
88 arbitrary header field or any string found within the messages. | |
89 | |
90 Use a prefix argument REDO-SEARCH-FLAG to repeat the last search. | |
91 | |
92 You are prompted for the FOLDER to search. This can be \"all\" to | |
93 search all folders. For most search methods, the search works | |
94 recursively on the listed folder. | |
95 | |
96 Next, an MH-Search buffer appears where you can enter search | |
97 criteria. | |
98 | |
99 From: | |
100 To: | |
101 Cc: | |
102 Date: | |
103 Subject: | |
104 -------- | |
105 | |
106 Edit this template by entering your search criteria in an | |
107 appropriate header field that is already there, or create a new | |
108 field yourself. If the string you're looking for could be | |
109 anywhere in a message, then place the string underneath the row | |
110 of dashes. | |
111 | |
112 It is all right to specify several search criteria. What happens | |
113 then is that a logical _and_ of the various fields is performed. | |
114 If you prefer a logical _or_ operation, run \\[mh-search] | |
115 multiple times. | |
116 | |
117 As an example, let's say that we want to find messages from | |
118 Ginnean about horseback riding in the Kosciusko National | |
119 Park (Australia) during January, 1994. Normally we would start | |
120 with a broad search and narrow it down if necessary to produce a | |
121 manageable amount of data, but we'll cut to the chase and create | |
122 a fairly restrictive set of criteria as follows: | |
123 | |
124 From: ginnean | |
125 To: | |
126 Cc: | |
127 Date: Jan 1994 | |
128 Subject: | |
129 -------- | |
130 horse | |
131 kosciusko | |
132 | |
133 As with MH-Letter mode, MH-Search provides commands like | |
134 \\<mh-search-mode-map>\\[mh-to-field] to help you fill in the | |
135 blanks. | |
136 | |
137 If you find that you do the same thing over and over when editing | |
138 the search template, you may wish to bind some shortcuts to keys. | |
139 This can be done with the variable `mh-search-mode-hook', which is | |
140 called when \\[mh-search] is run on a new pattern. | |
141 | |
142 To perform the search, type \\[mh-index-do-search]. | |
143 | |
144 Sometimes you're searching for text that is either not indexed, | |
145 or hasn't been indexed yet. In this case you can override the | |
146 default method with the pick method by running the command | |
147 \\[mh-pick-do-search]. | |
148 | |
149 The messages that are found are put in a temporary sub-folder of | |
150 \"+mhe-index\" and are displayed in an MH-Folder buffer. This | |
151 buffer is special because it displays messages from multiple | |
152 folders; each set of messages from a given folder has a heading | |
153 with the folder name.\\<mh-folder-mode-map> | |
154 | |
155 The appearance of the heading can be modified by customizing the | |
156 face `mh-index-folder'. You can jump back and forth between the | |
157 headings using the commands \\[mh-index-next-folder] and | |
158 \\[mh-index-previous-folder]. | |
159 | |
160 In addition, the command \\[mh-index-visit-folder] can be used to | |
161 visit the folder of the message at point. Initially, only the | |
162 messages that matched the search criteria are displayed in the | |
163 folder. While the temporary buffer has its own set of message | |
164 numbers, the actual messages numbers are shown in the visited | |
165 folder. Thus, the command \\[mh-index-visit-folder] is useful to | |
166 find the actual message number of an interesting message, or to | |
167 view surrounding messages with the command \\[mh-rescan-folder]. | |
168 | |
169 Because this folder is temporary, you'll probably get in the | |
170 habit of killing it when you're done with | |
171 \\[mh-kill-folder]. | |
172 | |
173 SEARCH METHODS | |
174 | |
175 The command \\[mh-search] runs the command defined by the option | |
176 `mh-index-program'. The default value is \"Auto-detect\" which | |
177 means that MH-E will automatically choose one of \"swish++\", | |
178 \"swish-e\", \"mairix\", \"namazu\", \"pick\" and \"grep\" in | |
179 that order. If, for example, you have both \"swish++\" and | |
180 \"mairix\" installed and you want to use \"mairix\", then you can | |
181 set this option to \"mairix\". | |
182 | |
183 *NOTE* | |
184 | |
185 The \"pick\" and \"grep\" commands do not perform a | |
186 recursive search on the given folder. | |
187 | |
188 This command uses an \"X-MHE-Checksum:\" header field to cache | |
189 the MD5 checksum of a message. This means that if an incoming | |
190 message already contains an \"X-MHE-Checksum:\" field, that | |
191 message might not be found by this command. The following | |
192 \"procmail\" recipe avoids this problem by renaming the existing | |
193 header field: | |
194 | |
195 :0 wf | |
196 | formail -R \"X-MHE-Checksum\" \"X-Old-MHE-Checksum\" | |
197 | |
198 The documentation for the following commands describe how to set | |
199 up the various indexing programs to use with MH-E. The \"pick\" | |
200 and \"grep\" commands do not require additional configuration. | |
201 | |
202 - `mh-swish++-execute-search' | |
203 - `mh-swish-execute-search' | |
204 - `mh-mairix-execute-search' | |
205 - `mh-namazu-execute-search' | |
206 - `mh-pick-execute-search' | |
207 - `mh-grep-execute-search' | |
208 | |
209 In a program, the folder is searched with SEARCH-REGEXP. If | |
210 FOLDER is \"+\" then mail in all folders are searched. Optional | |
211 argument WINDOW-CONFIG stores the window configuration that will | |
212 be restored after the user quits the folder containing the index | |
213 search results." | |
214 (interactive | |
215 (list current-prefix-arg | |
216 (progn | |
217 (mh-find-path) | |
218 ;; Yes, we do want to call mh-index-choose every time in case the | |
219 ;; user has switched the indexer manually. | |
220 (unless (mh-index-choose (and current-prefix-arg | |
221 mh-index-previous-search | |
222 (cadr mh-index-previous-search))) | |
223 (error "No indexing program found")) | |
224 (or (and current-prefix-arg mh-index-sequence-search-flag) | |
225 (and current-prefix-arg (car mh-index-previous-search)) | |
226 (mh-prompt-for-folder "Search" "+" nil "all" t))) | |
227 (or (and current-prefix-arg (caddr mh-index-previous-search)) | |
228 mh-index-regexp-builder | |
229 (read-string (format "%s regexp: " | |
230 (upcase-initials (symbol-name mh-indexer))))) | |
231 (if (and (not (and current-prefix-arg | |
232 (caddr mh-index-previous-search))) | |
233 mh-index-regexp-builder) | |
234 (current-window-configuration) | |
235 nil))) | |
236 ;; Redoing a sequence search? | |
237 (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag | |
238 (not mh-flists-called-flag)) | |
239 (let ((mh-flists-called-flag t)) | |
240 (apply #'mh-index-sequenced-messages mh-index-previous-search)) | |
241 (return-from mh-search)) | |
242 ;; We have fancy query parsing. | |
243 (when (symbolp search-regexp) | |
244 (mh-search-folder folder window-config) | |
245 (return-from mh-search)) | |
246 ;; Begin search proper. | |
247 (mh-checksum-choose) | |
248 (let ((result-count 0) | |
249 (old-window-config (or window-config mh-previous-window-config)) | |
250 (previous-search mh-index-previous-search) | |
251 (index-folder (format "%s/%s" mh-index-folder | |
252 (mh-index-generate-pretty-name search-regexp)))) | |
253 ;; Create a new folder for the search results or recreate the old one... | |
254 (if (and redo-search-flag mh-index-previous-search) | |
255 (let ((buffer-name (buffer-name (current-buffer)))) | |
256 (mh-process-or-undo-commands buffer-name) | |
257 (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name)) | |
258 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name) | |
259 (setq index-folder buffer-name)) | |
260 (setq index-folder (mh-index-new-folder index-folder search-regexp))) | |
261 | |
262 (let ((folder-path (format "%s%s" mh-user-path (substring folder 1))) | |
263 (folder-results-map (make-hash-table :test #'equal)) | |
264 (origin-map (make-hash-table :test #'equal))) | |
265 ;; Run search program... | |
266 (message "Executing %s... " mh-indexer) | |
267 (funcall mh-index-execute-search-function folder-path search-regexp) | |
268 | |
269 ;; Parse indexer output. | |
270 (message "Processing %s output... " mh-indexer) | |
271 (goto-char (point-min)) | |
272 (loop for next-result = (funcall mh-index-next-result-function) | |
273 while next-result | |
274 do (unless (eq next-result 'error) | |
275 (unless (gethash (car next-result) folder-results-map) | |
276 (setf (gethash (car next-result) folder-results-map) | |
277 (make-hash-table :test #'equal))) | |
278 (setf (gethash (cadr next-result) | |
279 (gethash (car next-result) folder-results-map)) | |
280 t))) | |
281 | |
282 ;; Copy the search results over. | |
283 (maphash #'(lambda (folder msgs) | |
284 (let ((cur (car (mh-translate-range folder "cur"))) | |
285 (msgs (sort (loop for msg being the hash-keys of msgs | |
286 collect msg) | |
287 #'<))) | |
288 (mh-exec-cmd "refile" msgs "-src" folder | |
289 "-link" index-folder) | |
290 ;; Restore cur to old value, that refile changed | |
291 (when cur | |
292 (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" | |
293 "-sequence" "cur" (format "%s" cur))) | |
294 (loop for msg in msgs | |
295 do (incf result-count) | |
296 (setf (gethash result-count origin-map) | |
297 (cons folder msg))))) | |
298 folder-results-map) | |
299 | |
300 ;; Vist the results folder. | |
301 (mh-visit-folder index-folder () (list folder-results-map origin-map)) | |
302 | |
303 (goto-char (point-min)) | |
304 (forward-line) | |
305 (mh-update-sequences) | |
306 (mh-recenter nil) | |
307 | |
308 ;; Update the speedbar, if needed. | |
309 (when (mh-speed-flists-active-p) | |
310 (mh-speed-flists t mh-current-folder)) | |
311 | |
312 ;; Maintain history. | |
313 (when (or (and redo-search-flag previous-search) window-config) | |
314 (setq mh-previous-window-config old-window-config)) | |
315 (setq mh-index-previous-search (list folder mh-indexer search-regexp)) | |
316 | |
317 ;; Write out data to disk. | |
318 (unless mh-flists-called-flag (mh-index-write-data)) | |
319 | |
320 (message "%s found %s matches in %s folders" | |
321 (upcase-initials (symbol-name mh-indexer)) | |
322 (loop for msg-hash being hash-values of mh-index-data | |
323 sum (hash-table-count msg-hash)) | |
324 (loop for msg-hash being hash-values of mh-index-data | |
325 count (> (hash-table-count msg-hash) 0)))))) | |
326 | |
327 (defun mh-search-folder (folder window-config) | |
328 "Search FOLDER for messages matching a pattern. | |
329 | |
330 In a program, argument WINDOW-CONFIG is the current window | |
331 configuration and is used when the search folder is dismissed." | |
332 (interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t) | |
333 (current-window-configuration))) | |
334 (let ((pick-folder (if (equal folder "+") mh-current-folder folder))) | |
335 (switch-to-buffer-other-window "search-pattern") | |
336 (if (or (zerop (buffer-size)) | |
337 (not (y-or-n-p "Reuse pattern? "))) | |
338 (mh-make-pick-template) | |
339 (message "")) | |
340 (mh-make-local-vars 'mh-current-folder folder | |
341 'mh-previous-window-config window-config) | |
342 (message "%s" (substitute-command-keys | |
343 (concat "Type \\[mh-index-do-search] to search messages, " | |
344 "\\[mh-pick-do-search] to use pick, " | |
345 "\\[mh-help] for help"))))) | |
346 | |
347 (defun mh-make-pick-template () | |
348 "Initialize the current buffer with a template for a pick pattern." | |
349 (let ((inhibit-read-only t)) (erase-buffer)) | |
350 (insert "From: \n" | |
351 "To: \n" | |
352 "Cc: \n" | |
353 "Date: \n" | |
354 "Subject: \n" | |
355 "---------\n") | |
356 (mh-search-mode) | |
357 (goto-char (point-min)) | |
358 (dotimes (i 5) | |
359 (add-text-properties (point) (1+ (point)) '(front-sticky t)) | |
360 (add-text-properties (- (line-end-position) 2) (1- (line-end-position)) | |
361 '(rear-nonsticky t)) | |
362 (add-text-properties (point) (1- (line-end-position)) '(read-only t)) | |
363 (forward-line)) | |
364 (add-text-properties (point) (1+ (point)) '(front-sticky t)) | |
365 (add-text-properties (point) (1- (line-end-position)) '(read-only t)) | |
366 (goto-char (point-max))) | |
367 | |
368 (defvar mh-search-mode-map (make-sparse-keymap) | |
369 "Keymap for searching folder.") | |
370 | |
371 ;; If this changes, modify mh-search-mode-help-messages accordingly, below. | |
372 (gnus-define-keys mh-search-mode-map | |
373 "\C-c?" mh-help | |
374 "\C-c\C-c" mh-index-do-search | |
375 "\C-c\C-p" mh-pick-do-search | |
376 "\C-c\C-f\C-b" mh-to-field | |
377 "\C-c\C-f\C-c" mh-to-field | |
378 "\C-c\C-f\C-d" mh-to-field | |
379 "\C-c\C-f\C-f" mh-to-field | |
380 "\C-c\C-f\C-r" mh-to-field | |
381 "\C-c\C-f\C-s" mh-to-field | |
382 "\C-c\C-f\C-t" mh-to-field | |
383 "\C-c\C-fb" mh-to-field | |
384 "\C-c\C-fc" mh-to-field | |
385 "\C-c\C-fd" mh-to-field | |
386 "\C-c\C-ff" mh-to-field | |
387 "\C-c\C-fr" mh-to-field | |
388 "\C-c\C-fs" mh-to-field | |
389 "\C-c\C-ft" mh-to-field) | |
390 | |
391 (easy-menu-define | |
392 mh-pick-menu mh-search-mode-map "Menu for MH-E Search" | |
393 '("Search" | |
394 ["Perform Search" mh-index-do-search t] | |
395 ["Search with pick" mh-pick-do-search t])) | |
396 | |
397 ;; Group messages logically, more or less. | |
398 (defvar mh-search-mode-help-messages | |
399 '((nil | |
400 "Perform search: \\[mh-index-do-search]\n" | |
401 "Search with pick: \\[mh-pick-do-search]\n" | |
402 "Move to a field by typing C-c C-f C-<field>\n" | |
403 "where <field> is the first letter of the desired field\n" | |
404 "(except for From: which uses \"m\").")) | |
405 "Key binding cheat sheet. | |
406 | |
407 This is an associative array which is used to show the most common | |
408 commands. The key is a prefix char. The value is one or more strings | |
409 which are concatenated together and displayed in the minibuffer if ? | |
410 is pressed after the prefix character. The special key nil is used to | |
411 display the non-prefixed commands. | |
412 | |
413 The substitutions described in `substitute-command-keys' are performed | |
414 as well.") | |
415 | |
416 (put 'mh-search-mode 'mode-class 'special) | |
417 | |
418 (define-derived-mode mh-search-mode fundamental-mode "MH-Search" | |
419 "Mode for creating search templates in MH-E.\\<mh-search-mode-map> | |
420 | |
421 After each field name, enter the pattern to search for. If a field's | |
422 value does not matter for the search, leave it empty. To search the | |
423 entire message, supply the pattern in the \"body\" of the template. | |
424 Each non-empty field must be matched for a message to be selected. To | |
425 effect a logical \"or\", use \\[mh-search-folder] multiple times. When | |
426 you have finished, type \\[mh-pick-do-search] to do the search. | |
427 | |
428 The hook `mh-search-mode-hook' is called upon entry to this mode. | |
429 | |
430 \\{mh-search-mode-map}" | |
431 | |
432 (make-local-variable 'mh-help-messages) | |
433 (easy-menu-add mh-pick-menu) | |
434 (setq mh-help-messages mh-search-mode-help-messages)) | |
435 | |
436 ;;;###mh-autoload | |
437 (defun mh-index-do-search (&optional indexer) | |
438 "Find messages that match the qualifications in the current pattern buffer. | |
439 If optional argument INDEXER is present, use it instead of | |
440 `mh-index-program'." | |
441 (interactive) | |
442 (unless (mh-index-choose indexer) (error "No indexing program found")) | |
443 (let* ((regexp-list (mh-pick-parse-search-buffer)) | |
444 (pattern (funcall mh-index-regexp-builder regexp-list))) | |
445 (if pattern | |
446 (mh-search nil mh-current-folder pattern mh-previous-window-config) | |
447 (error "No search terms")))) | |
448 | |
449 ;;;###mh-autoload | |
450 (defun mh-pick-do-search () | |
451 "Find messages that match the qualifications in the current pattern buffer. | |
452 | |
453 Uses the pick method described in `mh-pick-execute-search'." | |
454 (interactive) | |
455 (mh-index-do-search 'pick)) | |
456 | |
457 (defun mh-pick-parse-search-buffer () | |
458 "Parse the search buffer contents. | |
459 The function returns a alist. The car of each element is either | |
460 the header name to search in or nil to search the whole message. | |
461 The cdr of the element is the pattern to search." | |
462 (save-excursion | |
463 (let ((pattern-list ()) | |
464 (in-body-flag nil) | |
465 start begin) | |
466 (goto-char (point-min)) | |
467 (while (not (eobp)) | |
468 (if (search-forward "--------" (line-end-position) t) | |
469 (setq in-body-flag t) | |
470 (beginning-of-line) | |
471 (setq begin (point)) | |
472 (setq start (if in-body-flag | |
473 (point) | |
474 (search-forward ":" (line-end-position) t) | |
475 (point))) | |
476 (push (cons (and (not in-body-flag) | |
477 (intern (downcase | |
478 (buffer-substring-no-properties | |
479 begin (1- start))))) | |
480 (mh-index-parse-search-regexp | |
481 (buffer-substring-no-properties | |
482 start (line-end-position)))) | |
483 pattern-list)) | |
484 (forward-line)) | |
485 pattern-list))) | |
486 | |
487 ;;;###mh-autoload | |
488 (defun mh-index-parse-search-regexp (input-string) | |
489 "Construct parse tree for INPUT-STRING. | |
490 All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by | |
491 AND, OR and NOT as appropriate. Then the resulting string is | |
492 parsed." | |
493 (let (input) | |
494 (with-temp-buffer | |
495 (insert input-string) | |
496 ;; replace tabs | |
497 (mh-replace-string "\t" " ") | |
498 ;; synonyms of AND | |
499 (mh-replace-string " AND " " and ") | |
500 (mh-replace-string "&" " and ") | |
501 (mh-replace-string " -and " " and ") | |
502 ;; synonyms of OR | |
503 (mh-replace-string " OR " " or ") | |
504 (mh-replace-string "|" " or ") | |
505 (mh-replace-string " -or " " or ") | |
506 ;; synonyms of NOT | |
507 (mh-replace-string " NOT " " not ") | |
508 (mh-replace-string "!" " not ") | |
509 (mh-replace-string "~" " not ") | |
510 (mh-replace-string " -not " " not ") | |
511 ;; synonyms of left brace | |
512 (mh-replace-string "(" " ( ") | |
513 (mh-replace-string " -lbrace " " ( ") | |
514 ;; synonyms of right brace | |
515 (mh-replace-string ")" " ) ") | |
516 (mh-replace-string " -rbrace " " ) ") | |
517 ;; get the normalized input | |
518 (setq input (format "( %s )" (buffer-substring (point-min) (point-max))))) | |
519 | |
520 (let ((tokens (mh-index-add-implicit-ops (split-string input))) | |
521 (op-stack ()) | |
522 (operand-stack ()) | |
523 oper1) | |
524 (dolist (token tokens) | |
525 (cond ((equal token "(") (push 'paren op-stack)) | |
526 ((equal token "not") (push 'not op-stack)) | |
527 ((equal token "or") (push 'or op-stack)) | |
528 ((equal token "and") (push 'and op-stack)) | |
529 ((equal token ")") | |
530 (multiple-value-setq (op-stack operand-stack) | |
531 (mh-index-evaluate op-stack operand-stack)) | |
532 (when (eq (car op-stack) 'not) | |
533 (setq op-stack (cdr op-stack)) | |
534 (push `(not ,(pop operand-stack)) operand-stack)) | |
535 (when (eq (car op-stack) 'and) | |
536 (setq op-stack (cdr op-stack)) | |
537 (setq oper1 (pop operand-stack)) | |
538 (push `(and ,(pop operand-stack) ,oper1) operand-stack))) | |
539 ((eq (car op-stack) 'not) | |
540 (setq op-stack (cdr op-stack)) | |
541 (push `(not ,token) operand-stack) | |
542 (when (eq (car op-stack) 'and) | |
543 (setq op-stack (cdr op-stack)) | |
544 (setq oper1 (pop operand-stack)) | |
545 (push `(and ,(pop operand-stack) ,oper1) operand-stack))) | |
546 ((eq (car op-stack) 'and) | |
547 (setq op-stack (cdr op-stack)) | |
548 (push `(and ,(pop operand-stack) ,token) operand-stack)) | |
549 (t (push token operand-stack)))) | |
550 (prog1 (pop operand-stack) | |
551 (when (or op-stack operand-stack) | |
552 (error "Invalid regexp: %s" input)))))) | |
553 | |
554 (defun mh-index-add-implicit-ops (tokens) | |
555 "Add implicit operators in the list TOKENS." | |
556 (let ((result ()) | |
557 (literal-seen nil) | |
558 current) | |
559 (while tokens | |
560 (setq current (pop tokens)) | |
561 (cond ((or (equal current ")") (equal current "and") (equal current "or")) | |
562 (setq literal-seen nil) | |
563 (push current result)) | |
564 ((and literal-seen | |
565 (push "and" result) | |
566 (setq literal-seen nil) | |
567 nil)) | |
568 (t | |
569 (push current result) | |
570 (unless (or (equal current "(") (equal current "not")) | |
571 (setq literal-seen t))))) | |
572 (nreverse result))) | |
573 | |
574 (defun mh-index-evaluate (op-stack operand-stack) | |
575 "Read expression till starting paren based on OP-STACK and OPERAND-STACK." | |
576 (block mh-index-evaluate | |
577 (let (op oper1) | |
578 (while op-stack | |
579 (setq op (pop op-stack)) | |
580 (cond ((eq op 'paren) | |
581 (return-from mh-index-evaluate (values op-stack operand-stack))) | |
582 ((eq op 'not) | |
583 (push `(not ,(pop operand-stack)) operand-stack)) | |
584 ((or (eq op 'and) (eq op 'or)) | |
585 (setq oper1 (pop operand-stack)) | |
586 (push `(,op ,(pop operand-stack) ,oper1) operand-stack)))) | |
587 (error "Ran out of tokens")))) | |
588 | |
589 | |
590 | |
591 ;;; Sequence browsing | |
592 | |
593 ;;;###mh-autoload | |
594 (defun mh-index-new-messages (folders) | |
595 "Display unseen messages. | |
596 | |
597 If you use a program such as \"procmail\" to use \"rcvstore\" to file | |
598 your incoming mail automatically, you can display new, unseen, | |
599 messages using this command. All messages in the \"unseen\" | |
600 sequence from the folders in `mh-new-messages-folders' are | |
601 listed. | |
602 | |
603 With a prefix argument, enter a space-separated list of FOLDERS, | |
604 or nothing to search all folders." | |
605 (interactive | |
606 (list (if current-prefix-arg | |
607 (split-string (read-string "Search folder(s) (default all): ")) | |
608 mh-new-messages-folders))) | |
609 (mh-index-sequenced-messages folders mh-unseen-seq)) | |
610 | |
611 ;;;###mh-autoload | |
612 (defun mh-index-ticked-messages (folders) | |
613 "Display ticked messages. | |
614 | |
615 All messages in `mh-tick-seq' from the folders in | |
616 `mh-ticked-messages-folders' are listed. | |
617 | |
618 With a prefix argument, enter a space-separated list of FOLDERS, | |
619 or nothing to search all folders." | |
620 (interactive | |
621 (list (if current-prefix-arg | |
622 (split-string (read-string "Search folder(s) (default all): ")) | |
623 mh-ticked-messages-folders))) | |
624 (mh-index-sequenced-messages folders mh-tick-seq)) | |
625 | |
626 ;;;###mh-autoload | |
627 (defun mh-index-sequenced-messages (folders sequence) | |
628 "Display messages in any sequence. | |
629 | |
630 All messages from the FOLDERS in `mh-new-messages-folders' in the | |
631 SEQUENCE you provide are listed. With a prefix argument, enter a | |
632 space-separated list of folders at the prompt, or nothing to | |
633 search all folders." | |
634 (interactive | |
635 (list (if current-prefix-arg | |
636 (split-string (read-string "Search folder(s) (default all): ")) | |
637 mh-new-messages-folders) | |
638 (mh-read-seq-default "Search" nil))) | |
639 (unless sequence (setq sequence mh-unseen-seq)) | |
640 (let* ((mh-flists-search-folders folders) | |
641 (mh-flists-sequence sequence) | |
642 (mh-flists-called-flag t) | |
643 (mh-indexer 'flists) | |
644 (mh-index-execute-search-function 'mh-flists-execute) | |
645 (mh-index-next-result-function 'mh-mairix-next-result) | |
646 (mh-mairix-folder mh-user-path) | |
647 (mh-index-regexp-builder nil) | |
648 (new-folder (format "%s/%s/%s" mh-index-folder | |
649 mh-flists-results-folder sequence)) | |
650 (window-config (if (equal new-folder mh-current-folder) | |
651 mh-previous-window-config | |
652 (current-window-configuration))) | |
653 (redo-flag nil) | |
654 message) | |
655 (cond ((buffer-live-p (get-buffer new-folder)) | |
656 ;; The destination folder is being visited. Trick `mh-search' | |
657 ;; into thinking that the folder resulted from a previous search. | |
658 (set-buffer new-folder) | |
659 (setq mh-index-previous-search (list folders mh-indexer sequence)) | |
660 (setq redo-flag t)) | |
661 ((mh-folder-exists-p new-folder) | |
662 ;; Folder exists but we don't have it open. That means they are | |
663 ;; stale results from a old flists search. Clear it out. | |
664 (mh-exec-cmd-quiet nil "rmf" new-folder))) | |
665 (setq message (mh-search redo-flag "+" mh-flists-results-folder | |
666 window-config) | |
667 mh-index-sequence-search-flag t | |
668 mh-index-previous-search (list folders mh-indexer sequence)) | |
669 (mh-index-write-data) | |
670 (when (stringp message) (message "%s" message)))) | |
671 | |
672 (defvar mh-flists-search-folders) | |
673 | |
674 (defun mh-flists-execute (&rest args) | |
675 "Execute flists. | |
676 Search for messages belonging to `mh-flists-sequence' in the | |
677 folders specified by `mh-flists-search-folders'. If | |
678 `mh-recursive-folders-flag' is t, then the folders are searched | |
679 recursively. All parameters ARGS are ignored." | |
680 (set-buffer (get-buffer-create mh-temp-index-buffer)) | |
681 (erase-buffer) | |
682 (unless (executable-find "sh") | |
683 (error "Didn't find sh")) | |
684 (with-temp-buffer | |
685 (let ((seq (symbol-name mh-flists-sequence))) | |
686 (insert "for folder in `" (expand-file-name "flists" mh-progs) " " | |
687 (cond ((eq mh-flists-search-folders t) | |
688 (mh-quote-for-shell mh-inbox)) | |
689 ((eq mh-flists-search-folders nil) "") | |
690 ((listp mh-flists-search-folders) | |
691 (loop for folder in mh-flists-search-folders | |
692 concat | |
693 (concat " " (mh-quote-for-shell folder))))) | |
694 (if mh-recursive-folders-flag " -recurse" "") | |
695 " -sequence " seq " -noshowzero -fast` ; do\n" | |
696 (expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n" | |
697 "done\n")) | |
698 (call-process-region | |
699 (point-min) (point-max) "sh" nil (get-buffer mh-temp-index-buffer)))) | |
700 | |
701 | |
702 | |
703 ;;; Folder navigation and utilities | |
704 | |
705 ;;;###mh-autoload | |
706 (defun mh-index-group-by-folder () | |
707 "Partition the messages based on source folder. | |
708 Returns an alist with the the folder names in the car and the cdr | |
709 being the list of messages originally from that folder." | |
710 (save-excursion | |
711 (goto-char (point-min)) | |
712 (let ((result-table (make-hash-table :test #'equal))) | |
713 (loop for msg being hash-keys of mh-index-msg-checksum-map | |
714 do (push msg (gethash (car (gethash | |
715 (gethash msg mh-index-msg-checksum-map) | |
716 mh-index-checksum-origin-map)) | |
717 result-table))) | |
718 (loop for x being the hash-keys of result-table | |
719 collect (cons x (nreverse (gethash x result-table))))))) | |
720 | |
721 ;;;###mh-autoload | |
722 (defun mh-index-insert-folder-headers () | |
723 "Annotate the search results with original folder names." | |
724 (let ((cur-msg (mh-get-msg-num nil)) | |
725 (old-buffer-modified-flag (buffer-modified-p)) | |
726 (buffer-read-only nil) | |
727 current-folder last-folder) | |
728 (goto-char (point-min)) | |
729 (while (not (eobp)) | |
730 (setq current-folder (car (gethash (gethash (mh-get-msg-num nil) | |
731 mh-index-msg-checksum-map) | |
732 mh-index-checksum-origin-map))) | |
733 (when (and current-folder (not (equal current-folder last-folder))) | |
734 (insert (if last-folder "\n" "") current-folder "\n") | |
735 (setq last-folder current-folder)) | |
736 (forward-line)) | |
737 (when cur-msg | |
738 (mh-notate-cur) | |
739 (mh-goto-msg cur-msg t)) | |
740 (set-buffer-modified-p old-buffer-modified-flag)) | |
741 (mh-index-create-imenu-index)) | |
742 | |
743 ;;;###mh-autoload | |
744 (defun mh-index-delete-folder-headers () | |
745 "Delete the folder headers." | |
746 (let ((cur-msg (mh-get-msg-num nil)) | |
747 (old-buffer-modified-flag (buffer-modified-p)) | |
748 (buffer-read-only nil)) | |
749 (while (and (not cur-msg) (not (eobp))) | |
750 (forward-line) | |
751 (setq cur-msg (mh-get-msg-num nil))) | |
752 (goto-char (point-min)) | |
753 (while (not (eobp)) | |
754 (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10)) | |
755 (delete-region (point) (progn (forward-line) (point))) | |
756 (forward-line))) | |
757 (when cur-msg (mh-goto-msg cur-msg t t)) | |
758 (set-buffer-modified-p old-buffer-modified-flag))) | |
759 | |
760 ;;;###mh-autoload | |
761 (defun mh-index-create-imenu-index () | |
762 "Create alist of folder names and positions in index folder buffers." | |
763 (save-excursion | |
764 (setq which-func-mode t) | |
765 (let ((alist ())) | |
766 (goto-char (point-min)) | |
767 (while (re-search-forward "^+" nil t) | |
768 (save-excursion | |
769 (beginning-of-line) | |
770 (push (cons (buffer-substring-no-properties | |
771 (point) (line-end-position)) | |
772 (set-marker (make-marker) (point))) | |
773 alist))) | |
774 (setq imenu--index-alist (nreverse alist))))) | |
775 | |
776 ;;;###mh-autoload | |
777 (defun mh-index-next-folder (&optional backward-flag) | |
778 "Jump to the next folder marker. | |
779 | |
780 With non-nil optional argument BACKWARD-FLAG, jump to the previous | |
781 group of results." | |
782 (interactive "P") | |
783 (if (null mh-index-data) | |
784 (message "Only applicable in an MH-E index search buffer") | |
785 (let ((point (point))) | |
786 (forward-line (if backward-flag 0 1)) | |
787 (cond ((if backward-flag | |
788 (re-search-backward "^+" (point-min) t) | |
789 (re-search-forward "^+" (point-max) t)) | |
790 (beginning-of-line)) | |
791 ((and (if backward-flag | |
792 (goto-char (point-max)) | |
793 (goto-char (point-min))) | |
794 nil)) | |
795 ((if backward-flag | |
796 (re-search-backward "^+" (point-min) t) | |
797 (re-search-forward "^+" (point-max) t)) | |
798 (beginning-of-line)) | |
799 (t (goto-char point)))))) | |
800 | |
801 ;;;###mh-autoload | |
802 (defun mh-index-previous-folder () | |
803 "Jump to the previous folder marker." | |
804 (interactive) | |
805 (mh-index-next-folder t)) | |
806 | |
807 ;;;###mh-autoload | |
808 (defun mh-index-visit-folder () | |
809 "Visit original folder from where the message at point was found." | |
810 (interactive) | |
811 (unless mh-index-data | |
812 (error "Not in an index folder")) | |
813 (let (folder msg) | |
814 (save-excursion | |
815 (cond ((and (bolp) (eolp)) | |
816 (ignore-errors (forward-line -1)) | |
817 (setq msg (mh-get-msg-num t))) | |
818 ((equal (char-after (line-beginning-position)) ?+) | |
819 (setq folder (buffer-substring-no-properties | |
820 (line-beginning-position) (line-end-position)))) | |
821 (t (setq msg (mh-get-msg-num t))))) | |
822 (when (not folder) | |
823 (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map) | |
824 mh-index-checksum-origin-map)))) | |
825 (when (or (not (get-buffer folder)) | |
826 (y-or-n-p (format "Reuse buffer displaying %s? " folder))) | |
827 (mh-visit-folder | |
828 folder (loop for x being the hash-keys of (gethash folder mh-index-data) | |
829 when (mh-msg-exists-p x folder) collect x))))) | |
830 | |
831 ;;;###mh-autoload | |
832 (defun mh-index-p () | |
833 "Non-nil means that this folder was generated by an index search." | |
834 mh-index-data) | |
835 | |
836 ;;;###mh-autoload | |
837 (defun mh-index-execute-commands () | |
838 "Delete/refile the actual messages. | |
839 The copies in the searched folder are then deleted/refiled to get | |
840 the desired result. Before deleting the messages we make sure | |
841 that the message being deleted is identical to the one that the | |
842 user has marked in the index buffer." | |
843 (save-excursion | |
844 (let ((folders ()) | |
845 (mh-speed-flists-inhibit-flag t)) | |
846 (maphash | |
847 (lambda (folder msgs) | |
848 (push folder folders) | |
849 (if (not (get-buffer folder)) | |
850 ;; If source folder not open, just delete the messages... | |
851 (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)) | |
852 ;; Otherwise delete the messages in the source buffer... | |
853 (save-excursion | |
854 (set-buffer folder) | |
855 (let ((old-refile-list mh-refile-list) | |
856 (old-delete-list mh-delete-list)) | |
857 (setq mh-refile-list nil | |
858 mh-delete-list msgs) | |
859 (unwind-protect (mh-execute-commands) | |
860 (setq mh-refile-list | |
861 (mapcar (lambda (x) | |
862 (cons (car x) | |
863 (loop for y in (cdr x) | |
864 unless (memq y msgs) collect y))) | |
865 old-refile-list) | |
866 mh-delete-list | |
867 (loop for x in old-delete-list | |
868 unless (memq x msgs) collect x)) | |
869 (mh-set-folder-modified-p (mh-outstanding-commands-p)) | |
870 (when (mh-outstanding-commands-p) | |
871 (mh-notate-deleted-and-refiled))))))) | |
872 (mh-index-matching-source-msgs (append (loop for x in mh-refile-list | |
873 append (cdr x)) | |
874 mh-delete-list) | |
875 t)) | |
876 folders))) | |
877 | |
878 | |
879 | |
880 ;;; Indexing functions | |
881 | |
882 ;; Support different indexing programs | |
883 (defvar mh-indexer-choices | |
884 '((swish++ | |
885 mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result | |
886 mh-swish++-regexp-builder) | |
887 (swish | |
888 mh-swish-binary mh-swish-execute-search mh-swish-next-result nil) | |
889 (mairix | |
890 mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result | |
891 mh-mairix-regexp-builder) | |
892 (namazu | |
893 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil) | |
894 (pick | |
895 mh-pick-binary mh-pick-execute-search mh-pick-next-result | |
896 mh-pick-regexp-builder) | |
897 (grep | |
898 mh-grep-binary mh-grep-execute-search mh-grep-next-result nil)) | |
899 "List of possible indexer choices.") | |
900 | |
901 (defun mh-index-choose (&optional indexer) | |
902 "Choose an indexing function. | |
903 The side-effects of this function are that the variables | |
904 `mh-indexer', `mh-index-execute-search-function', and | |
905 `mh-index-next-result-function' are set according to the first | |
906 indexer in `mh-indexer-choices' present on the system. | |
907 If optional argument INDEXER is present, use it instead of | |
908 `mh-index-program'." | |
909 (block nil | |
910 (let ((program-alist (cond (indexer | |
911 (list (assoc indexer mh-indexer-choices))) | |
912 (mh-index-program | |
913 (list | |
914 (assoc mh-index-program mh-indexer-choices))) | |
915 (t mh-indexer-choices)))) | |
916 (while program-alist | |
917 (let* ((current (pop program-alist)) | |
918 (executable (symbol-value (cadr current)))) | |
919 (when executable | |
920 (setq mh-indexer (car current)) | |
921 (setq mh-index-execute-search-function (nth 2 current)) | |
922 (setq mh-index-next-result-function (nth 3 current)) | |
923 (setq mh-index-regexp-builder (nth 4 current)) | |
924 (return mh-indexer)))) | |
925 nil))) | |
926 | |
927 ;;; Swish++ interface | |
928 | |
929 (defvar mh-swish++-binary (or (executable-find "search++") | |
930 (executable-find "search"))) | |
931 (defvar mh-swish++-directory ".swish++") | |
932 (defvar mh-swish-folder nil) | |
933 | |
934 ;;;###mh-autoload | |
935 (defun mh-swish++-execute-search (folder-path search-regexp) | |
936 "Execute swish++ and read the results. | |
937 | |
938 In the examples below, replace \"/home/user/Mail\" with the path to | |
939 your MH directory. | |
940 | |
941 First create the directory \"/home/user/Mail/.swish++\". Then create | |
942 the file \"/home/user/Mail/.swish++/swish++.conf\" with the following | |
943 contents: | |
944 | |
945 IncludeMeta Bcc Cc Comments Content-Description From Keywords | |
946 IncludeMeta Newsgroups Resent-To Subject To | |
947 IncludeMeta Message-Id References In-Reply-To | |
948 IncludeFile Mail * | |
949 IndexFile /home/user/Mail/.swish++/swish++.index | |
950 | |
951 Use the following command line to generate the swish index. Run | |
952 this daily from cron: | |
953 | |
954 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\ | |
955 -o -path /home/user/Mail/.swish++ -prune \\ | |
956 -o -name \"[0-9]*\" -print \\ | |
957 | index -c /home/user/Mail/.swish++/swish++.conf - | |
958 | |
959 This command does not index the folders that hold the results of your | |
960 searches in \"+mhe-index\" since they tend to be ephemeral and the | |
961 original messages are indexed anyway. | |
962 | |
963 On some systems (Debian GNU/Linux, for example), use \"index++\" | |
964 instead of \"index\". | |
965 | |
966 In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP is | |
967 used to search." | |
968 (set-buffer (get-buffer-create mh-temp-index-buffer)) | |
969 (erase-buffer) | |
970 (unless mh-swish++-binary | |
971 (error "Set `mh-swish++-binary' appropriately")) | |
972 (call-process mh-swish++-binary nil '(t nil) nil | |
973 "-m" "10000" | |
974 (format "-i%s%s/swish++.index" | |
975 mh-user-path mh-swish++-directory) | |
976 search-regexp) | |
977 (goto-char (point-min)) | |
978 (setq mh-swish-folder | |
979 (let ((last-char (substring folder-path (1- (length folder-path))))) | |
980 (if (equal last-char "/") | |
981 folder-path | |
982 (format "%s/" folder-path))))) | |
983 | |
984 (defalias 'mh-swish++-next-result 'mh-swish-next-result) | |
985 | |
986 (defun mh-swish++-regexp-builder (regexp-list) | |
987 "Generate query for swish++. | |
988 REGEXP-LIST is an alist of fields and values." | |
989 (let ((regexp "")) | |
990 (dolist (elem regexp-list) | |
991 (when (cdr elem) | |
992 (setq regexp (concat regexp " and " | |
993 (if (car elem) "(" "") | |
994 (if (car elem) (symbol-name (car elem)) "") | |
995 (if (car elem) " = " "") | |
996 (mh-swish++-print-regexp (cdr elem)) | |
997 (if (car elem) ")" ""))))) | |
998 (substring regexp 4))) | |
999 | |
1000 (defun mh-swish++-print-regexp (expr) | |
1001 "Return infix expression corresponding to EXPR." | |
1002 (cond ((atom expr) (format "%s" expr)) | |
1003 ((eq (car expr) 'not) | |
1004 (format "(not %s)" (mh-swish++-print-regexp (cadr expr)))) | |
1005 (t (format "(%s %s %s)" (mh-swish++-print-regexp (cadr expr)) | |
1006 (symbol-name (car expr)) | |
1007 (mh-swish++-print-regexp (caddr expr)))))) | |
1008 | |
1009 ;;; Swish interface | |
1010 | |
1011 (defvar mh-swish-binary (executable-find "swish-e")) | |
1012 (defvar mh-swish-directory ".swish") | |
1013 | |
1014 ;;;###mh-autoload | |
1015 (defun mh-swish-execute-search (folder-path search-regexp) | |
1016 "Execute swish-e and read the results. | |
1017 | |
1018 In the examples below, replace \"/home/user/Mail\" with the path | |
1019 to your MH directory. | |
1020 | |
1021 First create the directory \"/home/user/Mail/.swish\". Then | |
1022 create the file \"/home/user/Mail/.swish/config\" with the | |
1023 following contents: | |
1024 | |
1025 DefaultContents TXT* | |
1026 IndexDir /home/user/Mail | |
1027 IndexFile /home/user/Mail/.swish/index | |
1028 IndexName \"Mail Index\" | |
1029 IndexDescription \"Mail Index\" | |
1030 IndexPointer \"http://nowhere\" | |
1031 IndexAdmin \"nobody\" | |
1032 #MetaNames automatic | |
1033 IndexReport 3 | |
1034 FollowSymLinks no | |
1035 UseStemming no | |
1036 IgnoreTotalWordCountWhenRanking yes | |
1037 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789- | |
1038 BeginCharacters abcdefghijklmnopqrstuvwxyz | |
1039 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789 | |
1040 IgnoreLimit 50 1000 | |
1041 IndexComments 0 | |
1042 FileRules filename contains \\D | |
1043 FileRules pathname contains /home/user/Mail/.swish | |
1044 FileRules pathname contains /home/user/Mail/mhe-index | |
1045 | |
1046 This configuration does not index the folders that hold the | |
1047 results of your searches in \"+mhe-index\" since they tend to be | |
1048 ephemeral and the original messages are indexed anyway. | |
1049 | |
1050 If there are any directories you would like to ignore, append | |
1051 lines like the following to \"config\": | |
1052 | |
1053 FileRules pathname contains /home/user/Mail/scripts | |
1054 | |
1055 Use the following command line to generate the swish index. Run | |
1056 this daily from cron: | |
1057 | |
1058 swish-e -c /home/user/Mail/.swish/config | |
1059 | |
1060 In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP | |
1061 is used to search." | |
1062 (set-buffer (get-buffer-create mh-temp-index-buffer)) | |
1063 (erase-buffer) | |
1064 (unless mh-swish-binary | |
1065 (error "Set `mh-swish-binary' appropriately")) | |
1066 (call-process mh-swish-binary nil '(t nil) nil | |
1067 "-w" search-regexp | |
1068 "-f" (format "%s%s/index" mh-user-path mh-swish-directory)) | |
1069 (goto-char (point-min)) | |
1070 (setq mh-swish-folder | |
1071 (let ((last-char (substring folder-path (1- (length folder-path))))) | |
1072 (if (equal last-char "/") | |
1073 folder-path | |
1074 (format "%s/" folder-path))))) | |
1075 | |
1076 (defun mh-swish-next-result () | |
1077 "Get the next result from swish output." | |
1078 (prog1 | |
1079 (block nil | |
1080 (when (or (eobp) (equal (char-after (point)) ?.)) | |
1081 (return nil)) | |
1082 (when (equal (char-after (point)) ?#) | |
1083 (return 'error)) | |
1084 (let* ((start (search-forward " " (line-end-position) t)) | |
1085 (end (search-forward " " (line-end-position) t))) | |
1086 (unless (and start end) | |
1087 (return 'error)) | |
1088 (setq end (1- end)) | |
1089 (unless (file-exists-p (buffer-substring-no-properties start end)) | |
1090 (return 'error)) | |
1091 (unless (search-backward "/" start t) | |
1092 (return 'error)) | |
1093 (list (let* ((s (buffer-substring-no-properties start (1+ (point))))) | |
1094 (unless (string-match mh-swish-folder s) | |
1095 (return 'error)) | |
1096 (if (and (string-match mh-user-path s) | |
1097 (< (match-end 0) (1- (length s)))) | |
1098 (format "+%s" | |
1099 (substring s (match-end 0) (1- (length s)))) | |
1100 (return 'error))) | |
1101 (let* ((s (buffer-substring-no-properties (1+ (point)) end)) | |
1102 (val (ignore-errors (read-from-string s)))) | |
1103 (if (and (consp val) (numberp (car val))) | |
1104 (car val) | |
1105 (return 'error))) | |
1106 nil))) | |
1107 (forward-line))) | |
1108 | |
1109 ;;; Mairix interface | |
1110 | |
1111 (defvar mh-mairix-binary (executable-find "mairix")) | |
1112 (defvar mh-mairix-directory ".mairix") | |
1113 (defvar mh-mairix-folder nil) | |
1114 | |
1115 ;;;###mh-autoload | |
1116 (defun mh-mairix-execute-search (folder-path search-regexp-list) | |
1117 "Execute mairix and read the results. | |
1118 | |
1119 In the examples below, replace \"/home/user/Mail\" with the path | |
1120 to your MH directory. | |
1121 | |
1122 First create the directory \"/home/user/Mail/.mairix\". Then | |
1123 create the file \"/home/user/Mail/.mairix/config\" with the | |
1124 following contents: | |
1125 | |
1126 base=/home/user/Mail | |
1127 | |
1128 # List of folders that should be indexed. 3 dots at the end means there | |
1129 # are subfolders within the folder | |
1130 mh=archive...:inbox:drafts:news:sent:trash | |
1131 | |
1132 vfolder_format=raw | |
1133 database=/home/user/Mail/mairix/database | |
1134 | |
1135 Use the following command line to generate the mairix index. Run | |
1136 this daily from cron: | |
1137 | |
1138 mairix -f /home/user/Mail/.mairix/config | |
1139 | |
1140 In a program, FOLDER-PATH is the directory in which | |
1141 SEARCH-REGEXP-LIST is used to search." | |
1142 (set-buffer (get-buffer-create mh-temp-index-buffer)) | |
1143 (erase-buffer) | |
1144 (unless mh-mairix-binary | |
1145 (error "Set `mh-mairix-binary' appropriately")) | |
1146 (apply #'call-process mh-mairix-binary nil '(t nil) nil | |
1147 "-r" "-f" (format "%s%s/config" mh-user-path mh-mairix-directory) | |
1148 search-regexp-list) | |
1149 (goto-char (point-min)) | |
1150 (setq mh-mairix-folder | |
1151 (let ((last-char (substring folder-path (1- (length folder-path))))) | |
1152 (if (equal last-char "/") | |
1153 folder-path | |
1154 (format "%s/" folder-path))))) | |
1155 | |
1156 (defun mh-mairix-next-result () | |
1157 "Return next result from mairix output." | |
1158 (prog1 | |
1159 (block nil | |
1160 (when (or (eobp) (and (bolp) (eolp))) | |
1161 (return nil)) | |
1162 (unless (eq (char-after) ?/) | |
1163 (return 'error)) | |
1164 (let ((start (point)) | |
1165 end msg-start) | |
1166 (setq end (line-end-position)) | |
1167 (unless (search-forward mh-mairix-folder end t) | |
1168 (return 'error)) | |
1169 (goto-char (match-beginning 0)) | |
1170 (unless (equal (point) start) | |
1171 (return 'error)) | |
1172 (goto-char end) | |
1173 (unless (search-backward "/" start t) | |
1174 (return 'error)) | |
1175 (setq msg-start (1+ (point))) | |
1176 (goto-char start) | |
1177 (unless (search-forward mh-user-path end t) | |
1178 (return 'error)) | |
1179 (list (format "+%s" (buffer-substring-no-properties | |
1180 (point) (1- msg-start))) | |
1181 (car (read-from-string | |
1182 (buffer-substring-no-properties msg-start end))) | |
1183 ()))) | |
1184 (forward-line))) | |
1185 | |
1186 (defun mh-mairix-regexp-builder (regexp-list) | |
1187 "Generate query for mairix. | |
1188 REGEXP-LIST is an alist of fields and values." | |
1189 (let ((result ())) | |
1190 (dolist (pair regexp-list) | |
1191 (when (cdr pair) | |
1192 (push | |
1193 (concat | |
1194 (cond ((eq (car pair) 'to) "t:") | |
1195 ((eq (car pair) 'from) "f:") | |
1196 ((eq (car pair) 'cc) "c:") | |
1197 ((eq (car pair) 'subject) "s:") | |
1198 ((eq (car pair) 'date) "d:") | |
1199 (t "")) | |
1200 (let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair)))) | |
1201 (final "")) | |
1202 (dolist (conjunct sop) | |
1203 (let ((expr-list (cdr conjunct)) | |
1204 (expr-string "")) | |
1205 (dolist (e expr-list) | |
1206 (setq expr-string (concat expr-string "," | |
1207 (if (atom e) "" "~") | |
1208 (if (atom e) e (cadr e))))) | |
1209 (setq final (concat final "/" (substring expr-string 1))))) | |
1210 (substring final 1))) | |
1211 result))) | |
1212 result)) | |
1213 | |
1214 (defun mh-mairix-convert-to-sop* (expr) | |
1215 "Convert EXPR to sum of product form." | |
1216 (cond ((atom expr) `(or (and ,expr))) | |
1217 ((eq (car expr) 'or) | |
1218 (cons 'or | |
1219 (loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr)) | |
1220 append (cdr e)))) | |
1221 ((eq (car expr) 'and) | |
1222 (let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr))) | |
1223 result next-factor) | |
1224 (setq result (pop conjuncts)) | |
1225 (while conjuncts | |
1226 (setq next-factor (pop conjuncts)) | |
1227 (setq result (let ((res ())) | |
1228 (dolist (t1 (cdr result)) | |
1229 (dolist (t2 (cdr next-factor)) | |
1230 (push `(and ,@(cdr t1) ,@(cdr t2)) res))) | |
1231 (cons 'or res)))) | |
1232 result)) | |
1233 ((atom (cadr expr)) `(or (and ,expr))) | |
1234 ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr))) | |
1235 ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop* | |
1236 `(or ,@(mapcar #'(lambda (x) `(not ,x)) | |
1237 (cdadr expr))))) | |
1238 ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop* | |
1239 `(and ,@(mapcar #'(lambda (x) `(not ,x)) | |
1240 (cdadr expr))))) | |
1241 (t (error "Unreachable: %s" expr)))) | |
1242 | |
1243 ;;; Namazu interface | |
1244 | |
1245 (defvar mh-namazu-binary (executable-find "namazu")) | |
1246 (defvar mh-namazu-directory ".namazu") | |
1247 (defvar mh-namazu-folder nil) | |
1248 | |
1249 ;;;###mh-autoload | |
1250 (defun mh-namazu-execute-search (folder-path search-regexp) | |
1251 "Execute namazu and read the results. | |
1252 | |
1253 In the examples below, replace \"/home/user/Mail\" with the path to | |
1254 your MH directory. | |
1255 | |
1256 First create the directory \"/home/user/Mail/.namazu\". Then create | |
1257 the file \"/home/user/Mail/.namazu/mknmzrc\" with the following | |
1258 contents: | |
1259 | |
1260 package conf; # Don't remove this line! | |
1261 $ADDRESS = 'user@localhost'; | |
1262 $ALLOW_FILE = \"[0-9]*\"; | |
1263 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\"; | |
1264 | |
1265 This configuration does not index the folders that hold the results of | |
1266 your searches in \"+mhe-index\" since they tend to be ephemeral and | |
1267 the original messages are indexed anyway. | |
1268 | |
1269 Use the following command line to generate the namazu index. Run this | |
1270 daily from cron: | |
1271 | |
1272 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\ | |
1273 /home/user/Mail | |
1274 | |
1275 In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP | |
1276 is used to search." | |
1277 (let ((namazu-index-directory | |
1278 (format "%s%s" mh-user-path mh-namazu-directory))) | |
1279 (unless (file-exists-p namazu-index-directory) | |
1280 (error "Namazu directory %s not present" namazu-index-directory)) | |
1281 (unless (executable-find mh-namazu-binary) | |
1282 (error "Set `mh-namazu-binary' appropriately")) | |
1283 (set-buffer (get-buffer-create mh-temp-index-buffer)) | |
1284 (erase-buffer) | |
1285 (call-process mh-namazu-binary nil '(t nil) nil | |
1286 "-alR" search-regexp namazu-index-directory) | |
1287 (goto-char (point-min)) | |
1288 (setq mh-namazu-folder | |
1289 (let ((last (substring folder-path (1- (length folder-path))))) | |
1290 (if (equal last "/") | |
1291 folder-path | |
1292 (format "%s/" folder-path)))))) | |
1293 | |
1294 (defun mh-namazu-next-result () | |
1295 "Get the next result from namazu output." | |
1296 (prog1 | |
1297 (block nil | |
1298 (when (eobp) (return nil)) | |
1299 (let ((file-name (buffer-substring-no-properties | |
1300 (point) (line-end-position)))) | |
1301 (unless (equal (string-match mh-namazu-folder file-name) 0) | |
1302 (return 'error)) | |
1303 (unless (file-exists-p file-name) | |
1304 (return 'error)) | |
1305 (string-match mh-user-path file-name) | |
1306 (let* ((folder/msg (substring file-name (match-end 0))) | |
1307 (mark (mh-search-from-end ?/ folder/msg))) | |
1308 (unless mark (return 'error)) | |
1309 (list (format "+%s" (substring folder/msg 0 mark)) | |
1310 (let ((n (ignore-errors (read-from-string | |
1311 (substring folder/msg (1+ mark)))))) | |
1312 (if (and (consp n) (numberp (car n))) | |
1313 (car n) | |
1314 (return 'error))) | |
1315 nil)))) | |
1316 (forward-line))) | |
1317 | |
1318 ;;; Pick interface | |
1319 | |
1320 (defvar mh-index-pick-folder) | |
1321 (defvar mh-pick-binary "pick") | |
1322 (defconst mh-pick-single-dash '(cc date from subject to) | |
1323 "Search components that are supported by single-dash option in pick.") | |
1324 | |
1325 ;;;###mh-autoload | |
1326 (defun mh-pick-execute-search (folder-path search-regexp) | |
1327 "Execute pick. | |
1328 | |
1329 There are no semantics associated with the search criteria--they | |
1330 are simply treated as strings. Case is ignored when all lowercase | |
1331 is used, and regular expressions (a la \"ed\") are available. | |
1332 | |
1333 Unlike the other index search programs, you must specify a | |
1334 folder. In addition, this command does not descend into any | |
1335 sub-folders that may be present. | |
1336 | |
1337 In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP | |
1338 is used to search." | |
1339 (set-buffer (get-buffer-create mh-temp-index-buffer)) | |
1340 (erase-buffer) | |
1341 (setq mh-index-pick-folder | |
1342 (concat "+" (substring folder-path (length mh-user-path)))) | |
1343 (apply #'call-process (expand-file-name "pick" mh-progs) nil '(t nil) nil | |
1344 mh-index-pick-folder "-list" search-regexp) | |
1345 (goto-char (point-min))) | |
1346 | |
1347 (defun mh-pick-next-result () | |
1348 "Return the next pick search result." | |
1349 (prog1 (block nil | |
1350 (when (eobp) (return nil)) | |
1351 (unless (re-search-forward "^[1-9][0-9]*$" (line-end-position) t) | |
1352 (return 'error)) | |
1353 (list mh-index-pick-folder | |
1354 (car (read-from-string (buffer-substring-no-properties | |
1355 (line-beginning-position) | |
1356 (line-end-position)))) | |
1357 nil)) | |
1358 (forward-line))) | |
1359 | |
1360 ;; All implementations of pick have special options -cc, -date, -from and | |
1361 ;; -subject that allow to search for corresponding components. Any other | |
1362 ;; component is searched using option --COMPNAME, for example: `pick | |
1363 ;; --x-mailer mh-e'. Mailutils "pick" supports this option using a certain | |
1364 ;; kludge, but it prefers the following syntax for this purpose: | |
1365 ;; "--component=COMPNAME --pattern=PATTERN". | |
1366 ;; -- Sergey Poznyakoff, Aug 2003 | |
1367 (defun mh-pick-regexp-builder (pattern-list) | |
1368 "Generate pick search expression from PATTERN-LIST." | |
1369 (let ((result ())) | |
1370 (dolist (pattern pattern-list) | |
1371 (when (cdr pattern) | |
1372 (setq result `(,@result "-and" "-lbrace" | |
1373 ,@(mh-pick-construct-regexp | |
1374 (if (and (mh-variant-p 'mu-mh) (car pattern)) | |
1375 (format "--pattern=%s" (cdr pattern)) | |
1376 (cdr pattern)) | |
1377 (if (car pattern) | |
1378 (cond | |
1379 ((mh-variant-p 'mu-mh) | |
1380 (format "--component=%s" (car pattern))) | |
1381 ((member (car pattern) mh-pick-single-dash) | |
1382 (format "-%s" (car pattern))) | |
1383 (t | |
1384 (format "--%s" (car pattern)))) | |
1385 "-search")) | |
1386 "-rbrace")))) | |
1387 (cdr result))) | |
1388 | |
1389 (defun mh-pick-construct-regexp (expr component) | |
1390 "Construct pick compatible expression corresponding to EXPR. | |
1391 COMPONENT is the component to search." | |
1392 (cond ((atom expr) (list component expr)) | |
1393 ((eq (car expr) 'and) | |
1394 `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-and" | |
1395 ,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace")) | |
1396 ((eq (car expr) 'or) | |
1397 `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-or" | |
1398 ,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace")) | |
1399 ((eq (car expr) 'not) | |
1400 `("-lbrace" "-not" ,@(mh-pick-construct-regexp (cadr expr) component) | |
1401 "-rbrace")) | |
1402 (t (error "Unknown operator %s seen" (car expr))))) | |
1403 | |
1404 ;;; Grep interface | |
1405 | |
1406 (defvar mh-grep-binary (executable-find "grep")) | |
1407 | |
1408 ;;;###mh-autoload | |
1409 (defun mh-grep-execute-search (folder-path search-regexp) | |
1410 "Execute grep and read the results. | |
1411 | |
1412 In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP | |
1413 is used to search." | |
1414 (set-buffer (get-buffer-create mh-temp-index-buffer)) | |
1415 (erase-buffer) | |
1416 (call-process mh-grep-binary nil '(t nil) nil | |
1417 "-i" "-r" search-regexp folder-path) | |
1418 (goto-char (point-min))) | |
1419 | |
1420 (defun mh-grep-next-result () | |
1421 "Read the next result. | |
1422 Parse it and return the message folder, message index and the | |
1423 match. If no other matches left then return nil. If the current | |
1424 record is invalid return 'error." | |
1425 (prog1 | |
1426 (block nil | |
1427 (when (eobp) | |
1428 (return nil)) | |
1429 (let ((eol-pos (line-end-position)) | |
1430 (bol-pos (line-beginning-position)) | |
1431 folder-start msg-end) | |
1432 (goto-char bol-pos) | |
1433 (unless (search-forward mh-user-path eol-pos t) | |
1434 (return 'error)) | |
1435 (setq folder-start (point)) | |
1436 (unless (search-forward ":" eol-pos t) | |
1437 (return 'error)) | |
1438 (let ((match (buffer-substring-no-properties (point) eol-pos))) | |
1439 (forward-char -1) | |
1440 (setq msg-end (point)) | |
1441 (unless (search-backward "/" folder-start t) | |
1442 (return 'error)) | |
1443 (list (format "+%s" (buffer-substring-no-properties | |
1444 folder-start (point))) | |
1445 (let ((val (ignore-errors (read-from-string | |
1446 (buffer-substring-no-properties | |
1447 (1+ (point)) msg-end))))) | |
1448 (if (and (consp val) (integerp (car val))) | |
1449 (car val) | |
1450 (return 'error))) | |
1451 match)))) | |
1452 (forward-line))) | |
1453 | |
1454 | |
1455 | |
1456 ;;; Folder support | |
1457 | |
1458 (defun mh-index-generate-pretty-name (string) | |
1459 "Given STRING generate a name which is suitable for use as a folder name. | |
1460 White space from the beginning and end are removed. All spaces in | |
1461 the name are replaced with underscores and all / are replaced | |
1462 with $. If STRING is longer than 20 it is truncated too. STRING | |
1463 could be a list of strings in which case they are concatenated to | |
1464 construct the base name." | |
1465 (with-temp-buffer | |
1466 (if (stringp string) | |
1467 (insert string) | |
1468 (when (car string) (insert (car string))) | |
1469 (dolist (s (cdr string)) | |
1470 (insert "_" s))) | |
1471 (setq string (mh-replace-string "-lbrace" " ")) | |
1472 (setq string (mh-replace-string "-rbrace" " ")) | |
1473 (subst-char-in-region (point-min) (point-max) ?( ? t) | |
1474 (subst-char-in-region (point-min) (point-max) ?) ? t) | |
1475 (subst-char-in-region (point-min) (point-max) ?- ? t) | |
1476 (goto-char (point-min)) | |
1477 (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_))) | |
1478 (delete-char 1)) | |
1479 (goto-char (point-max)) | |
1480 (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_))) | |
1481 (delete-backward-char 1)) | |
1482 (subst-char-in-region (point-min) (point-max) ? ?_ t) | |
1483 (subst-char-in-region (point-min) (point-max) ?\t ?_ t) | |
1484 (subst-char-in-region (point-min) (point-max) ?\n ?_ t) | |
1485 (subst-char-in-region (point-min) (point-max) ?\r ?_ t) | |
1486 (subst-char-in-region (point-min) (point-max) ?/ ?$ t) | |
1487 (let ((out (truncate-string-to-width (buffer-string) 20))) | |
1488 (cond ((eq mh-indexer 'flists) | |
1489 (format "%s/%s" mh-flists-results-folder mh-flists-sequence)) | |
1490 ((equal out mh-flists-results-folder) (concat out "1")) | |
1491 (t out))))) | |
1492 | |
1493 (defun mh-folder-exists-p (folder) | |
1494 "Check if FOLDER exists." | |
1495 (and (mh-folder-name-p folder) | |
1496 (save-excursion | |
1497 (with-temp-buffer | |
1498 (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder) | |
1499 (goto-char (point-min)) | |
1500 (not (eobp)))))) | |
1501 | |
1502 (defun mh-msg-exists-p (msg folder) | |
1503 "Check if MSG exists in FOLDER." | |
1504 (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg))) | |
1505 | |
1506 (defun mh-index-new-folder (name search-regexp) | |
1507 "Return a folder name based on NAME for search results of SEARCH-REGEXP. | |
1508 | |
1509 If folder NAME already exists and was generated for the same | |
1510 SEARCH-REGEXP then it is reused. | |
1511 | |
1512 Otherwise if the folder NAME was generated from a different | |
1513 search then check if NAME<2> can be used. Otherwise try NAME<3>. | |
1514 This is repeated till we find a new folder name. | |
1515 | |
1516 If the folder returned doesn't exist then it is created." | |
1517 (unless (mh-folder-name-p name) | |
1518 (error "The argument should be a valid MH folder name")) | |
1519 (let ((chosen-name | |
1520 (loop for i from 1 | |
1521 for candidate = (if (equal i 1) name (format "%s<%s>" name i)) | |
1522 when (or (not (mh-folder-exists-p candidate)) | |
1523 (equal (mh-index-folder-search-regexp candidate) | |
1524 search-regexp)) | |
1525 return candidate))) | |
1526 ;; Do pending refiles/deletes... | |
1527 (when (get-buffer chosen-name) | |
1528 (mh-process-or-undo-commands chosen-name)) | |
1529 ;; Recreate folder... | |
1530 (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name)) | |
1531 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) | |
1532 (mh-remove-from-sub-folders-cache chosen-name) | |
1533 (when (boundp 'mh-speed-folder-map) | |
1534 (mh-speed-add-folder chosen-name)) | |
1535 chosen-name)) | |
1536 | |
1537 (defun mh-index-folder-search-regexp (folder) | |
1538 "If FOLDER was created by a index search, return the search regexp. | |
1539 Return nil if FOLDER doesn't exist or the .mhe_index file is | |
1540 garbled." | |
1541 (ignore-errors | |
1542 (with-temp-buffer | |
1543 (insert-file-contents | |
1544 (format "%s%s/%s" mh-user-path (substring folder 1) mh-index-data-file)) | |
1545 (goto-char (point-min)) | |
1546 (forward-list 3) | |
1547 (cadr (read (current-buffer)))))) | |
1548 | |
1549 | |
1550 | |
1551 ;;; Sequence support | |
1552 | |
1553 ;;;###mh-autoload | |
1554 (defun mh-index-create-sequences () | |
1555 "Mirror sequences present in source folders in index folder." | |
1556 (let ((seq-hash (make-hash-table :test #'equal)) | |
1557 (seq-list ())) | |
1558 (loop for folder being the hash-keys of mh-index-data | |
1559 do (setf (gethash folder seq-hash) | |
1560 (mh-create-sequence-map | |
1561 (mh-read-folder-sequences folder nil)))) | |
1562 (dolist (msg (mh-translate-range mh-current-folder "all")) | |
1563 (let* ((checksum (gethash msg mh-index-msg-checksum-map)) | |
1564 (pair (gethash checksum mh-index-checksum-origin-map)) | |
1565 (ofolder (car pair)) | |
1566 (omsg (cdr pair))) | |
1567 (loop for seq in (ignore-errors | |
1568 (gethash omsg (gethash ofolder seq-hash))) | |
1569 do (if (assoc seq seq-list) | |
1570 (push msg (cdr (assoc seq seq-list))) | |
1571 (push (list seq msg) seq-list))))) | |
1572 (loop for seq in seq-list | |
1573 do (apply #'mh-exec-cmd "mark" mh-current-folder | |
1574 "-sequence" (symbol-name (car seq)) "-add" | |
1575 (mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) | |
1576 | |
1577 ;;;###mh-autoload | |
1578 (defun mh-create-sequence-map (seq-list) | |
1579 "Return a map from msg number to list of sequences in which it is present. | |
1580 SEQ-LIST is an assoc list whose keys are sequence names and whose | |
1581 cdr is the list of messages in that sequence." | |
1582 (loop with map = (make-hash-table) | |
1583 for seq in seq-list | |
1584 when (and (not (memq (car seq) (mh-unpropagated-sequences))) | |
1585 (mh-valid-seq-p (car seq))) | |
1586 do (loop for msg in (cdr seq) | |
1587 do (push (car seq) (gethash msg map))) | |
1588 finally return map)) | |
1589 | |
1590 ;;;###mh-autoload | |
1591 (defun mh-index-add-to-sequence (seq msgs) | |
1592 "Add to SEQ the messages in the list MSGS. | |
1593 This function updates the source folder sequences. Also makes an | |
1594 attempt to update the source folder buffer if we have it open." | |
1595 ;; Don't need to do anything for cur | |
1596 (save-excursion | |
1597 (when (and (not (memq seq (mh-unpropagated-sequences))) | |
1598 (mh-valid-seq-p seq)) | |
1599 (let ((folders ()) | |
1600 (mh-speed-flists-inhibit-flag t)) | |
1601 (maphash (lambda (folder msgs) | |
1602 (push folder folders) | |
1603 ;; Add messages to sequence in source folder... | |
1604 (apply #'mh-exec-cmd-quiet nil "mark" folder | |
1605 "-add" "-nozero" "-sequence" (symbol-name seq) | |
1606 (mapcar (lambda (x) (format "%s" x)) | |
1607 (mh-coalesce-msg-list msgs))) | |
1608 ;; Update source folder buffer if we have it open... | |
1609 (when (get-buffer folder) | |
1610 (save-excursion | |
1611 (set-buffer folder) | |
1612 (mh-put-msg-in-seq msgs seq)))) | |
1613 (mh-index-matching-source-msgs msgs)) | |
1614 folders)))) | |
1615 | |
1616 ;;;###mh-autoload | |
1617 (defun mh-index-delete-from-sequence (seq msgs) | |
1618 "Delete from SEQ the messages in MSGS. | |
1619 This function updates the source folder sequences. Also makes an | |
1620 attempt to update the source folder buffer if present." | |
1621 (save-excursion | |
1622 (when (and (not (memq seq (mh-unpropagated-sequences))) | |
1623 (mh-valid-seq-p seq)) | |
1624 (let ((folders ()) | |
1625 (mh-speed-flists-inhibit-flag t)) | |
1626 (maphash (lambda (folder msgs) | |
1627 (push folder folders) | |
1628 ;; Remove messages from sequence in source folder... | |
1629 (apply #'mh-exec-cmd-quiet nil "mark" folder | |
1630 "-del" "-nozero" "-sequence" (symbol-name seq) | |
1631 (mapcar (lambda (x) (format "%s" x)) | |
1632 (mh-coalesce-msg-list msgs))) | |
1633 ;; Update source folder buffer if we have it open... | |
1634 (when (get-buffer folder) | |
1635 (save-excursion | |
1636 (set-buffer folder) | |
1637 (mh-delete-msg-from-seq msgs seq t)))) | |
1638 (mh-index-matching-source-msgs msgs)) | |
1639 folders)))) | |
1640 | |
1641 (defvar mh-unpropagated-sequences '(cur range subject search) | |
1642 "List of sequences that aren't preserved.") | |
1643 | |
1644 (defun mh-unpropagated-sequences () | |
1645 "Return a list of sequences that aren't propagated to the source folders. | |
1646 It is just the sequences in the variable | |
1647 `mh-unpropagated-sequences' in addition to the | |
1648 Previous-Sequence (see mh-profile 5)." | |
1649 (if mh-previous-seq | |
1650 (cons mh-previous-seq mh-unpropagated-sequences) | |
1651 mh-unpropagated-sequences)) | |
1652 | |
1653 (defun mh-index-matching-source-msgs (msgs &optional delete-from-index-data) | |
1654 "Return a table of original messages and folders for messages in MSGS. | |
1655 If optional argument DELETE-FROM-INDEX-DATA is non-nil, then each | |
1656 of the messages, whose counter-part is found in some source | |
1657 folder, is removed from `mh-index-data'." | |
1658 (let ((table (make-hash-table :test #'equal))) | |
1659 (dolist (msg msgs) | |
1660 (let* ((checksum (gethash msg mh-index-msg-checksum-map)) | |
1661 (pair (gethash checksum mh-index-checksum-origin-map))) | |
1662 (when (and checksum (car pair) (cdr pair) | |
1663 (mh-index-match-checksum (cdr pair) (car pair) checksum)) | |
1664 (push (cdr pair) (gethash (car pair) table)) | |
1665 (when delete-from-index-data | |
1666 (remhash (cdr pair) (gethash (car pair) mh-index-data)))))) | |
1667 table)) | |
1668 | |
1669 (defun mh-index-match-checksum (msg folder checksum) | |
1670 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." | |
1671 (with-temp-buffer | |
1672 (mh-exec-cmd-output mh-scan-prog nil "-width" "80" | |
1673 "-format" "%{x-mhe-checksum}\n" folder msg) | |
1674 (goto-char (point-min)) | |
1675 (string-equal (buffer-substring-no-properties (point) (line-end-position)) | |
1676 checksum))) | |
1677 | |
1678 | |
1679 | |
1680 ;;; Serialization of index data | |
1681 | |
1682 (defun mh-index-write-data () | |
1683 "Write index data to file." | |
1684 (ignore-errors | |
1685 (unless (eq major-mode 'mh-folder-mode) | |
1686 (error "Can't be called from folder in \"%s\"" major-mode)) | |
1687 (let ((data mh-index-data) | |
1688 (msg-checksum-map mh-index-msg-checksum-map) | |
1689 (checksum-origin-map mh-index-checksum-origin-map) | |
1690 (previous-search mh-index-previous-search) | |
1691 (sequence-search-flag mh-index-sequence-search-flag) | |
1692 (outfile (concat buffer-file-name mh-index-data-file)) | |
1693 (print-length nil) | |
1694 (print-level nil)) | |
1695 (with-temp-file outfile | |
1696 (mh-index-write-hashtable | |
1697 data (lambda (x) (loop for y being the hash-keys of x collect y))) | |
1698 (mh-index-write-hashtable msg-checksum-map #'identity) | |
1699 (mh-index-write-hashtable checksum-origin-map #'identity) | |
1700 (pp previous-search (current-buffer)) (insert "\n") | |
1701 (pp sequence-search-flag (current-buffer)) (insert "\n"))))) | |
1702 | |
1703 (defun mh-index-write-hashtable (table proc) | |
1704 "Write TABLE to `current-buffer'. | |
1705 PROC is used to serialize the values corresponding to the hash | |
1706 table keys." | |
1707 (pp (loop for x being the hash-keys of table | |
1708 collect (cons x (funcall proc (gethash x table)))) | |
1709 (current-buffer)) | |
1710 (insert "\n")) | |
1711 | |
1712 ;;;###mh-autoload | |
1713 (defun mh-index-read-data () | |
1714 "Read index data from file." | |
1715 (ignore-errors | |
1716 (unless (eq major-mode 'mh-folder-mode) | |
1717 (error "Can't be called from folder in \"%s\"" major-mode)) | |
1718 (let ((infile (concat buffer-file-name mh-index-data-file)) | |
1719 t1 t2 t3 t4 t5) | |
1720 (with-temp-buffer | |
1721 (insert-file-contents-literally infile) | |
1722 (goto-char (point-min)) | |
1723 (setq t1 (mh-index-read-hashtable | |
1724 (lambda (data) | |
1725 (loop with table = (make-hash-table :test #'equal) | |
1726 for x in data do (setf (gethash x table) t) | |
1727 finally return table))) | |
1728 t2 (mh-index-read-hashtable #'identity) | |
1729 t3 (mh-index-read-hashtable #'identity) | |
1730 t4 (read (current-buffer)) | |
1731 t5 (read (current-buffer)))) | |
1732 (setq mh-index-data t1 | |
1733 mh-index-msg-checksum-map t2 | |
1734 mh-index-checksum-origin-map t3 | |
1735 mh-index-previous-search t4 | |
1736 mh-index-sequence-search-flag t5)))) | |
1737 | |
1738 (defun mh-index-read-hashtable (proc) | |
1739 "From BUFFER read a hash table serialized as a list. | |
1740 PROC is used to convert the value to actual data." | |
1741 (loop with table = (make-hash-table :test #'equal) | |
1742 for pair in (read (current-buffer)) | |
1743 do (setf (gethash (car pair) table) (funcall proc (cdr pair))) | |
1744 finally return table)) | |
1745 | |
1746 | |
1747 | |
1748 ;;; Checksum routines | |
1749 | |
1750 ;; A few different checksum programs are supported. The supported programs | |
1751 ;; are: | |
1752 ;; | |
1753 ;; 1. md5sum | |
1754 ;; 2. md5 | |
1755 ;; 3. openssl | |
1756 ;; | |
1757 ;; To add support for your favorite checksum program add a clause to the cond | |
1758 ;; statement in mh-checksum-choose. This should set the variable | |
1759 ;; mh-checksum-cmd to the command line needed to run the checsum program and | |
1760 ;; should set mh-checksum-parser to a function which returns a cons cell | |
1761 ;; containing the message number and checksum string. | |
1762 | |
1763 (defvar mh-checksum-cmd) | |
1764 (defvar mh-checksum-parser) | |
1765 | |
1766 (defun mh-checksum-choose () | |
1767 "Check if a program to create a checksum is present." | |
1768 (unless (boundp 'mh-checksum-cmd) | |
1769 (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path))) | |
1770 (cond ((executable-find "md5sum") | |
1771 (setq mh-checksum-cmd (list (executable-find "md5sum"))) | |
1772 (setq mh-checksum-parser #'mh-md5sum-parser)) | |
1773 ((executable-find "openssl") | |
1774 (setq mh-checksum-cmd (list (executable-find "openssl") "md5")) | |
1775 (setq mh-checksum-parser #'mh-openssl-parser)) | |
1776 ((executable-find "md5") | |
1777 (setq mh-checksum-cmd (list (executable-find "md5"))) | |
1778 (setq mh-checksum-parser #'mh-md5-parser)) | |
1779 (t (error "No suitable checksum program")))))) | |
1780 | |
1781 (defun mh-md5sum-parser () | |
1782 "Parse md5sum output." | |
1783 (let ((begin (line-beginning-position)) | |
1784 (end (line-end-position)) | |
1785 first-space last-slash) | |
1786 (setq first-space (search-forward " " end t)) | |
1787 (goto-char end) | |
1788 (setq last-slash (search-backward "/" begin t)) | |
1789 (cond ((and first-space last-slash) | |
1790 (cons (car (read-from-string (buffer-substring-no-properties | |
1791 (1+ last-slash) end))) | |
1792 (buffer-substring-no-properties begin (1- first-space)))) | |
1793 (t (cons nil nil))))) | |
1794 | |
1795 (defun mh-openssl-parser () | |
1796 "Parse openssl output." | |
1797 (let ((begin (line-beginning-position)) | |
1798 (end (line-end-position)) | |
1799 last-space last-slash) | |
1800 (goto-char end) | |
1801 (setq last-space (search-backward " " begin t)) | |
1802 (setq last-slash (search-backward "/" begin t)) | |
1803 (cond ((and last-slash last-space) | |
1804 (cons (car (read-from-string (buffer-substring-no-properties | |
1805 (1+ last-slash) (1- last-space)))) | |
1806 (buffer-substring-no-properties (1+ last-space) end)))))) | |
1807 | |
1808 (defalias 'mh-md5-parser 'mh-openssl-parser) | |
1809 | |
1810 ;;;###mh-autoload | |
1811 (defun mh-index-update-maps (folder &optional origin-map) | |
1812 "Annotate all as yet unannotated messages in FOLDER with their MD5 hash. | |
1813 As a side effect msg -> checksum map is updated. Optional | |
1814 argument ORIGIN-MAP is a hashtable which maps each message in the | |
1815 index folder to the original folder and message from whence it | |
1816 was copied. If present the checksum -> (origin-folder, | |
1817 origin-index) map is updated too." | |
1818 (clrhash mh-index-msg-checksum-map) | |
1819 (save-excursion | |
1820 ;; Clear temp buffer | |
1821 (set-buffer (get-buffer-create mh-temp-checksum-buffer)) | |
1822 (erase-buffer) | |
1823 ;; Run scan to check if any messages needs MD5 annotations at all | |
1824 (with-temp-buffer | |
1825 (mh-exec-cmd-output mh-scan-prog nil "-width" "80" | |
1826 "-format" "%(msg)\n%{x-mhe-checksum}\n" | |
1827 folder "all") | |
1828 (goto-char (point-min)) | |
1829 (let (msg checksum) | |
1830 (while (not (eobp)) | |
1831 (setq msg (buffer-substring-no-properties | |
1832 (point) (line-end-position))) | |
1833 (forward-line) | |
1834 (save-excursion | |
1835 (cond ((not (string-match "^[0-9]*$" msg))) | |
1836 ((eolp) | |
1837 ;; need to compute checksum | |
1838 (set-buffer mh-temp-checksum-buffer) | |
1839 (insert mh-user-path (substring folder 1) "/" msg "\n")) | |
1840 (t | |
1841 ;; update maps | |
1842 (setq checksum (buffer-substring-no-properties | |
1843 (point) (line-end-position))) | |
1844 (let ((msg (car (read-from-string msg)))) | |
1845 (set-buffer folder) | |
1846 (mh-index-update-single-msg msg checksum origin-map))))) | |
1847 (forward-line)))) | |
1848 ;; Run checksum program if needed | |
1849 (unless (and (eobp) (bobp)) | |
1850 (apply #'mh-xargs mh-checksum-cmd) | |
1851 (goto-char (point-min)) | |
1852 (while (not (eobp)) | |
1853 (let* ((intermediate (funcall mh-checksum-parser)) | |
1854 (msg (car intermediate)) | |
1855 (checksum (cdr intermediate))) | |
1856 (when msg | |
1857 ;; annotate | |
1858 (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum" | |
1859 "-nodate" "-text" checksum "-inplace") | |
1860 ;; update maps | |
1861 (save-excursion | |
1862 (set-buffer folder) | |
1863 (mh-index-update-single-msg msg checksum origin-map))) | |
1864 (forward-line))))) | |
1865 (mh-index-write-data)) | |
1866 | |
1867 (defun mh-index-update-single-msg (msg checksum origin-map) | |
1868 "Update various maps for one message. | |
1869 MSG is a index folder message, CHECKSUM its MD5 hash and | |
1870 ORIGIN-MAP, if non-nil, a hashtable containing which maps each | |
1871 message in the index folder to the folder and message that it was | |
1872 copied from. The function updates the hash tables | |
1873 `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'. | |
1874 | |
1875 This function should only be called in the appropriate index | |
1876 folder buffer." | |
1877 (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map)) | |
1878 (let* ((intermediate (gethash msg origin-map)) | |
1879 (ofolder (car intermediate)) | |
1880 (omsg (cdr intermediate))) | |
1881 ;; This is most probably a duplicate. So eliminate it. | |
1882 (call-process "rm" nil nil nil | |
1883 (format "%s%s/%s" mh-user-path | |
1884 (substring mh-current-folder 1) msg)) | |
1885 (when (gethash ofolder mh-index-data) | |
1886 (remhash omsg (gethash ofolder mh-index-data))))) | |
1887 (t | |
1888 (setf (gethash msg mh-index-msg-checksum-map) checksum) | |
1889 (when origin-map | |
1890 (setf (gethash checksum mh-index-checksum-origin-map) | |
1891 (gethash msg origin-map)))))) | |
1892 | |
1893 (provide 'mh-search) | |
1894 | |
1895 ;; Local Variables: | |
1896 ;; indent-tabs-mode: nil | |
1897 ;; sentence-end-double-space: nil | |
1898 ;; End: | |
1899 | |
1900 ;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47 | |
1901 ;;; mh-search ends here |