lisp/mh-e/mh-index.el

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