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 |