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

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