code.delx.au - gnu-emacs/blob - lisp/mh-e/mh-search.el

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