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

   1 ;;; mh-index  --  MH-E interface to indexing programs
   2
   3 ;; Copyright (C) 2002 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 ;;;        namazu
  33 ;;;        glimpse
  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 ;; $Id: mh-index.el,v 1.73 2003/01/07 21:15:49 satyaki Exp $
  44
  45 ;;; Code:
  46
  47 (require 'cl)
  48 (require 'mh-e)
  49 (require 'mh-mime)
  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     (swish
  61      mh-swish-binary mh-swish-execute-search mh-swish-next-result)
  62     (namazu
  63      mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result)
  64     (glimpse
  65      mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result)
  66     (grep
  67      mh-grep-binary mh-grep-execute-search mh-grep-next-result))
  68   "List of possible indexer choices.")
  69 (defvar mh-indexer nil
  70   "Chosen index program.")
  71 (defvar mh-index-execute-search-function nil
  72   "Function which executes the search program.")
  73 (defvar mh-index-next-result-function nil
  74   "Function to parse the next line of output.")
  75
  76 ;; FIXME: This should be a defcustom...
  77 (defvar mh-index-folder "+mhe-index"
  78   "Folder that contains the folders resulting from the index searches.")
  79
  80 ;; Temporary buffers for search results
  81 (defvar mh-index-temp-buffer " *mh-index-temp*")
  82 (defvar mh-checksum-buffer " *mh-checksum-buffer*")
  83
  84 \f
  85
  86 ;;; A few different checksum programs are supported. The supported programs
  87 ;;; are:
  88 ;;;   1. md5sum
  89 ;;;   2. md5
  90 ;;;   3. openssl
  91 ;;;
  92 ;;; To add support for your favorite checksum program add a clause to the cond
  93 ;;; statement in mh-checksum-choose. This should set the variable
  94 ;;; mh-checksum-cmd to the command line needed to run the checsum program and
  95 ;;; should set mh-checksum-parser to a function which returns a cons cell
  96 ;;; containing the message number and checksum string.
  97
  98 (defvar mh-checksum-cmd)
  99 (defvar mh-checksum-parser)
 100
 101 (defun mh-checksum-choose ()
 102   "Check if a program to create a checksum is present."
 103   (unless (boundp 'mh-checksum-cmd)
 104     (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
 105       (cond ((executable-find "md5sum")
 106              (setq mh-checksum-cmd (list (executable-find "md5sum")))
 107              (setq mh-checksum-parser #'mh-md5sum-parser))
 108             ((executable-find "openssl")
 109              (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
 110              (setq mh-checksum-parser #'mh-openssl-parser))
 111             ((executable-find "md5")
 112              (setq mh-checksum-cmd (list (executable-find "md5")))
 113              (setq mh-checksum-parser #'mh-md5-parser))
 114             (t (error "No suitable checksum program"))))))
 115
 116 (defun mh-md5sum-parser ()
 117   "Parse md5sum output."
 118   (let ((begin (line-beginning-position))
 119         (end (line-end-position))
 120         first-space last-slash)
 121     (setq first-space (search-forward " " end t))
 122     (goto-char end)
 123     (setq last-slash (search-backward "/" begin t))
 124     (cond ((and first-space last-slash)
 125            (cons (car (read-from-string (buffer-substring-no-properties
 126                                          (1+ last-slash) end)))
 127                  (buffer-substring-no-properties begin (1- first-space))))
 128           (t (cons nil nil)))))
 129
 130 (defun mh-openssl-parser ()
 131   "Parse openssl output."
 132   (let ((begin (line-beginning-position))
 133         (end (line-end-position))
 134         last-space last-slash)
 135     (goto-char end)
 136     (setq last-space (search-backward " " begin t))
 137     (setq last-slash (search-backward "/" begin t))
 138     (cond ((and last-slash last-space)
 139            (cons (car (read-from-string (buffer-substring-no-properties
 140                                          (1+ last-slash) (1- last-space))))
 141                  (buffer-substring-no-properties (1+ last-space) end))))))
 142
 143 (defalias 'mh-md5-parser 'mh-openssl-parser)
 144
 145 \f
 146
 147 ;;; Make sure that we don't produce too long a command line.
 148
 149 (defvar mh-index-max-cmdline-args 500
 150   "Maximum number of command line args.")
 151
 152 (defun mh-index-execute (cmd &rest args)
 153   "Partial imitation of xargs.
 154 The current buffer contains a list of strings, one on each line. The function
 155 will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
 156 strings to it. This is repeated till all the strings have been used."
 157   (goto-char (point-min))
 158   (let ((out (get-buffer-create " *mh-xargs-output*")))
 159     (save-excursion
 160       (set-buffer out)
 161       (erase-buffer))
 162     (while (not (eobp))
 163       (let ((arg-list (reverse args))
 164             (count 0))
 165         (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
 166           (push (buffer-substring-no-properties (point) (line-end-position))
 167                 arg-list)
 168           (incf count)
 169           (forward-line))
 170         (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
 171     (erase-buffer)
 172     (insert-buffer-substring out)))
 173
 174 \f
 175
 176 (defun mh-index-update-single-msg (msg checksum origin-map)
 177   "Update various maps for one message.
 178 MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
 179 non-nil, a hashtable containing which maps each message in the index folder to
 180 the folder and message that it was copied from. The function updates the hash
 181 tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
 182
 183 This function should only be called in the appropriate index folder buffer."
 184   (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
 185          (let* ((intermediate (gethash msg origin-map))
 186                 (ofolder (car intermediate))
 187                 (omsg (cdr intermediate)))
 188            ;; This is most probably a duplicate. So eliminate it.
 189            (call-process "rm" nil nil nil
 190                          (format "%s%s/%s" mh-user-path
 191                                  (substring mh-current-folder 1) msg))
 192            (remhash omsg (gethash ofolder mh-index-data))))
 193         (t
 194          (setf (gethash msg mh-index-msg-checksum-map) checksum)
 195          (when origin-map
 196            (setf (gethash checksum mh-index-checksum-origin-map)
 197                  (gethash msg origin-map))))))
 198
 199 ;;;###mh-autoload
 200 (defun mh-index-update-maps (folder &optional origin-map)
 201   "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
 202 As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
 203 is a hashtable which maps each message in the index folder to the original
 204 folder and message from whence it was copied. If present the
 205 checksum -> (origin-folder, origin-index) map is updated too."
 206   (clrhash mh-index-msg-checksum-map)
 207   (save-excursion
 208     ;; Clear temp buffer
 209     (set-buffer (get-buffer-create mh-checksum-buffer))
 210     (erase-buffer)
 211     ;; Run scan to check if any messages needs MD5 annotations at all
 212     (with-temp-buffer
 213       (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
 214                           "-format" "%(msg)\n%{x-mhe-checksum}\n"
 215                           folder "all")
 216       (goto-char (point-min))
 217       (let (msg checksum)
 218         (while (not (eobp))
 219           (setq msg (buffer-substring-no-properties
 220                      (point) (line-end-position)))
 221           (forward-line)
 222           (save-excursion
 223             (cond ((eolp)
 224                    ;; need to compute checksum
 225                    (set-buffer mh-checksum-buffer)
 226                    (insert mh-user-path (substring folder 1) "/" msg "\n"))
 227                   (t
 228                    ;; update maps
 229                    (setq checksum (buffer-substring-no-properties
 230                                    (point) (line-end-position)))
 231                    (let ((msg (car (read-from-string msg))))
 232                      (set-buffer folder)
 233                      (mh-index-update-single-msg msg checksum origin-map)))))
 234           (forward-line))))
 235     ;; Run checksum program if needed
 236     (unless (and (eobp) (bobp))
 237       (apply #'mh-index-execute mh-checksum-cmd)
 238       (goto-char (point-min))
 239       (while (not (eobp))
 240         (let* ((intermediate (funcall mh-checksum-parser))
 241                (msg (car intermediate))
 242                (checksum (cdr intermediate)))
 243           (when msg
 244             ;; annotate
 245             (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
 246                          "-nodate" "-text" checksum "-inplace")
 247             ;; update maps
 248             (save-excursion
 249               (set-buffer folder)
 250               (mh-index-update-single-msg msg checksum origin-map)))
 251           (forward-line))))))
 252
 253 (defun mh-index-generate-pretty-name (string)
 254   "Given STRING generate a name which is suitable for use as a folder name.
 255 White space from the beginning and end are removed. All spaces in the name are
 256 replaced with underscores and all / are replaced with $. If STRING is longer
 257 than 20 it is truncated too."
 258   (with-temp-buffer
 259     (insert string)
 260     (goto-char (point-min))
 261     (while (and (not (eobp)) (memq (char-after) '(?  ?\t ?\n ?\r)))
 262       (delete-char 1))
 263     (goto-char (point-max))
 264     (while (and (not (bobp)) (memq (char-before) '(?  ?\t ?\n ?\r)))
 265       (delete-backward-char 1))
 266     (subst-char-in-region (point-min) (point-max) ? ?_ t)
 267     (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
 268     (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
 269     (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
 270     (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
 271     (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
 272
 273 ;;;###mh-autoload
 274 (defun mh-index-search (redo-search-flag folder search-regexp)
 275   "Perform an indexed search in an MH mail folder.
 276
 277 If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
 278 index search, then the search is repeated. Otherwise, FOLDER is searched with
 279 SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
 280 \"+\" then mail in all folders are searched.
 281
 282 Four indexing programs are supported; if none of these are present, then grep
 283 is used. This function picks the first program that is available on your
 284 system. If you would prefer to use a different program, set the customization
 285 variable `mh-index-program' accordingly.
 286
 287 The documentation for the following functions describes how to generate the
 288 index for each program:
 289
 290     - `mh-swish++-execute-search'
 291     - `mh-swish-execute-search'
 292     - `mh-namazu-execute-search'
 293     - `mh-glimpse-execute-search'
 294
 295 This and related functions use an X-MHE-Checksum header to cache the MD5
 296 checksum of a message. This means that already present X-MHE-Checksum headers
 297 in the incoming email could result in messages not being found. The following
 298 procmail recipe should avoid this:
 299
 300   :0 wf
 301   | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
 302
 303 This has the effect of renaming already present X-MHE-Checksum headers."
 304   (interactive
 305    (list current-prefix-arg
 306          (progn
 307            (unless mh-find-path-run (mh-find-path))
 308            (or (and current-prefix-arg (car mh-index-previous-search))
 309                (mh-prompt-for-folder "Search" "+" nil "all")))
 310          (progn
 311            ;; Yes, we do want to call mh-index-choose every time in case the
 312            ;; user has switched the indexer manually.
 313            (unless (mh-index-choose) (error "No indexing program found"))
 314            (or (and current-prefix-arg (cadr mh-index-previous-search))
 315                (read-string (format "%s regexp: "
 316                                     (upcase-initials
 317                                      (symbol-name mh-indexer))))))))
 318   (mh-checksum-choose)
 319   (let ((result-count 0)
 320         (old-window-config mh-previous-window-config)
 321         (previous-search mh-index-previous-search)
 322         (index-folder (format "%s/%s" mh-index-folder
 323                               (mh-index-generate-pretty-name search-regexp))))
 324     ;; Create a new folder for the search results or recreate the old one...
 325     (if (and redo-search-flag mh-index-previous-search)
 326         (let ((buffer-name (buffer-name (current-buffer))))
 327           (mh-process-or-undo-commands buffer-name)
 328           (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
 329           (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
 330           (setq index-folder buffer-name))
 331       (setq index-folder (mh-index-new-folder index-folder)))
 332
 333     (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
 334           (folder-results-map (make-hash-table :test #'equal))
 335           (origin-map (make-hash-table :test #'equal)))
 336       ;; Run search program...
 337       (message "Executing %s... " mh-indexer)
 338       (funcall mh-index-execute-search-function folder-path search-regexp)
 339
 340       ;; Parse indexer output
 341       (message "Processing %s output... " mh-indexer)
 342       (goto-char (point-min))
 343       (loop for next-result = (funcall mh-index-next-result-function)
 344             when (null next-result) return nil
 345             do (unless (eq next-result 'error)
 346                  (unless (gethash (car next-result) folder-results-map)
 347                    (setf (gethash (car next-result) folder-results-map)
 348                          (make-hash-table :test #'equal)))
 349                  (setf (gethash (cadr next-result)
 350                                 (gethash (car next-result) folder-results-map))
 351                        t)))
 352
 353       ;; Copy the search results over
 354       (maphash #'(lambda (folder msgs)
 355                    (let ((msgs (sort (loop for msg being the hash-keys of msgs
 356                                            collect msg)
 357                                      #'<)))
 358                      (mh-exec-cmd "refile" msgs "-src" folder
 359                                   "-link" index-folder)
 360                      (loop for msg in msgs
 361                            do (incf result-count)
 362                            (setf (gethash result-count origin-map)
 363                                  (cons folder msg)))))
 364                folder-results-map)
 365
 366       ;; Generate scan lines for the hits.
 367       (let ((mh-show-threads-flag nil))
 368         (mh-visit-folder index-folder () (list folder-results-map origin-map)))
 369
 370       (goto-char (point-min))
 371       (forward-line)
 372       (mh-update-sequences)
 373       (mh-recenter nil)
 374
 375       ;; Maintain history
 376       (when (and redo-search-flag previous-search)
 377         (setq mh-previous-window-config old-window-config))
 378       (setq mh-index-previous-search (list folder search-regexp))
 379
 380       (message "%s found %s matches in %s folders"
 381                (upcase-initials (symbol-name mh-indexer))
 382                (loop for msg-hash being hash-values of mh-index-data
 383                      sum (hash-table-count msg-hash))
 384                (loop for msg-hash being hash-values of mh-index-data
 385                      count (> (hash-table-count msg-hash) 0))))))
 386
 387 ;;;###mh-autoload
 388 (defun mh-index-next-folder (&optional backward-flag)
 389   "Jump to the next folder marker.
 390 The function is only applicable to folders displaying index search results.
 391 With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
 392 results."
 393   (interactive "P")
 394   (if (or (null mh-index-data)
 395           (memq 'unthread mh-view-ops))
 396       (message "Only applicable in an unthreaded MH-E index search buffer")
 397     (let ((point (point)))
 398       (forward-line (if backward-flag -1 1))
 399       (cond ((if backward-flag
 400                  (re-search-backward "^+" (point-min) t)
 401                (re-search-forward "^+" (point-max) t))
 402              (beginning-of-line))
 403             ((and (if backward-flag
 404                       (goto-char (point-max))
 405                     (goto-char (point-min)))
 406                   nil))
 407             ((if backward-flag
 408                  (re-search-backward "^+" (point-min) t)
 409                (re-search-forward "^+" (point-max) t))
 410              (beginning-of-line))
 411             (t (goto-char point))))))
 412
 413 ;;;###mh-autoload
 414 (defun mh-index-previous-folder ()
 415   "Jump to the previous folder marker."
 416   (interactive)
 417   (mh-index-next-folder t))
 418
 419 (defun mh-folder-exists-p (folder)
 420   "Check if FOLDER exists."
 421   (and (mh-folder-name-p folder)
 422        (save-excursion
 423          (with-temp-buffer
 424            (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
 425            (goto-char (point-min))
 426            (not (eobp))))))
 427
 428 (defun mh-msg-exists-p (msg folder)
 429   "Check if MSG exists in FOLDER."
 430   (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
 431
 432 (defun mh-index-new-folder (name)
 433   "Create and return an MH folder name based on NAME.
 434 If the folder NAME already exists then check if NAME<2> exists. If it doesn't
 435 then it is created and returned. Otherwise try NAME<3>. This is repeated till
 436 we find a new folder name."
 437   (unless (mh-folder-name-p name)
 438     (error "The argument should be a valid MH folder name"))
 439   (let ((chosen-name name))
 440     (block unique-name
 441       (unless (mh-folder-exists-p name)
 442         (return-from unique-name))
 443       (loop for index from 2
 444             do (let ((new-name (format "%s<%s>" name index)))
 445                  (unless (mh-folder-exists-p new-name)
 446                    (setq chosen-name new-name)
 447                    (return-from unique-name)))))
 448     (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
 449     (when (boundp 'mh-speed-folder-map)
 450       (mh-speed-add-folder chosen-name))
 451     (push (list chosen-name) mh-folder-list)
 452     chosen-name))
 453
 454 ;;;###mh-autoload
 455 (defun mh-index-insert-folder-headers ()
 456   "Annotate the search results with original folder names."
 457   (let ((cur-msg (mh-get-msg-num nil))
 458         (old-buffer-modified-flag (buffer-modified-p))
 459         (buffer-read-only nil)
 460         current-folder last-folder)
 461     (goto-char (point-min))
 462     (while (not (eobp))
 463       (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
 464                                                   mh-index-msg-checksum-map)
 465                                          mh-index-checksum-origin-map)))
 466       (when (and current-folder (not (eq current-folder last-folder)))
 467         (insert (if last-folder "\n" "") current-folder "\n")
 468         (setq last-folder current-folder))
 469       (forward-line))
 470     (when cur-msg (mh-goto-msg cur-msg t))
 471     (set-buffer-modified-p old-buffer-modified-flag)))
 472
 473 ;;;###mh-autoload
 474 (defun mh-index-delete-folder-headers ()
 475   "Delete the folder headers."
 476   (let ((cur-msg (mh-get-msg-num nil))
 477         (old-buffer-modified-flag (buffer-modified-p))
 478         (buffer-read-only nil))
 479     (goto-char (point-min))
 480     (while (not (eobp))
 481       (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
 482           (delete-region (point) (progn (forward-line) (point)))
 483         (forward-line)))
 484     (when cur-msg (mh-goto-msg cur-msg t t))
 485     (set-buffer-modified-p old-buffer-modified-flag)))
 486
 487 ;;;###mh-autoload
 488 (defun mh-index-visit-folder ()
 489   "Visit original folder from where the message at point was found."
 490   (interactive)
 491   (unless mh-index-data
 492     (error "Not in an index folder"))
 493   (let (folder msg)
 494     (save-excursion
 495       (cond ((and (bolp) (eolp))
 496              (ignore-errors (forward-line -1))
 497              (setq msg (mh-get-msg-num t)))
 498             ((equal (char-after (line-beginning-position)) ?+)
 499              (setq folder (buffer-substring-no-properties
 500                            (line-beginning-position) (line-end-position))))
 501             (t (setq msg (mh-get-msg-num t)))))
 502     (when (not folder)
 503       (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
 504                                  mh-index-checksum-origin-map))))
 505     (mh-visit-folder
 506      folder (loop for x being the hash-keys of (gethash folder mh-index-data)
 507                   when (mh-msg-exists-p x folder) collect x))))
 508
 509 (defun mh-index-match-checksum (msg folder checksum)
 510   "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
 511   (with-temp-buffer
 512     (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
 513                         "-format" "%{x-mhe-checksum}\n" folder msg)
 514     (goto-char (point-min))
 515     (string-equal (buffer-substring-no-properties (point) (line-end-position))
 516                   checksum)))
 517
 518 ;;;###mh-autoload
 519 (defun mh-index-execute-commands ()
 520   "Delete/refile the actual messages.
 521 The copies in the searched folder are then deleted/refiled to get the desired
 522 result. Before deleting the messages we make sure that the message being
 523 deleted is identical to the one that the user has marked in the index buffer."
 524   (let ((message-table (make-hash-table :test #'equal)))
 525     (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
 526       (dolist (msg msg-list)
 527         (let* ((checksum (gethash msg mh-index-msg-checksum-map))
 528                (pair (gethash checksum mh-index-checksum-origin-map)))
 529           (when (and checksum (car pair) (cdr pair)
 530                      (mh-index-match-checksum (cdr pair) (car pair) checksum))
 531             (push (cdr pair) (gethash (car pair) message-table))
 532             (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
 533     (maphash (lambda (folder msgs)
 534                (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
 535              message-table)))
 536
 537 \f
 538
 539 ;; Glimpse interface
 540
 541 (defvar mh-glimpse-binary (executable-find "glimpse"))
 542 (defvar mh-glimpse-directory ".glimpse")
 543
 544 ;;;###mh-autoload
 545 (defun mh-glimpse-execute-search (folder-path search-regexp)
 546   "Execute glimpse and read the results.
 547
 548 In the examples below, replace /home/user/Mail with the path to your MH
 549 directory.
 550
 551 First create the directory /home/user/Mail/.glimpse. Then create the file
 552 /home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
 553
 554     */.*
 555     */#*
 556     */,*
 557     */*~
 558     ^/home/user/Mail/.glimpse
 559     ^/home/user/Mail/mhe-index
 560
 561 If there are any directories you would like to ignore, append lines like the
 562 following to .glimpse_exclude:
 563
 564     ^/home/user/Mail/scripts
 565
 566 You do not want to index the folders that hold the results of your searches
 567 since they tend to be ephemeral and the original messages are indexed anyway.
 568 The configuration file above assumes that the results are found in sub-folders
 569 of `mh-index-folder' which is +mhe-index by default.
 570
 571 Use the following command line to generate the glimpse index. Run this
 572 daily from cron:
 573
 574     glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
 575
 576 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 577   (set-buffer (get-buffer-create mh-index-temp-buffer))
 578   (erase-buffer)
 579   (call-process mh-glimpse-binary nil '(t nil) nil
 580                                         ;(format "-%s" fuzz)
 581                 "-i" "-y"
 582                 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
 583                 "-F" (format "^%s" folder-path)
 584                 search-regexp)
 585   (goto-char (point-min)))
 586
 587 (defun mh-glimpse-next-result ()
 588   "Read the next result.
 589 Parse it and return the message folder, message index and the match. If no
 590 other matches left then return nil. If the current record is invalid return
 591 'error."
 592   (prog1
 593       (block nil
 594         (when (eobp)
 595           (return nil))
 596         (let ((eol-pos (line-end-position))
 597               (bol-pos (line-beginning-position))
 598               folder-start msg-end)
 599           (goto-char bol-pos)
 600           (unless (search-forward mh-user-path eol-pos t)
 601             (return 'error))
 602           (setq folder-start (point))
 603           (unless (search-forward ": " eol-pos t)
 604             (return 'error))
 605           (let ((match (buffer-substring-no-properties (point) eol-pos)))
 606             (forward-char -2)
 607             (setq msg-end (point))
 608             (unless (search-backward "/" folder-start t)
 609               (return 'error))
 610             (list (format "+%s" (buffer-substring-no-properties
 611                                  folder-start (point)))
 612                   (let ((val (ignore-errors (read-from-string
 613                                              (buffer-substring-no-properties
 614                                               (1+ (point)) msg-end)))))
 615                     (if (and (consp val) (integerp (car val)))
 616                         (car val)
 617                       (return 'error)))
 618                   match))))
 619     (forward-line)))
 620
 621 \f
 622
 623 ;; Grep interface
 624
 625 (defvar mh-grep-binary (executable-find "grep"))
 626
 627 (defun mh-grep-execute-search (folder-path search-regexp)
 628   "Execute grep and read the results.
 629 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 630   (set-buffer (get-buffer-create mh-index-temp-buffer))
 631   (erase-buffer)
 632   (call-process mh-grep-binary nil '(t nil) nil
 633                 "-i" "-r" search-regexp folder-path)
 634   (goto-char (point-min)))
 635
 636 (defun mh-grep-next-result ()
 637   "Read the next result.
 638 Parse it and return the message folder, message index and the match. If no
 639 other matches left then return nil. If the current record is invalid return
 640 'error."
 641   (prog1
 642       (block nil
 643         (when (eobp)
 644           (return nil))
 645         (let ((eol-pos (line-end-position))
 646               (bol-pos (line-beginning-position))
 647               folder-start msg-end)
 648           (goto-char bol-pos)
 649           (unless (search-forward mh-user-path eol-pos t)
 650             (return 'error))
 651           (setq folder-start (point))
 652           (unless (search-forward ":" eol-pos t)
 653             (return 'error))
 654           (let ((match (buffer-substring-no-properties (point) eol-pos)))
 655             (forward-char -1)
 656             (setq msg-end (point))
 657             (unless (search-backward "/" folder-start t)
 658               (return 'error))
 659             (list (format "+%s" (buffer-substring-no-properties
 660                                  folder-start (point)))
 661                   (let ((val (ignore-errors (read-from-string
 662                                              (buffer-substring-no-properties
 663                                               (1+ (point)) msg-end)))))
 664                     (if (and (consp val) (integerp (car val)))
 665                         (car val)
 666                       (return 'error)))
 667                   match))))
 668     (forward-line)))
 669
 670 \f
 671
 672 ;; Swish interface
 673
 674 (defvar mh-swish-binary (executable-find "swish-e"))
 675 (defvar mh-swish-directory ".swish")
 676 (defvar mh-swish-folder nil)
 677
 678 ;;;###mh-autoload
 679 (defun mh-swish-execute-search (folder-path search-regexp)
 680   "Execute swish-e and read the results.
 681
 682 In the examples below, replace /home/user/Mail with the path to your MH
 683 directory.
 684
 685 First create the directory /home/user/Mail/.swish. Then create the file
 686 /home/user/Mail/.swish/config with the following contents:
 687
 688     IndexDir /home/user/Mail
 689     IndexFile /home/user/Mail/.swish/index
 690     IndexName \"Mail Index\"
 691     IndexDescription \"Mail Index\"
 692     IndexPointer \"http://nowhere\"
 693     IndexAdmin \"nobody\"
 694     #MetaNames automatic
 695     IndexReport 3
 696     FollowSymLinks no
 697     UseStemming no
 698     IgnoreTotalWordCountWhenRanking yes
 699     WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
 700     BeginCharacters abcdefghijklmnopqrstuvwxyz
 701     EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
 702     IgnoreLimit 50 1000
 703     IndexComments 0
 704     FileRules pathname contains /home/user/Mail/.swish
 705     FileRules pathname contains /home/user/Mail/mhe-index
 706     FileRules filename is index
 707     FileRules filename is \..*
 708     FileRules filename is #.*
 709     FileRules filename is ,.*
 710     FileRules filename is .*~
 711
 712 If there are any directories you would like to ignore, append lines like the
 713 following to config:
 714
 715     FileRules pathname contains /home/user/Mail/scripts
 716
 717 You do not want to index the folders that hold the results of your searches
 718 since they tend to be ephemeral and the original messages are indexed anyway.
 719 The configuration file above assumes that the results are found in sub-folders
 720 of `mh-index-folder' which is +mhe-index by default.
 721
 722 Use the following command line to generate the swish index. Run this
 723 daily from cron:
 724
 725     swish-e -c /home/user/Mail/.swish/config
 726
 727 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 728   (set-buffer (get-buffer-create mh-index-temp-buffer))
 729   (erase-buffer)
 730   (unless mh-swish-binary
 731     (error "Set mh-swish-binary appropriately"))
 732   (call-process mh-swish-binary nil '(t nil) nil
 733                 "-w" search-regexp
 734                 "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
 735   (goto-char (point-min))
 736   (setq mh-swish-folder
 737         (let ((last-char (substring folder-path (1- (length folder-path)))))
 738           (if (equal last-char "/")
 739               folder-path
 740             (format "%s/" folder-path)))))
 741
 742 (defun mh-swish-next-result ()
 743   "Get the next result from swish output."
 744   (prog1
 745       (block nil
 746         (when (or (eobp) (equal (char-after (point)) ?.))
 747           (return nil))
 748         (when (equal (char-after (point)) ?#)
 749           (return 'error))
 750         (let* ((start (search-forward " " (line-end-position) t))
 751                (end (search-forward " " (line-end-position) t)))
 752           (unless (and start end)
 753             (return 'error))
 754           (setq end (1- end))
 755           (unless (file-exists-p (buffer-substring-no-properties start end))
 756             (return 'error))
 757           (unless (search-backward "/" start t)
 758             (return 'error))
 759           (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
 760                   (unless (string-match mh-swish-folder s)
 761                     (return 'error))
 762                   (if (string-match mh-user-path s)
 763                       (format "+%s"
 764                               (substring s (match-end 0) (1- (length s))))
 765                     (return 'error)))
 766                 (let* ((s (buffer-substring-no-properties (1+ (point)) end))
 767                        (val (ignore-errors (read-from-string s))))
 768                   (if (and (consp val) (numberp (car val)))
 769                       (car val)
 770                     (return 'error)))
 771                 nil)))
 772     (forward-line)))
 773
 774 \f
 775
 776 ;; Swish++ interface
 777
 778 (defvar mh-swish++-binary (or (executable-find "search++")
 779                               (executable-find "search")))
 780 (defvar mh-swish++-directory ".swish++")
 781
 782 ;;;###mh-autoload
 783 (defun mh-swish++-execute-search (folder-path search-regexp)
 784   "Execute swish++ and read the results.
 785
 786 In the examples below, replace /home/user/Mail with the path to your MH
 787 directory.
 788
 789 First create the directory /home/user/Mail/.swish++. Then create the file
 790 /home/user/Mail/.swish++/swish++.conf with the following contents:
 791
 792     IncludeMeta         Bcc Cc Comments Content-Description From Keywords
 793     IncludeMeta         Newsgroups Resent-To Subject To
 794     IncludeMeta         Message-Id References In-Reply-To
 795     IncludeFile         Mail    *
 796     IndexFile           /home/user/Mail/.swish++/swish++.index
 797
 798 Use the following command line to generate the swish index. Run this
 799 daily from cron:
 800
 801  find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
 802                    -o -path /home/user/Mail/.swish++ -prune \\
 803                    -o -name \"[0-9]*\" -print \\
 804     | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
 805
 806 You do not want to index the folders that hold the results of your searches
 807 since they tend to be ephemeral and the original messages are indexed anyway.
 808 The command above assumes that the results are found in sub-folders of
 809 `mh-index-folder' which is +mhe-index by default.
 810
 811 On some systems (Debian GNU/Linux, for example), use index++ instead of index.
 812
 813 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 814   (set-buffer (get-buffer-create mh-index-temp-buffer))
 815   (erase-buffer)
 816   (unless mh-swish++-binary
 817     (error "Set mh-swish++-binary appropriately"))
 818   (call-process mh-swish++-binary nil '(t nil) nil
 819                 "-m" "10000"
 820                 (format "-i%s%s/swish++.index"
 821                         mh-user-path mh-swish++-directory)
 822                 search-regexp)
 823   (goto-char (point-min))
 824   (setq mh-swish-folder
 825         (let ((last-char (substring folder-path (1- (length folder-path)))))
 826           (if (equal last-char "/")
 827               folder-path
 828             (format "%s/" folder-path)))))
 829
 830 (defalias 'mh-swish++-next-result 'mh-swish-next-result)
 831
 832 \f
 833
 834 ;; Namazu interface
 835
 836 (defvar mh-namazu-binary (executable-find "namazu"))
 837 (defvar mh-namazu-directory ".namazu")
 838 (defvar mh-namazu-folder nil)
 839
 840 ;;;###mh-autoload
 841 (defun mh-namazu-execute-search (folder-path search-regexp)
 842   "Execute namazu and read the results.
 843
 844 In the examples below, replace /home/user/Mail with the path to your MH
 845 directory.
 846
 847 First create the directory /home/user/Mail/.namazu. Then create the file
 848 /home/user/Mail/.namazu/mknmzrc with the following contents:
 849
 850     package conf;  # Don't remove this line!
 851     $ADDRESS = 'user@localhost';
 852     $ALLOW_FILE = \"[0-9]*\";
 853     $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
 854
 855 In the above example configuration, none of the mail files contained in the
 856 directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
 857
 858 You do not want to index the folders that hold the results of your searches
 859 since they tend to be ephemeral and the original messages are indexed anyway.
 860 The configuration file above assumes that the results are found in sub-folders
 861 of `mh-index-folder' which is +mhe-index by default.
 862
 863 Use the following command line to generate the namazu index. Run this
 864 daily from cron:
 865
 866    mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
 867          /home/user/Mail
 868
 869 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 870   (let ((namazu-index-directory
 871          (format "%s%s" mh-user-path mh-namazu-directory)))
 872     (unless (file-exists-p namazu-index-directory)
 873       (error "Namazu directory %s not present" namazu-index-directory))
 874     (unless (executable-find mh-namazu-binary)
 875       (error "Set mh-namazu-binary appropriately"))
 876     (set-buffer (get-buffer-create mh-index-temp-buffer))
 877     (erase-buffer)
 878     (call-process mh-namazu-binary nil '(t nil) nil
 879                   "-alR" search-regexp namazu-index-directory)
 880     (goto-char (point-min))
 881     (setq mh-namazu-folder
 882           (let ((last (substring folder-path (1- (length folder-path)))))
 883             (if (equal last "/")
 884                 folder-path
 885               (format "%s/" folder-path))))))
 886
 887 (defun mh-namazu-next-result ()
 888   "Get the next result from namazu output."
 889   (prog1
 890       (block nil
 891         (when (eobp) (return nil))
 892         (let ((file-name (buffer-substring-no-properties
 893                           (point) (line-end-position))))
 894           (unless (equal (string-match mh-namazu-folder file-name) 0)
 895             (return 'error))
 896           (unless (file-exists-p file-name)
 897             (return 'error))
 898           (string-match mh-user-path file-name)
 899           (let* ((folder/msg (substring file-name (match-end 0)))
 900                  (mark (mh-search-from-end ?/ folder/msg)))
 901             (unless mark (return 'error))
 902             (list (format "+%s" (substring folder/msg 0 mark))
 903                   (let ((n (ignore-errors (read-from-string
 904                                            (substring folder/msg (1+ mark))))))
 905                     (if (and (consp n) (numberp (car n)))
 906                         (car n)
 907                       (return 'error)))
 908                   nil))))
 909     (forward-line)))
 910
 911 \f
 912
 913 (defun mh-index-choose ()
 914   "Choose an indexing function.
 915 The side-effects of this function are that the variables `mh-indexer',
 916 `mh-index-execute-search-function', and `mh-index-next-result-function' are
 917 set according to the first indexer in `mh-indexer-choices' present on the
 918 system."
 919   (block nil
 920     ;; The following favors the user's preference; otherwise, the last
 921     ;; automatically chosen indexer is used for efficiency rather than going
 922     ;; through the list.
 923     (let ((program-alist (cond (mh-index-program
 924                                 (list
 925                                  (assoc mh-index-program mh-indexer-choices)))
 926                                (mh-indexer
 927                                 (list (assoc mh-indexer mh-indexer-choices)))
 928                                (t mh-indexer-choices))))
 929       (while program-alist
 930         (let* ((current (pop program-alist))
 931                (executable (symbol-value (cadr current))))
 932           (when executable
 933             (setq mh-indexer (car current))
 934             (setq mh-index-execute-search-function (caddr current))
 935             (setq mh-index-next-result-function (cadddr current))
 936             (return mh-indexer))))
 937       nil)))
 938
 939 \f
 940
 941 (provide 'mh-index)
 942
 943 ;;; Local Variables:
 944 ;;; indent-tabs-mode: nil
 945 ;;; sentence-end-double-space: nil
 946 ;;; End:
 947
 948 ;;; mh-index ends here