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