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: Bill Wohler <wohler@newt.com>
   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 ;;;  (3) Right now only viewing messages and moving between messages works in
  42 ;;;      the index buffer. With a little bit of work more stuff like
  43 ;;;      replying or forwarding messages can be done.
  44
  45 ;;; Change Log:
  46
  47 ;; $Id: mh-index.el,v 1.51 2002/11/13 18:43:57 satyaki Exp $
  48
  49 ;;; Code:
  50
  51 (require 'cl)
  52 (require 'mh-e)
  53 (require 'mh-mime)
  54
  55 ;; Shush the byte-compiler
  56 (defvar font-lock-defaults)
  57
  58 (autoload 'gnus-local-map-property "gnus-util")
  59 (autoload 'gnus-eval-format "gnus-spec")
  60 (autoload 'widget-convert-button "wid-edit")
  61 (autoload 'executable-find "executable")
  62
  63 ;;; User customizable
  64 (defcustom mh-index-program nil
  65   "Indexing program that MH-E shall use.
  66 The possible choices are swish++, swish-e, namazu, glimpse and grep. By
  67 default this variable is nil which means that the programs are tried in order
  68 and the first one found is used."
  69   :group 'mh
  70   :type '(choice (const :tag "auto-detect" nil)
  71                  (const :tag "swish++" swish++)
  72                  (const :tag "swish-e" swish)
  73                  (const :tag "namazu" namazu)
  74                  (const :tag "glimpse" glimpse)
  75                  (const :tag "grep" grep)))
  76
  77 ;;; Hooks
  78 (defcustom mh-index-show-hook nil
  79   "Invoked after the message has been displayed."
  80   :type 'hook
  81   :group 'mh-hook)
  82
  83 ;; Support different indexing programs
  84 (defvar mh-indexer-choices
  85   '((swish++
  86      mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result)
  87     (swish
  88      mh-swish-binary mh-swish-execute-search mh-swish-next-result)
  89     (namazu
  90      mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result)
  91     (glimpse
  92      mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result)
  93     (grep
  94      mh-grep-binary mh-grep-execute-search mh-grep-next-result))
  95   "List of possible indexer choices.")
  96 (defvar mh-indexer nil
  97   "Chosen index program.")
  98 (defvar mh-index-execute-search-function nil
  99   "Function which executes the search program.")
 100 (defvar mh-index-next-result-function nil
 101   "Function to parse the next line of output.")
 102
 103 ;; Names for the default mh-index-buffers...
 104 (defvar mh-index-buffer "*mh-index*")
 105 (defvar mh-index-show-buffer "*mh-index-show*")
 106
 107 ;; For use with adaptive size setting...
 108 (defvar mh-index-max-msg-index 0)
 109
 110 ;; Buffer locals to allow multiple concurrent search folders.
 111 (defvar mh-index-other-buffer nil
 112   "Keeps track of other buffer associated with current buffer.
 113 The value is the show buffer or the folder-buffer depending on whether we are
 114 in a folder buffer or show buffer respectively.")
 115 (defvar mh-index-matches nil
 116   "Map of folder to messages which match.")
 117 (defvar mh-index-previous-window-configuration nil
 118   "Keep track of previous window configuration that is restored on exit.")
 119 (defvar mh-index-current-msg nil
 120   "Message index of message being shown.")
 121
 122 ;; Make variables buffer local ...
 123 (make-variable-buffer-local 'mh-index-other-buffer)
 124 (make-variable-buffer-local 'mh-index-matches)
 125 (make-variable-buffer-local 'mh-index-previous-window-configuration)
 126 (make-variable-buffer-local 'mh-current-folder)
 127 (make-variable-buffer-local 'mh-index-current-msg)
 128
 129 ;; ... and arrange for them to not get slaughtered by a call to text-mode
 130 ;; (text-mode is called by mh-show-mode and mh-folder-mode).
 131 (put 'mh-index-other-buffer 'permanent-local t)
 132 (put 'mh-index-matches 'permanent-local t)
 133 (put 'mh-index-previous-window-configuration 'permanent-local t)
 134 (put 'mh-index-current-msg 'permanent-local t)
 135 (put 'mh-current-folder 'permanent-local t)
 136 (put 'mh-cmd-note 'permanent-local t)
 137
 138 ;; Temporary buffer where search results are output.
 139 (defvar mh-index-temp-buffer " *mh-index-temp*")
 140
 141 ;; Keymaps
 142
 143 ;; N.B. If this map were named mh-index-folder-mode-map, it would inherit the
 144 ;; keymap from mh-folder-mode. Since we want our own keymap, we tweak the name
 145 ;; to avoid this unwanted inheritance.
 146 (defvar mh-index-folder-mode-keymap (make-sparse-keymap)
 147   "Keymap for MH index folder.")
 148 (suppress-keymap mh-index-folder-mode-keymap)
 149 (gnus-define-keys mh-index-folder-mode-keymap
 150   " "           mh-index-page-msg
 151   ","           mh-index-header-display
 152   "."           mh-index-show
 153   [mouse-2]     mh-index-show
 154   "?"           mh-help
 155   "\177"        mh-index-previous-page
 156   "\M-\t"       mh-index-prev-button
 157   [backtab]     mh-index-prev-button
 158   "\r"          mh-index-show
 159   "\t"          mh-index-next-button
 160   "i"           mh-inc-folder
 161   "m"           mh-send                 ;alias
 162   "n"           mh-index-next
 163   "p"           mh-index-prev
 164   "q"           mh-index-quit
 165   "s"           mh-send)
 166
 167 (gnus-define-keys (mh-index-folder-map "F" mh-index-folder-mode-keymap)
 168   "?"           mh-prefix-help
 169   "f"           mh-visit-folder         ;alias
 170   "i"           mh-index-search-again
 171   "o"           mh-visit-folder         ;alias
 172   "v"           mh-visit-folder)
 173
 174 (defvar mh-index-button-map (make-sparse-keymap))
 175 (gnus-define-keys mh-index-button-map
 176   "\r"          mh-index-press-button)
 177
 178 \f
 179
 180 ;;; Help Messages
 181
 182 ;;; If you add a new prefix, add appropriate text to the nil key.
 183 ;;;
 184 ;;; In general, messages are grouped logically. Taking the main commands for
 185 ;;; example, the first line is "ways to view messages," the second line is
 186 ;;; "things you can do with messages", and the third is "composing" messages.
 187 ;;;
 188 ;;; When adding a new prefix, ensure that the help message contains "what" the
 189 ;;; prefix is for. For example, if the word "folder" were not present in the
 190 ;;; `F' entry, it would not be clear what these commands operated upon.
 191 (defvar mh-index-folder-mode-help-messages
 192   '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
 193          "[s]end, [q]uit")
 194     (?F "[v]isit folder; [i]ndexed search"))
 195   "Key binding cheat sheet.
 196
 197 This is an associative array which is used to show the most common commands.
 198 The key is a prefix char. The value is one or more strings which are
 199 concatenated together and displayed in the minibuffer if ? is pressed after
 200 the prefix character. The special key nil is used to display the
 201 non-prefixed commands.
 202
 203 The substitutions described in `substitute-command-keys' are performed as
 204 well.")
 205
 206 \f
 207
 208 (defun mh-index-search (folder search-regexp &optional new-buffer-flag)
 209   "Perform an indexed search in an MH mail folder.
 210
 211 FOLDER is searched with SEARCH-REGEXP and the results are presented in an MH-E
 212 folder. If FOLDER is \"+\" then mail in all folders are searched. Optional
 213 prefix argument NEW-BUFFER-FLAG decides whether the results are presented in a
 214 new buffer. This allows multiple search results to coexist.
 215
 216 Four indexing programs are supported; if none of these are present, then grep
 217 is used. This function picks the first program that is available on your
 218 system. If you would prefer to use a different program, set the customization
 219 variable `mh-index-program' accordingly.
 220
 221 The documentation for the following functions describes how to generate the
 222 index for each program:
 223
 224     - `mh-swish++-execute-search'
 225     - `mh-swish-execute-search'
 226     - `mh-namazu-execute-search'
 227     - `mh-glimpse-execute-search'"
 228   (interactive
 229    (list (progn
 230            (unless mh-find-path-run (mh-find-path))
 231            (mh-prompt-for-folder "Search" "+" nil "all"))
 232          (progn
 233            ;; Yes, we do want to call mh-index-choose every time in case the
 234            ;; user has switched the indexer manually.
 235            (unless (mh-index-choose) (error "No indexing program found"))
 236            (read-string (format "%s regexp: "
 237                                 (upcase-initials (symbol-name mh-indexer)))))
 238          current-prefix-arg))
 239   (setq mh-index-max-msg-index 0)
 240   (let ((config (current-window-configuration))
 241         (mh-index-buffer
 242           (cond (new-buffer-flag
 243                  (buffer-name (generate-new-buffer mh-index-buffer)))
 244                 ((and (eq major-mode 'mh-index-folder-mode))
 245                  (buffer-name (current-buffer)))
 246                 (t mh-index-buffer)))
 247         (mh-index-show-buffer
 248           (cond (new-buffer-flag
 249                  (buffer-name (generate-new-buffer mh-index-show-buffer)))
 250                 ((eq major-mode 'mh-index-folder-mode)
 251                  mh-index-other-buffer)
 252                 (t mh-index-show-buffer))))
 253     (when (buffer-live-p (get-buffer mh-index-show-buffer))
 254       (kill-buffer (get-buffer mh-index-show-buffer)))
 255     (get-buffer-create mh-index-buffer)
 256     (get-buffer-create mh-index-show-buffer)
 257     (save-excursion
 258       (set-buffer mh-index-buffer)
 259       (setq mh-index-other-buffer mh-index-show-buffer))
 260     (save-excursion
 261       (set-buffer mh-index-show-buffer)
 262       (setq mh-index-other-buffer mh-index-buffer))
 263     (set-buffer mh-index-buffer)
 264     (setq buffer-read-only nil)
 265     (erase-buffer)
 266     (let* ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
 267            (count 0)
 268            (folder-count 0)
 269            cur-folder last-folder cur-index last-index
 270            parse-results button-start button-end)
 271       (setq mh-index-matches (make-hash-table :test #'equal))
 272
 273       ;; Run search program...
 274       (message "%s searching... " (upcase-initials (symbol-name mh-indexer)))
 275       (funcall mh-index-execute-search-function folder-path search-regexp)
 276
 277       ;; Parse output and generate folder view
 278       (message "Processing %s output... " mh-indexer)
 279       (goto-char (point-min))
 280       (while (setq parse-results (funcall mh-index-next-result-function))
 281         (unless (eq parse-results 'error)
 282           (setq cur-folder (car parse-results)
 283                 cur-index (cadr parse-results))
 284           (setq mh-index-max-msg-index (max mh-index-max-msg-index cur-index))
 285           (cond ((and (equal cur-folder last-folder)
 286                       (= cur-index last-index))
 287                  nil)
 288                 ((equal cur-folder last-folder)
 289                  (save-excursion
 290                    (set-buffer mh-index-buffer)
 291                    (push cur-index (gethash cur-folder mh-index-matches))))
 292                 (t
 293                  (save-excursion
 294                    (set-buffer mh-index-buffer)
 295                    (unless (gethash cur-folder mh-index-matches)
 296                      (setq button-start (point))
 297                      (gnus-eval-format "%T\n" '((?T cur-folder ?s))
 298                                        `(,@(gnus-local-map-property
 299                                             mh-index-button-map)
 300                                          mh-callback mh-index-callback
 301                                          mh-data ,cur-folder))
 302                      (setq button-end (point))
 303                      (widget-convert-button
 304                       'link button-start button-end
 305                       :button-keymap mh-index-button-map
 306                       :action 'mh-index-callback)
 307                      (insert "\n"))
 308                    (push cur-index (gethash cur-folder mh-index-matches)))))
 309           (setq last-folder cur-folder)
 310           (setq last-index cur-index)))
 311
 312       ;; Get rid of extra line at end of the buffer if there were any hits.
 313       (set-buffer mh-index-buffer)
 314       (goto-char (point-max))
 315       (when (and (= (forward-line -1) 0) (bolp) (eolp))
 316         (delete-char 1))
 317
 318       ;; Set mh-cmd-note to a large enough value...
 319       (when mh-adaptive-cmd-note-flag
 320         (mh-set-cmd-note (mh-index-find-max-width mh-index-max-msg-index)))
 321
 322       ;; Generate scan lines for the hits.
 323       (message "Generating scan lines... ")
 324       (goto-char (point-min))
 325       (while (not (eobp))
 326         (let ((folder (get-text-property (point) 'mh-data)))
 327           (when folder
 328             (incf folder-count)
 329             (forward-line)
 330             (incf count (mh-index-insert-scan folder))))
 331         (forward-line))
 332
 333       ;; Go to the first hit (if any).
 334       (goto-char (point-min))
 335       (forward-line)
 336
 337       ;; Remember old window configuration
 338       (setq mh-index-previous-window-configuration config)
 339
 340       ;; Setup folder buffer mode
 341       (when mh-decode-mime-flag
 342         (add-hook 'kill-buffer-hook 'mh-mime-cleanup))
 343       (mh-index-folder-mode)
 344       (setq mh-show-buffer mh-index-show-buffer)
 345       (setq buffer-read-only t)
 346       (set-buffer-modified-p nil)
 347       (mh-index-configure-one-window)
 348       (setq mh-current-folder nil mh-index-current-msg nil)
 349       (message "%s found %s matches in %s folders"
 350                (upcase-initials (symbol-name mh-indexer))
 351                count folder-count))))
 352
 353 (defun mh-index-find-max-width (max-index)
 354   "Given MAX-INDEX find the number of digits necessary to print it."
 355   (let ((result 1)
 356         (max-int 9))
 357     (while (< max-int max-index)
 358       (incf result)
 359       (setq max-int (+ (* 10 max-int) 9)))
 360     result))
 361
 362 (defun mh-index-search-again ()
 363   "Call `mh-index-search' from index search buffer."
 364   (interactive)
 365   (cond ((eq major-mode 'mh-index-show-mode)
 366          (set-buffer mh-index-other-buffer))
 367         ((not (eq major-mode 'mh-index-folder-mode))
 368          (error "Should be called from one of the index buffers")))
 369   (let ((old-buffer (current-buffer))
 370         (window-config mh-index-previous-window-configuration))
 371     (unwind-protect (call-interactively 'mh-index-search)
 372       (when (eq old-buffer (current-buffer))
 373         (setq mh-index-previous-window-configuration window-config)))))
 374
 375 (defun mh-index-insert-scan (folder)
 376   "Insert scan lines for hits in FOLDER that the indexing program found.
 377 The only twist is to replace the subject/body field with the match (if
 378 possible)."
 379   (save-excursion
 380     (apply #'mh-exec-cmd-output
 381            mh-scan-prog nil (mh-scan-format)
 382            "-noclear" "-noheader" "-width" (window-width)
 383            folder (mh-coalesce-msg-list (gethash folder mh-index-matches))))
 384   (save-excursion
 385     (let ((window-width (window-width))
 386           (count 0))
 387       (while (not (or (get-text-property (point) 'mh-data) (eobp)))
 388         (beginning-of-line)
 389         (unless (and (eolp) (bolp))
 390           (incf count)
 391           (forward-char mh-cmd-note)
 392           (delete-char 1)
 393           (insert " "))
 394         (forward-line 1))
 395       count)))
 396
 397 (defun mh-index-callback ()
 398   "Callback function for buttons in the index buffer."
 399   (let* ((folder (save-excursion
 400                    (buffer-substring-no-properties
 401                     (progn (beginning-of-line) (point))
 402                     (progn (end-of-line) (point)))))
 403          (data (get-text-property (point) 'mh-data))
 404          (msg-list (gethash data mh-index-matches)))
 405     (when msg-list
 406       (mh-visit-folder folder msg-list))))
 407
 408 (defmacro mh-defun-index (func args &rest body)
 409   "Macro to generate a function callable both from index and show buffer.
 410 FUNC is the function name, ARGS the argument list and BODY the function
 411 body."
 412   (let ((cur (gensym))
 413         interactive-spec doc-string)
 414     (when (stringp (car body))
 415       (setq doc-string (car body))
 416       (setq body (cdr body)))
 417     (when (and (listp (car body)) (eq (caar body) 'interactive))
 418       (setq interactive-spec (car body))
 419       (setq body (cdr body)))
 420     `(defun ,func ,args
 421        ,@(if doc-string (list doc-string) ())
 422        ,interactive-spec
 423        (let* ((mh-index-buffer (if (eq major-mode 'mh-index-folder-mode)
 424                                    (buffer-name (current-buffer))
 425                                  mh-index-other-buffer))
 426               (mh-index-show-buffer (if (eq major-mode 'mh-index-show-mode)
 427                                         (buffer-name (current-buffer))
 428                                       mh-index-other-buffer))
 429               (,cur (cond ((eq (get-buffer mh-index-buffer)
 430                                (current-buffer))
 431                            mh-index-buffer)
 432                           ((eq (get-buffer mh-index-show-buffer)
 433                                (current-buffer))
 434                            mh-index-show-buffer)
 435                           (t (error "Not called from mh-index buffer")))))
 436          (flet ((mh-msg-folder (folder) mh-index-buffer)
 437                 (mh-msg-filename (msg-num folder)
 438                   (format "%s%s/%s" mh-user-path (subseq folder 1) msg-num)))
 439            (cond ((eq ,cur mh-index-buffer)
 440                   (mh-index-goto-nearest-msg)
 441                   (when (and mh-current-folder mh-index-current-msg)
 442                     (mh-index-notate mh-current-folder
 443                                      mh-index-current-msg " " mh-cmd-note))
 444                   (setq mh-current-folder (mh-index-parse-folder))
 445                   (setq mh-index-current-msg (mh-index-parse-msg-number)))
 446                  ((eq ,cur mh-index-show-buffer)
 447                   (set-buffer mh-index-buffer)
 448                   (mh-index-goto-msg mh-current-folder
 449                                      mh-index-current-msg)
 450                   (mh-index-notate nil nil " " mh-cmd-note))
 451                  (t (error "This can't happen!")))
 452            (unwind-protect
 453                (progn ,@body)
 454              (save-excursion
 455                (set-buffer mh-index-buffer)
 456                (mh-index-goto-msg mh-current-folder mh-index-current-msg)
 457                (mh-recenter nil))
 458              (mh-index-configure-windows)
 459              (pop-to-buffer ,cur)))))))
 460
 461 (defun mh-index-advance (steps)
 462   "Advance STEPS messages in the folder buffer.
 463 If there are less than STEPS messages left then an error message is printed."
 464   (let* ((backward-flag (< steps 0))
 465          (steps (if backward-flag (- steps) steps))
 466          point)
 467     (block body
 468       (save-excursion
 469         (while (> steps 0)
 470           (unless (= (forward-line (if backward-flag -1 1)) 0)
 471             (return-from body))
 472           (cond ((and (eolp) (bolp) (not backward-flag))
 473                  (unless (= (forward-line 2) 0) (return-from body)))
 474                 ((and (get-text-property (point) 'mh-data) backward-flag)
 475                  (unless (= (forward-line -2) 0) (return-from body)))
 476                 ((or (and (eolp) (bolp))
 477                      (get-text-property (point) 'mh-data))
 478                  (error "Mh-index-buffer is inconsistent")))
 479           (decf steps))
 480         (setq point (point))))
 481     (cond (point (goto-char point) t)
 482           (t nil))))
 483
 484 ;; Details about message at point. These functions assume that we are on a
 485 ;; line which contains a message scan line and not on a blank line or a line
 486 ;; with a folder name.
 487 (defun mh-index-parse-msg-number ()
 488   "Parse message number of message at point."
 489   (save-excursion
 490     (beginning-of-line)
 491     (let* ((b (point))
 492            (e (progn (forward-char mh-cmd-note) (point)))
 493            (data (ignore-errors
 494                    (read-from-string (buffer-substring-no-properties b e)))))
 495       (unless (and (consp data) (integerp (car data)))
 496         (error "Didn't find message number"))
 497       (car data))))
 498
 499 (defun mh-index-parse-folder ()
 500   "Parse folder of message at point."
 501   (save-excursion
 502     (while (not (get-text-property (point) 'mh-data))
 503       (unless (eql (forward-line -1) 0)
 504         (error "Reached beginning of buffer without seeing a folder")))
 505     (buffer-substring-no-properties (progn (beginning-of-line) (point))
 506                                     (progn (end-of-line) (point)))))
 507
 508 (defun mh-index-goto-nearest-msg ()
 509   "If point is not at a message go to the closest line with a message on it."
 510   (beginning-of-line)
 511   (cond ((and (eolp) (bolp)) (forward-line -1))
 512         ((get-text-property (point) 'mh-data) (forward-line 1))))
 513
 514 ;; Window configuration for mh-index... There should be similar functions
 515 ;; in MH-E but I couldn't find them. I got the idea of using next-window,
 516 ;; previous-window and minibuffer-window from MH-E code.
 517 (defun mh-index-configure-windows ()
 518   "Configure windows."
 519   (cond ((and (buffer-live-p (get-buffer mh-index-show-buffer))
 520               (buffer-live-p (get-buffer mh-index-buffer))
 521               (eq (save-excursion (set-buffer mh-index-show-buffer) major-mode)
 522                   'mh-index-show-mode))
 523          (mh-index-configure-two-windows))
 524         ((buffer-live-p (get-buffer mh-index-buffer))
 525          (mh-index-configure-one-window))))
 526
 527 (defun mh-count-windows ()
 528   "Count the number of windows in the current frame.
 529 The minibuffer window is excluded from the count."
 530   (let* ((start-window (next-window nil t))
 531          (current-window (next-window start-window t))
 532          (count 0))
 533     (while (not (eq current-window start-window))
 534       (incf count)
 535       (setq current-window (next-window current-window t)))
 536     count))
 537
 538 (defun mh-index-configure-two-windows ()
 539   "Force a split view like that of MH-E."
 540   (save-excursion
 541     (unless (and (get-buffer mh-index-show-buffer)
 542                  (get-buffer mh-index-buffer))
 543       (error "We don't have both index buffers"))
 544     (let ((window-count (mh-count-windows)))
 545       (unless (and (= window-count 2)
 546                    (eq (window-buffer (next-window (minibuffer-window)))
 547                        (get-buffer mh-index-buffer))
 548                    (eq (window-buffer (previous-window (minibuffer-window)))
 549                        (get-buffer mh-index-show-buffer)))
 550         (unless (= window-count 2)
 551           (delete-other-windows)
 552           (split-window-vertically))
 553         (set-window-buffer (next-window (minibuffer-window))
 554                            mh-index-buffer)
 555         (set-window-buffer (previous-window (minibuffer-window))
 556                            mh-index-show-buffer))
 557       (unless (and (get-buffer-window mh-index-buffer)
 558                    (= (window-height (get-buffer-window mh-index-buffer))
 559                       mh-summary-height))
 560         (pop-to-buffer mh-index-buffer)
 561         (shrink-window (- (window-height) mh-summary-height))))
 562     (set-window-point (previous-window (minibuffer-window))
 563                       (progn (set-buffer mh-index-show-buffer) (point)))
 564     (set-window-point (next-window (minibuffer-window))
 565                       (progn (set-buffer mh-index-buffer) (point)))))
 566
 567 (defun mh-index-configure-one-window ()
 568   "Single window view."
 569   (save-excursion
 570     (unless (buffer-live-p (get-buffer mh-index-buffer))
 571       (error "Should have mh-index-buffer"))
 572     (switch-to-buffer mh-index-buffer)
 573     (delete-other-windows)
 574     (set-window-point (next-window (minibuffer-window))
 575                       (progn (set-buffer mh-index-buffer) (point)))))
 576
 577 ;; This is slightly more involved than normal MH-E since we may have multiple
 578 ;; folders in the same buffer.
 579 (defun mh-index-goto-msg (folder msg)
 580   "Move the cursor to the message specified by FOLDER and MSG."
 581   (block body
 582     (unless (buffer-live-p (get-buffer mh-index-buffer))
 583       (error "No index buffer to go to"))
 584     (set-buffer mh-index-buffer)
 585     (goto-char (point-min))
 586     (while (re-search-forward (format "^%s$" folder) nil t)
 587       (forward-line)
 588       (while (not (eolp))
 589         (when (= (mh-index-parse-msg-number) msg)
 590           (return-from body))
 591         (forward-line)))
 592     (error "Folder: %s, msg: %s doesn't exist" folder msg)))
 593
 594 ;; Can't use mh-notate directly since we could have more than one folder in
 595 ;; the same buffer
 596 (defun mh-index-notate (folder msg notation offset)
 597   "Add notation to scan line.
 598 FOLDER is the message folder and MSG the message index. These arguments
 599 specify the message to be notated. NOTATION is the character to be used to
 600 notate and OFFSET is the number of chars from start of the line where
 601 notation is to be placed."
 602   (save-excursion
 603     (set-buffer mh-index-buffer)
 604     (let ((buffer-read-only nil)
 605           (modified-p (buffer-modified-p))
 606           (found t))
 607       (setq found nil)
 608       (when (and (stringp folder) (numberp msg))
 609         (block nil
 610           (goto-char (point-min))
 611           (re-search-forward (format "^%s$" folder))
 612           (forward-line)
 613           (while (not (eolp))
 614             (when (= (mh-index-parse-msg-number) msg)
 615               (setq found t)
 616               (return))
 617             (forward-line))))
 618       (when found
 619         (beginning-of-line)
 620         (forward-char offset)
 621         (delete-char 1)
 622         (insert notation)
 623         (unless modified-p (set-buffer-modified-p nil))))))
 624
 625 \f
 626
 627 ;;; User functions
 628
 629 (mh-defun-index mh-index-show (display-headers-flag)
 630   "Display message at point.
 631 If there are no messages at point then display the closest message.
 632 The value of `mh-index-show-hook' is a list of functions to be called,
 633 with no arguments, after the message has been displayed.
 634 If DISPLAY-HEADERS-FLAG is non-nil then the raw message is shown."
 635   (interactive (list nil))
 636   (when (or (and (bolp) (eolp)) (get-text-property (point) 'mh-data))
 637     (error "No message at point"))
 638   (setq mh-current-folder (mh-index-parse-folder))
 639   (setq mh-index-current-msg (mh-index-parse-msg-number))
 640   ;; Do new notation
 641   (when (and mh-current-folder mh-index-current-msg)
 642     (mh-index-notate mh-current-folder mh-index-current-msg
 643                      mh-note-cur mh-cmd-note))
 644   (let ((mh-decode-mime-flag (and (not display-headers-flag) mh-decode-mime-flag))
 645         (mh-clean-message-header-flag
 646          (and (not display-headers-flag) mh-clean-message-header-flag))
 647         (mhl-formfile (if display-headers-flag nil mhl-formfile))
 648         (msg mh-index-current-msg)
 649         (folder mh-current-folder))
 650     (when (not (eq display-headers-flag mh-showing-with-headers))
 651       (mh-invalidate-show-buffer))
 652     (mh-in-show-buffer (mh-index-show-buffer)
 653       (mh-display-msg msg folder))
 654     ;; Search for match in shown message
 655     (select-window (get-buffer-window mh-index-show-buffer))
 656     (set-buffer mh-index-show-buffer)
 657     (mh-index-show-mode))
 658   (run-hooks 'mh-index-show-hook))
 659
 660 (defun mh-index-header-display ()
 661   "Show the message with full headers."
 662   (interactive)
 663   (mh-index-show t)
 664   (setq mh-showing-with-headers t))
 665
 666 (mh-defun-index mh-index-next (steps)
 667   "Display next message.
 668 Prefix argument STEPS specifies the number of messages to skip ahead."
 669   (interactive "p")
 670   (mh-index-goto-nearest-msg)
 671   (if (mh-index-advance steps)
 672       (mh-index-show nil)
 673     (mh-index-show nil)
 674     (message "Not enough messages")))
 675
 676 (mh-defun-index mh-index-prev (steps)
 677   "Display previous message.
 678 Prefix argument STEPS specifies the number of messages to skip backward."
 679   (interactive "p")
 680   (mh-index-goto-nearest-msg)
 681   (if (mh-index-advance (- steps))
 682       (mh-index-show nil)
 683     (mh-index-show nil)
 684     (message "Not enough messages")))
 685
 686 (defun mh-index-page-msg (arg)
 687   "Scroll the displayed message upward ARG lines."
 688   (interactive "P")
 689   (save-excursion
 690     (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode)
 691                                mh-index-other-buffer)
 692                               ((eq major-mode 'mh-index-show-mode)
 693                                (buffer-name (current-buffer)))
 694                               (t (error "Don't use mh-index-page-msg"))))
 695            (window (get-buffer-window show-buffer))
 696            (current-window (selected-window)))
 697       (when (window-live-p window)
 698         (select-window window)
 699         (unwind-protect (scroll-up arg)
 700           (select-window current-window))))))
 701
 702 (defun mh-index-previous-page (arg)
 703   "Scroll the displayed message downward ARG lines."
 704   (interactive "P")
 705   (save-excursion
 706     (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode)
 707                                mh-index-other-buffer)
 708                               ((eq major-mode 'mh-index-show-mode)
 709                                (buffer-name (current-buffer)))
 710                               (t (error "Don't use mh-index-previous-page"))))
 711            (window (get-buffer-window show-buffer))
 712            (current-window (selected-window)))
 713       (when (window-live-p window)
 714         (select-window window)
 715         (unwind-protect (scroll-down arg)
 716           (select-window current-window))))))
 717
 718 (defun mh-index-press-button ()
 719   "Press index button."
 720   (interactive)
 721   (let ((function (get-text-property (point) 'mh-callback)))
 722     (when function
 723       (funcall function))))
 724
 725 (defun mh-index-quit ()
 726   "Quit the index folder.
 727 Restore the previous window configuration, if one exists.
 728 The value of `mh-before-quit-hook' is a list of functions to be called, with
 729 no arguments, immediately upon entry to this function.
 730 The value of `mh-quit-hook' is a list of functions to be called, with no
 731 arguments, upon exit of this function."
 732   (interactive)
 733   (cond ((eq major-mode 'mh-index-show-mode)
 734          (set-buffer mh-index-other-buffer))
 735         ((not (eq major-mode 'mh-index-folder-mode))
 736          (error "The function mh-index-quit shouldn't be called")))
 737   (run-hooks 'mh-before-quit-hook)
 738   (let ((mh-index-buffer (buffer-name (current-buffer)))
 739         (mh-index-show-buffer mh-index-other-buffer)
 740         (window-config mh-index-previous-window-configuration))
 741     (when (buffer-live-p (get-buffer mh-index-buffer))
 742       (bury-buffer (get-buffer mh-index-buffer)))
 743     (when (buffer-live-p (get-buffer mh-index-show-buffer))
 744       (bury-buffer (get-buffer mh-index-show-buffer)))
 745     (when window-config
 746       (set-window-configuration window-config)))
 747   (run-hooks 'mh-quit-hook))
 748
 749 ;; Can't quite use mh-next-button... This buffer has no concept of
 750 ;; folder-buffer or show-buffer. Maybe refactor mh-next-button?
 751 (defun mh-index-next-button (&optional backward-flag)
 752   "Go to the next button.
 753 Advance point to the next button in the show buffer. If the end of buffer is
 754 reached then the search wraps over to the start of the buffer. With optional
 755 argument BACKWARD-FLAG the point will move to the previous button."
 756   (interactive current-prefix-arg)
 757   (mh-goto-next-button backward-flag))
 758
 759 (defun mh-index-prev-button ()
 760   "Go to the next button.
 761 Move point to the previous button in the show buffer. If the beginning of
 762 the buffer is reached then the search wraps over to the end."
 763   (interactive)
 764   (mh-index-next-button t))
 765
 766 \f
 767
 768 ;; Glimpse interface
 769
 770 (defvar mh-glimpse-binary (executable-find "glimpse"))
 771 (defvar mh-glimpse-directory ".glimpse")
 772
 773 (defun mh-glimpse-execute-search (folder-path search-regexp)
 774   "Execute glimpse and read the results.
 775
 776 In the examples below, replace /home/user/Mail with the path to your MH
 777 directory.
 778
 779 First create the directory /home/user/Mail/.glimpse. Then create the file
 780 /home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
 781
 782     */.*
 783     */#*
 784     */,*
 785     */*~
 786     ^/home/user/Mail/.glimpse
 787
 788 If there are any directories you would like to ignore, append lines like the
 789 following to .glimpse_exclude:
 790
 791     ^/home/user/Mail/scripts
 792
 793 Use the following command line to generate the glimpse index. Run this
 794 daily from cron:
 795
 796     glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
 797
 798 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 799   (set-buffer (get-buffer-create mh-index-temp-buffer))
 800   (erase-buffer)
 801   (call-process mh-glimpse-binary nil '(t nil) nil
 802                 ;(format "-%s" fuzz)
 803                 "-i" "-y"
 804                 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
 805                 "-F" (format "^%s" folder-path)
 806                 search-regexp)
 807   (goto-char (point-min)))
 808
 809 (defun mh-glimpse-next-result ()
 810   "Read the next result.
 811 Parse it and return the message folder, message index and the match. If no
 812 other matches left then return nil. If the current record is invalid return
 813 'error."
 814   (prog1
 815     (block nil
 816       (when (eobp)
 817         (return nil))
 818       (let ((eol-pos (line-end-position))
 819             (bol-pos (line-beginning-position))
 820             folder-start msg-end)
 821         (goto-char bol-pos)
 822         (unless (search-forward mh-user-path eol-pos t)
 823           (return 'error))
 824         (setq folder-start (point))
 825         (unless (search-forward ": " eol-pos t)
 826           (return 'error))
 827         (let ((match (buffer-substring-no-properties (point) eol-pos)))
 828           (forward-char -2)
 829           (setq msg-end (point))
 830           (unless (search-backward "/" folder-start t)
 831             (return 'error))
 832           (list (format "+%s" (buffer-substring-no-properties
 833                                folder-start (point)))
 834                 (let ((val (ignore-errors (read-from-string
 835                                            (buffer-substring-no-properties
 836                                             (1+ (point)) msg-end)))))
 837                   (if (and (consp val) (integerp (car val)))
 838                     (car val)
 839                     (return 'error)))
 840                 match))))
 841     (forward-line)))
 842
 843 \f
 844
 845 ;; Grep interface
 846
 847 (defvar mh-grep-binary (executable-find "grep"))
 848
 849 (defun mh-grep-execute-search (folder-path search-regexp)
 850   "Execute grep and read the results.
 851 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 852   (set-buffer (get-buffer-create mh-index-temp-buffer))
 853   (erase-buffer)
 854   (call-process mh-grep-binary nil '(t nil) nil
 855                 "-i" "-r" search-regexp folder-path)
 856   (goto-char (point-min)))
 857
 858 (defun mh-grep-next-result ()
 859   "Read the next result.
 860 Parse it and return the message folder, message index and the match. If no
 861 other matches left then return nil. If the current record is invalid return
 862 'error."
 863   (prog1
 864     (block nil
 865       (when (eobp)
 866         (return nil))
 867       (let ((eol-pos (line-end-position))
 868             (bol-pos (line-beginning-position))
 869             folder-start msg-end)
 870         (goto-char bol-pos)
 871         (unless (search-forward mh-user-path eol-pos t)
 872           (return 'error))
 873         (setq folder-start (point))
 874         (unless (search-forward ":" eol-pos t)
 875           (return 'error))
 876         (let ((match (buffer-substring-no-properties (point) eol-pos)))
 877           (forward-char -1)
 878           (setq msg-end (point))
 879           (unless (search-backward "/" folder-start t)
 880             (return 'error))
 881           (list (format "+%s" (buffer-substring-no-properties
 882                                folder-start (point)))
 883                 (let ((val (ignore-errors (read-from-string
 884                                            (buffer-substring-no-properties
 885                                             (1+ (point)) msg-end)))))
 886                   (if (and (consp val) (integerp (car val)))
 887                     (car val)
 888                     (return 'error)))
 889                 match))))
 890     (forward-line)))
 891
 892 \f
 893
 894 ;; Swish interface
 895
 896 (defvar mh-swish-binary (executable-find "swish-e"))
 897 (defvar mh-swish-directory ".swish")
 898 (defvar mh-swish-folder nil)
 899
 900 (defun mh-swish-execute-search (folder-path search-regexp)
 901   "Execute swish-e and read the results.
 902
 903 In the examples below, replace /home/user/Mail with the path to your MH
 904 directory.
 905
 906 First create the directory /home/user/Mail/.swish. Then create the file
 907 /home/user/Mail/.swish/config with the following contents:
 908
 909     IndexDir /home/user/Mail
 910     IndexFile /home/user/Mail/.swish/index
 911     IndexName \"Mail Index\"
 912     IndexDescription \"Mail Index\"
 913     IndexPointer \"http://nowhere\"
 914     IndexAdmin \"nobody\"
 915     #MetaNames automatic
 916     IndexReport 3
 917     FollowSymLinks no
 918     UseStemming no
 919     IgnoreTotalWordCountWhenRanking yes
 920     WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
 921     BeginCharacters abcdefghijklmnopqrstuvwxyz
 922     EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
 923     IgnoreLimit 50 1000
 924     IndexComments 0
 925     FileRules pathname contains /home/user/Mail/.swish
 926     FileRules filename is index
 927     FileRules filename is \..*
 928     FileRules filename is #.*
 929     FileRules filename is ,.*
 930     FileRules filename is .*~
 931
 932 If there are any directories you would like to ignore, append lines like the
 933 following to config:
 934
 935     FileRules pathname contains /home/user/Mail/scripts
 936
 937 Use the following command line to generate the swish index. Run this
 938 daily from cron:
 939
 940     swish-e -c /home/user/Mail/.swish/config
 941
 942 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
 943   (set-buffer (get-buffer-create mh-index-temp-buffer))
 944   (erase-buffer)
 945   (unless mh-swish-binary
 946     (error "Set mh-swish-binary appropriately"))
 947   (call-process mh-swish-binary nil '(t nil) nil
 948                 "-w" search-regexp
 949                 "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
 950   (goto-char (point-min))
 951   (setq mh-swish-folder
 952         (let ((last-char (substring folder-path (1- (length folder-path)))))
 953           (if (equal last-char "/")
 954               folder-path
 955             (format "%s/" folder-path)))))
 956
 957 (defun mh-swish-next-result ()
 958   "Get the next result from swish output."
 959   (prog1
 960       (block nil
 961         (when (or (eobp) (equal (char-after (point)) ?.))
 962           (return nil))
 963         (when (equal (char-after (point)) ?#)
 964           (return 'error))
 965         (let* ((start (search-forward " " (line-end-position) t))
 966                (end (search-forward " " (line-end-position) t)))
 967           (unless (and start end)
 968             (return 'error))
 969           (setq end (1- end))
 970           (unless (file-exists-p (buffer-substring-no-properties start end))
 971             (return 'error))
 972           (unless (search-backward "/" start t)
 973             (return 'error))
 974           (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
 975                   (unless (string-match mh-swish-folder s)
 976                     (return 'error))
 977                   (if (string-match mh-user-path s)
 978                       (format "+%s"
 979                               (substring s (match-end 0) (1- (length s))))
 980                     (return 'error)))
 981                 (let* ((s (buffer-substring-no-properties (1+ (point)) end))
 982                        (val (ignore-errors (read-from-string s))))
 983                   (if (and (consp val) (numberp (car val)))
 984                       (car val)
 985                     (return 'error)))
 986                 nil)))
 987     (forward-line)))
 988
 989 \f
 990
 991 ;; Swish++ interface
 992
 993 (defvar mh-swish++-binary (or (executable-find "search++")
 994                               (executable-find "search")))
 995 (defvar mh-swish++-directory ".swish++")
 996
 997 (defun mh-swish++-execute-search (folder-path search-regexp)
 998   "Execute swish++ and read the results.
 999
1000 In the examples below, replace /home/user/Mail with the path to your MH
1001 directory.
1002
1003 First create the directory /home/user/Mail/.swish++. Then create the file
1004 /home/user/Mail/.swish++/swish++.conf with the following contents:
1005
1006     IncludeMeta         Bcc Cc Comments Content-Description From Keywords
1007     IncludeMeta         Newsgroups Resent-To Subject To
1008     IncludeFile         Mail    [0-9]*
1009     IndexFile           /home/user/Mail/.swish++/swish++.index
1010
1011 Use the following command line to generate the swish index. Run this
1012 daily from cron:
1013
1014     index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
1015
1016 On some systems (Debian GNU/Linux, for example), use index++ instead of index.
1017
1018 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1019   (set-buffer (get-buffer-create mh-index-temp-buffer))
1020   (erase-buffer)
1021   (unless mh-swish++-binary
1022     (error "Set mh-swish++-binary appropriately"))
1023   (call-process mh-swish++-binary nil '(t nil) nil
1024                 "-m" "10000"
1025                 (format "-i%s%s/swish++.index"
1026                         mh-user-path mh-swish++-directory)
1027                 search-regexp)
1028   (goto-char (point-min))
1029   (setq mh-swish-folder
1030         (let ((last-char (substring folder-path (1- (length folder-path)))))
1031           (if (equal last-char "/")
1032               folder-path
1033             (format "%s/" folder-path)))))
1034
1035 (defalias 'mh-swish++-next-result 'mh-swish-next-result)
1036
1037 \f
1038
1039 ;; Namazu interface
1040
1041 (defvar mh-namazu-binary (executable-find "namazu"))
1042 (defvar mh-namazu-directory ".namazu")
1043 (defvar mh-namazu-folder nil)
1044
1045 (defun mh-namazu-execute-search (folder-path search-regexp)
1046   "Execute namazu and read the results.
1047
1048 In the examples below, replace /home/user/Mail with the path to your MH
1049 directory.
1050
1051 First create the directory /home/user/Mail/.namazu. Then create the file
1052 /home/user/Mail/.namazu/mknmzrc with the following contents:
1053
1054     package conf;  # Don't remove this line!
1055     $ADDRESS = 'user@localhost';
1056     $ALLOW_FILE = \"[0-9]*\";
1057
1058 Use the following command line to generate the namazu index. Run this
1059 daily from cron:
1060
1061    mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
1062          /home/user/Mail
1063
1064 FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1065   (let ((namazu-index-directory
1066          (format "%s%s" mh-user-path mh-namazu-directory)))
1067     (unless (file-exists-p namazu-index-directory)
1068       (error "Namazu directory %s not present" namazu-index-directory))
1069     (unless (executable-find mh-namazu-binary)
1070       (error "Set mh-namazu-binary appropriately"))
1071     (set-buffer (get-buffer-create mh-index-temp-buffer))
1072     (erase-buffer)
1073     (call-process mh-namazu-binary nil '(t nil) nil
1074                   "-alR" search-regexp namazu-index-directory)
1075     (goto-char (point-min))
1076     (setq mh-namazu-folder
1077           (let ((last (substring folder-path (1- (length folder-path)))))
1078             (if (equal last "/")
1079                 folder-path
1080               (format "%s/" folder-path))))))
1081
1082 (defun mh-namazu-next-result ()
1083   "Get the next result from namazu output."
1084   (prog1
1085       (block nil
1086         (when (eobp) (return nil))
1087         (let ((file-name (buffer-substring-no-properties
1088                           (point) (line-end-position))))
1089           (unless (equal (string-match mh-namazu-folder file-name) 0)
1090             (return 'error))
1091           (unless (file-exists-p file-name)
1092             (return 'error))
1093           (string-match mh-user-path file-name)
1094           (let* ((folder/msg (substring file-name (match-end 0)))
1095                  (mark (search "/" folder/msg :from-end t)))
1096             (unless mark (return 'error))
1097             (list (format "+%s" (substring folder/msg 0 mark))
1098                   (let ((n (ignore-errors (read-from-string
1099                                            (substring folder/msg (1+ mark))))))
1100                     (if (and (consp n) (numberp (car n)))
1101                         (car n)
1102                       (return 'error)))
1103                   nil))))
1104     (forward-line)))
1105
1106 \f
1107
1108 (defun mh-index-choose ()
1109   "Choose an indexing function.
1110 The side-effects of this function are that the variables `mh-indexer',
1111 `mh-index-execute-search-function', and `mh-index-next-result-function' are
1112 set according to the first indexer in `mh-indexer-choices' present on the
1113 system."
1114   (block nil
1115     ;; The following favors the user's preference; otherwise, the last
1116     ;; automatically chosen indexer is used for efficiency rather than going
1117     ;; through the list.
1118     (let ((program-alist (cond (mh-index-program
1119                                 (list
1120                                  (assoc mh-index-program mh-indexer-choices)))
1121                                (mh-indexer
1122                                 (list (assoc mh-indexer mh-indexer-choices)))
1123                                (t mh-indexer-choices))))
1124       (while program-alist
1125         (let* ((current (pop program-alist))
1126                (executable (symbol-value (cadr current))))
1127           (when executable
1128             (setq mh-indexer (car current))
1129             (setq mh-index-execute-search-function (caddr current))
1130             (setq mh-index-next-result-function (cadddr current))
1131             (return mh-indexer))))
1132       nil)))
1133
1134 \f
1135
1136 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1137 ;;; Menus for folder mode: folder, message (in that order)
1138 ;;; folder-mode "Message" menu
1139 (easy-menu-define
1140   mh-index-folder-message-menu mh-index-folder-mode-keymap
1141   "Menu for MH-E folder-message."
1142   '("Message"
1143     ["Show Message"             mh-index-show (mh-get-msg-num nil)]
1144     ["Show Message with Header" mh-index-header-display (mh-get-msg-num nil)]
1145     ["Next Message"             mh-index-next t]
1146     ["Previous Message"         mh-index-prev t]
1147     "--"
1148     ["Compose a New Message"    mh-send t]))
1149
1150 ;;; folder-mode "Folder" menu
1151 (easy-menu-define
1152   mh-index-folder-folder-menu mh-index-folder-mode-keymap
1153   "Menu for MH-E folder."
1154   '("Folder"
1155     ["Incorporate New Mail"     mh-inc-folder t]
1156     "--"
1157     ["Visit a Folder..."        mh-visit-folder t]
1158     ["Indexed Search..."        mh-index-search-again t]
1159     "--"
1160     ["Quit Indexed Search"      mh-index-quit t]))
1161
1162 \f
1163
1164 ;;; Support for emacs21 toolbar using gnus/message.el icons (and code).
1165 (eval-when-compile (defvar tool-bar-map))
1166 (defvar mh-index-folder-tool-bar-map nil)
1167 (when (fboundp 'tool-bar-add-item)
1168   (setq mh-index-folder-tool-bar-map
1169     (let ((tool-bar-map (make-sparse-keymap)))
1170       (tool-bar-add-item "mail" 'mh-inc-folder
1171                          'mh-indexfoldertoolbar-inc-folder
1172                          :help "Incorporate new mail in Inbox")
1173       (tool-bar-add-item "left_arrow" 'mh-index-prev
1174                          'mh-indexfoldertoolbar-prev :help "Previous message")
1175       (tool-bar-add-item "page-down" 'mh-index-page-msg
1176                          'mh-indexfoldertoolbar-page
1177                          :help "Page this message")
1178       (tool-bar-add-item "right_arrow" 'mh-index-next
1179                          'mh-indexfoldertoolbar-next :help "Next message")
1180
1181       (tool-bar-add-item "mail_compose" 'mh-send 'mh-indexfoldertoolbar-compose
1182                          :help "Compose new message")
1183
1184       (tool-bar-add-item "search"
1185                          (lambda (&optional arg)
1186                            (interactive "P")
1187                            (call-interactively mh-tool-bar-search-function))
1188                          'mh-indexfoldertoolbar-search :help "Search")
1189       (tool-bar-add-item "fld_open" 'mh-visit-folder
1190                          'mh-indexfoldertoolbar-visit
1191                          :help "Visit other folder")
1192
1193       (tool-bar-add-item "preferences" (lambda ()
1194                                          (interactive)
1195                                          (customize-group "mh"))
1196                          'mh-indexfoldertoolbar-customize
1197                          :help "MH-E preferences")
1198       (tool-bar-add-item "help" (lambda ()
1199                                   (interactive)
1200                                   (Info-goto-node "(mh-e)Top"))
1201                          'mh-indexfoldertoolbar-help :help "Help")
1202       tool-bar-map)))
1203
1204 ;; Modes for mh-index
1205 (define-derived-mode mh-index-folder-mode mh-folder-mode "MH-Index-Folder"
1206   "Major MH-E mode for displaying the results of searching.\\<mh-index-folder-mode-keymap>
1207
1208 You can display the message the cursor is pointing to and step through the
1209 messages.
1210
1211 You can also jump to the folders narrowed to the search results by pressing
1212 RET on the folder name. Many operations, such as replying to a message,
1213 require that you do this first.
1214
1215 \\{mh-index-folder-mode-keymap}"
1216   (make-local-variable 'font-lock-defaults)
1217   (setq font-lock-defaults '(mh-index-font-lock-keywords t))
1218   (use-local-map mh-index-folder-mode-keymap)
1219   (make-local-variable 'mh-help-messages)
1220   (easy-menu-add mh-index-folder-message-menu)
1221   (easy-menu-add mh-index-folder-folder-menu)
1222   (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1223       (set (make-local-variable 'tool-bar-map) mh-index-folder-tool-bar-map))
1224   (setq mh-help-messages mh-index-folder-mode-help-messages))
1225
1226 (define-derived-mode mh-index-show-mode mh-show-mode "MH-Index-Show"
1227   "Major mode for showing messages in MH-E index.\\<mh-index-folder-mode-keymap>
1228 \\{mh-index-folder-mode-keymap}"
1229   (use-local-map mh-index-folder-mode-keymap)
1230   (setq mh-help-messages mh-index-folder-mode-help-messages))
1231
1232 ;; Font lock support for mh-index-folder. This is the same as mh-folder
1233 ;; except that the folder line needs to be recognized and highlighted.
1234 (defvar mh-index-folder-face 'mh-index-folder-face
1235   "Face for highlighting folders in MH-Index buffers.")
1236 (defface mh-index-folder-face
1237   '((((class color) (background light))
1238      (:foreground "dark green"))
1239     (((class color) (background dark))
1240      (:foreground "indian red"))
1241     (t
1242      (:bold t)))
1243   "Face for highlighting folders in MH-Index buffers."
1244   :group 'mh)
1245
1246 (eval-after-load "font-lock"
1247   '(progn
1248      (defvar mh-index-folder-face 'mh-index-folder-face
1249        "Face for highlighting folders in MH-Index buffers.")
1250
1251      (defvar mh-index-font-lock-keywords
1252        (list
1253         ;; Folder name
1254         (list "^\\+.*" '(0 mh-index-folder-face))
1255         ;; Marked for deletion
1256         (list (concat mh-scan-deleted-msg-regexp ".*")
1257               '(0 mh-folder-deleted-face))
1258         ;; Marked for refile
1259         (list (concat mh-scan-refiled-msg-regexp ".*")
1260               '(0 mh-folder-refiled-face))
1261         ;;after subj
1262         (list mh-scan-body-regexp '(1 mh-folder-body-face nil t))
1263         '(mh-folder-font-lock-subject
1264           (1 mh-folder-followup-face append t)
1265           (2 mh-folder-subject-face append t))
1266         ;;current msg
1267         (list mh-scan-cur-msg-number-regexp
1268               '(1 mh-folder-cur-msg-number-face))
1269         (list mh-scan-good-msg-regexp
1270               '(1 mh-folder-msg-number-face))  ;; Msg number
1271         (list mh-scan-date-regexp '(1 mh-folder-date-face))       ;; Date
1272         (list mh-scan-rcpt-regexp
1273               '(1 mh-folder-to-face)                              ;; To:
1274               '(2 mh-folder-address-face))                        ;; address
1275         ;; scan font-lock name
1276         (list mh-scan-format-regexp
1277               '(1 mh-folder-date-face)
1278               '(3 mh-folder-scan-format-face))
1279         ;; Current message line
1280         (list mh-scan-cur-msg-regexp
1281               '(1 mh-folder-cur-msg-face prepend t)))
1282        "Regexp keywords used to fontify the MH-Index-Folder buffer.")))
1283
1284 (provide 'mh-index)
1285
1286 ;;; Local Variables:
1287 ;;; sentence-end-double-space: nil
1288 ;;; End:
1289
1290 ;;; mh-index ends here