comparison lisp/mh-e/mh-index.el @ 50702:7dd3d5eae9c7

Upgraded to MH-E version 7.3. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.

50701:cb5f0a5d5b36

;;; mh-index  --  MH-E interface to indexing programs

;; Copyright (C) 2002 Free Software Foundation, Inc.

;; Author: Satyaki Das <[e-mail]>
;; Maintainer: Bill Wohler <[e-mail]>
;; Keywords: mail
;; See: mh-e.el

;;; Commentary:

;;;  (1) The following search engines are supported:
;;;        swish++
;;;        swish-e
;;;        namazu
;;;        glimpse
;;;        grep
;;;
;;;  (2) To use this package, you first have to build an index. Please read
;;;      the documentation for `mh-index-search' to get started. That
;;;      documentation will direct you to the specific instructions for your
;;;      particular indexer.

;;; Change Log:

;; $Id: mh-index.el,v 1.2 2003/02/03 20:55:30 wohler Exp $

;;; Code:

(require 'cl)
(require 'mh-e)

  "Partial imitation of xargs.
The current buffer contains a list of strings, one on each line. The function
will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
strings to it. This is repeated till all the strings have been used."
  (goto-char (point-min))
  (let ((out (get-buffer-create " *mh-xargs-output*")))
    (save-excursion
      (set-buffer out)
      (erase-buffer))
    (while (not (eobp))
      (let ((arg-list (reverse args))
            (count 0))
        (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
          (push (buffer-substring-no-properties (point) (line-end-position))
                arg-list)
          (incf count)
          (forward-line))
        (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
    (erase-buffer)
    (insert-buffer-substring out)))



(defun mh-index-update-single-msg (msg checksum origin-map)
  "Update various maps for one message.

        (while (not (eobp))
          (setq msg (buffer-substring-no-properties
                     (point) (line-end-position)))
          (forward-line)
          (save-excursion
            (cond ((eolp)
                   ;; need to compute checksum
                   (set-buffer mh-checksum-buffer)
                   (insert mh-user-path (substring folder 1) "/" msg "\n"))
                  (t
                   ;; update maps

            (save-excursion
              (set-buffer folder)
              (mh-index-update-single-msg msg checksum origin-map)))
          (forward-line))))))

(defun mh-index-generate-pretty-name (string)
  "Given STRING generate a name which is suitable for use as a folder name.
White space from the beginning and end are removed. All spaces in the name are
replaced with underscores and all / are replaced with $. If STRING is longer
than 20 it is truncated too. STRING could be a list of strings in which case

    (subst-char-in-region (point-min) (point-max) ?  ?_ t)
    (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
    (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
    (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
    (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
    (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))

;;;###mh-autoload
(defun* mh-index-search (redo-search-flag folder search-regexp
                        &optional window-config)
  "Perform an indexed search in an MH mail folder.

If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
index search, then the search is repeated. Otherwise, FOLDER is searched with
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
stores the window configuration that will be restored after the user quits the
folder containing the index search results.

Four indexing programs are supported; if none of these are present, then grep
is used. This function picks the first program that is available on your
system. If you would prefer to use a different program, set the customization
variable `mh-index-program' accordingly.

      ;; Parse indexer output
      (message "Processing %s output... " mh-indexer)
      (goto-char (point-min))
      (loop for next-result = (funcall mh-index-next-result-function)
            when (null next-result) return nil
            do (unless (eq next-result 'error)
                 (unless (gethash (car next-result) folder-results-map)
                   (setf (gethash (car next-result) folder-results-map)
                         (make-hash-table :test #'equal)))
                 (setf (gethash (cadr next-result)

                           do (incf result-count)
                           (setf (gethash result-count origin-map)
                                 (cons folder msg)))))
               folder-results-map)

      ;; Generate scan lines for the hits.
      (let ((mh-show-threads-flag nil))
        (mh-visit-folder index-folder () (list folder-results-map origin-map)))

      (goto-char (point-min))
      (forward-line)
      (mh-update-sequences)
      (mh-recenter nil)

  "Jump to the next folder marker.
The function is only applicable to folders displaying index search results.
With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
results."
  (interactive "P")
  (if (or (null mh-index-data)
          (memq 'unthread mh-view-ops))
      (message "Only applicable in an unthreaded MH-E index search buffer")
    (let ((point (point)))
      (forward-line (if backward-flag -1 1))
      (cond ((if backward-flag
                 (re-search-backward "^+" (point-min) t)
               (re-search-forward "^+" (point-max) t))

      (forward-line))
    (when cur-msg (mh-goto-msg cur-msg t))
    (set-buffer-modified-p old-buffer-modified-flag)))

;;;###mh-autoload
(defun mh-index-delete-folder-headers ()
  "Delete the folder headers."
  (let ((cur-msg (mh-get-msg-num nil))
        (old-buffer-modified-flag (buffer-modified-p))
        (buffer-read-only nil))

                           (line-beginning-position) (line-end-position))))
            (t (setq msg (mh-get-msg-num t)))))
    (when (not folder)
      (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
                                 mh-index-checksum-origin-map))))
    (mh-visit-folder
     folder (loop for x being the hash-keys of (gethash folder mh-index-data)
                  when (mh-msg-exists-p x folder) collect x))))

(defun mh-index-match-checksum (msg folder checksum)
  "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
  (with-temp-buffer
    (mh-exec-cmd-output mh-scan-prog nil "-width" "80"

  (prog1
      (block nil
        (when (or (eobp) (and (bolp) (eolp)))
          (return nil))
        (unless (eq (char-after) ?/)
          (return error))
        (let ((start (point))
              end msg-start)
          (setq end (line-end-position))
          (unless (search-forward mh-mairix-folder end t)
            (return 'error))

                                                (cdadr expr)))))
        ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
                                `(and ,@(mapcar #'(lambda (x) `(not ,x))
                                                (cdadr expr)))))
        (t (error "Unreachable: %s" expr))))



;; Swish interface

(defalias 'mh-swish++-next-result 'mh-swish-next-result)

(defun mh-swish++-regexp-builder (regexp-list)
  "Generate query for swish++.
REGEXP-LIST is an alist of fields and values."
  (let ((regexp "") meta)
    (dolist (elem regexp-list)
      (when (cdr elem)
        (setq regexp (concat regexp " and "
                             (if (car elem) "(" "")
                             (if (car elem) (symbol-name (car elem)) "")

                  nil))))
    (forward-line)))



(defun mh-index-choose ()
  "Choose an indexing function.
The side-effects of this function are that the variables `mh-indexer',
`mh-index-execute-search-function', and `mh-index-next-result-function' are
set according to the first indexer in `mh-indexer-choices' present on the

50702:7dd3d5eae9c7

;;; mh-index  --  MH-E interface to indexing programs

;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.

;; Author: Satyaki Das <[e-mail]>
;; Maintainer: Bill Wohler <[e-mail]>
;; Keywords: mail
;; See: mh-e.el

;;; Commentary:

;;;  (1) The following search engines are supported:
;;;        swish++
;;;        swish-e
;;;        mairix
;;;        namazu
;;;        glimpse
;;;        grep
;;;
;;;  (2) To use this package, you first have to build an index. Please read
;;;      the documentation for `mh-index-search' to get started. That
;;;      documentation will direct you to the specific instructions for your
;;;      particular indexer.

;;; Change Log:

;;; Code:

(require 'cl)
(require 'mh-e)

  "Partial imitation of xargs.
The current buffer contains a list of strings, one on each line. The function
will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
strings to it. This is repeated till all the strings have been used."
  (goto-char (point-min))
  (let ((current-buffer (current-buffer)))
    (with-temp-buffer
      (let ((out (current-buffer)))
        (set-buffer current-buffer)
        (while (not (eobp))
          (let ((arg-list (reverse args))
                (count 0))
            (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
              (push (buffer-substring-no-properties (point) (line-end-position))
                    arg-list)
              (incf count)
              (forward-line))
            (apply #'call-process cmd nil (list out nil) nil
                   (nreverse arg-list))))
        (erase-buffer)
        (insert-buffer-substring out)))))



(defun mh-index-update-single-msg (msg checksum origin-map)
  "Update various maps for one message.

        (while (not (eobp))
          (setq msg (buffer-substring-no-properties
                     (point) (line-end-position)))
          (forward-line)
          (save-excursion
            (cond ((not (string-match "^[0-9]*$" msg)))
                  ((eolp)
                   ;; need to compute checksum
                   (set-buffer mh-checksum-buffer)
                   (insert mh-user-path (substring folder 1) "/" msg "\n"))
                  (t
                   ;; update maps

            (save-excursion
              (set-buffer folder)
              (mh-index-update-single-msg msg checksum origin-map)))
          (forward-line))))))

(defvar mh-flists-results-folder "new"
  "Subfolder for `mh-index-folder' where flists output is placed.")

(defun mh-index-generate-pretty-name (string)
  "Given STRING generate a name which is suitable for use as a folder name.
White space from the beginning and end are removed. All spaces in the name are
replaced with underscores and all / are replaced with $. If STRING is longer
than 20 it is truncated too. STRING could be a list of strings in which case

    (subst-char-in-region (point-min) (point-max) ?  ?_ t)
    (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
    (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
    (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
    (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
    (let ((out (truncate-string-to-width (buffer-string) 20)))
      (cond ((eq mh-indexer 'flists) mh-flists-results-folder)
            ((equal out mh-flists-results-folder) (concat out "1"))
            (t out)))))

;;;###mh-autoload
(defun* mh-index-search (redo-search-flag folder search-regexp
                        &optional window-config unseen-flag)
  "Perform an indexed search in an MH mail folder.
Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.

If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
index search, then the search is repeated. Otherwise, FOLDER is searched with
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
stores the window configuration that will be restored after the user quits the
folder containing the index search results. If optional argument UNSEEN-FLAG
is non-nil, then all the messages are marked as unseen.

Four indexing programs are supported; if none of these are present, then grep
is used. This function picks the first program that is available on your
system. If you would prefer to use a different program, set the customization
variable `mh-index-program' accordingly.

      ;; Parse indexer output
      (message "Processing %s output... " mh-indexer)
      (goto-char (point-min))
      (loop for next-result = (funcall mh-index-next-result-function)
            while next-result
            do (unless (eq next-result 'error)
                 (unless (gethash (car next-result) folder-results-map)
                   (setf (gethash (car next-result) folder-results-map)
                         (make-hash-table :test #'equal)))
                 (setf (gethash (cadr next-result)

                           do (incf result-count)
                           (setf (gethash result-count origin-map)
                                 (cons folder msg)))))
               folder-results-map)

      ;; Mark messages as unseen (if needed)
      (when (and unseen-flag (> result-count 0))
        (mh-exec-cmd "mark" index-folder "all"
                     "-sequence" (symbol-name mh-unseen-seq) "-add"))

      ;; Generate scan lines for the hits.
      (mh-visit-folder index-folder () (list folder-results-map origin-map))

      (goto-char (point-min))
      (forward-line)
      (mh-update-sequences)
      (mh-recenter nil)

  "Jump to the next folder marker.
The function is only applicable to folders displaying index search results.
With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
results."
  (interactive "P")
  (if (null mh-index-data)
      (message "Only applicable in an MH-E index search buffer")
    (let ((point (point)))
      (forward-line (if backward-flag -1 1))
      (cond ((if backward-flag
                 (re-search-backward "^+" (point-min) t)
               (re-search-forward "^+" (point-max) t))

      (forward-line))
    (when cur-msg (mh-goto-msg cur-msg t))
    (set-buffer-modified-p old-buffer-modified-flag)))

;;;###mh-autoload
(defun mh-index-group-by-folder ()
  "Partition the messages based on source folder.
Returns an alist with the the folder names in the car and the cdr being the
list of messages originally from that folder."
  (save-excursion
    (goto-char (point-min))
    (let ((result-table (make-hash-table)))
      (loop for msg being hash-keys of mh-index-msg-checksum-map
            do (push msg (gethash (car (gethash
                                        (gethash msg mh-index-msg-checksum-map)
                                        mh-index-checksum-origin-map))
                                  result-table)))
      (loop for x being the hash-keys of result-table
            collect (cons x (nreverse (gethash x result-table)))))))

;;;###mh-autoload
(defun mh-index-delete-folder-headers ()
  "Delete the folder headers."
  (let ((cur-msg (mh-get-msg-num nil))
        (old-buffer-modified-flag (buffer-modified-p))
        (buffer-read-only nil))

                           (line-beginning-position) (line-end-position))))
            (t (setq msg (mh-get-msg-num t)))))
    (when (not folder)
      (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
                                 mh-index-checksum-origin-map))))
    (when (or (not (get-buffer folder))
              (y-or-n-p (format "Reuse buffer displaying %s? " folder)))
      (mh-visit-folder
       folder (loop for x being the hash-keys of (gethash folder mh-index-data)
                    when (mh-msg-exists-p x folder) collect x)))))

;;;###mh-autoload
(defun mh-index-update-unseen (msg)
  "Remove counterpart of MSG in source folder from `mh-unseen-seq'.
Also `mh-update-unseen' is called in the original folder, if we have it open."
  (let* ((checksum (gethash msg mh-index-msg-checksum-map))
         (folder-msg-pair (gethash checksum mh-index-checksum-origin-map))
         (orig-folder (car folder-msg-pair))
         (orig-msg (cdr folder-msg-pair)))
    (when (mh-index-match-checksum orig-msg orig-folder checksum)
      (when (get-buffer orig-folder)
        (save-excursion
          (set-buffer orig-folder)
          (unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))
          (mh-update-unseen)))
      (mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)
                          "-sequence" (symbol-name mh-unseen-seq) "-del"))))

(defun mh-index-match-checksum (msg folder checksum)
  "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
  (with-temp-buffer
    (mh-exec-cmd-output mh-scan-prog nil "-width" "80"

  (prog1
      (block nil
        (when (or (eobp) (and (bolp) (eolp)))
          (return nil))
        (unless (eq (char-after) ?/)
          (return 'error))
        (let ((start (point))
              end msg-start)
          (setq end (line-end-position))
          (unless (search-forward mh-mairix-folder end t)
            (return 'error))

                                                (cdadr expr)))))
        ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
                                `(and ,@(mapcar #'(lambda (x) `(not ,x))
                                                (cdadr expr)))))
        (t (error "Unreachable: %s" expr))))



;; Interface to unseen messages script

(defvar mh-flists-search-folders)

(defun mh-flists-execute (&rest args)
  "Search for unseen messages in `mh-flists-search-folders'.
If `mh-recursive-folders-flag' is t, then the folders are searched
recursively. All parameters ARGS are ignored."
  (set-buffer (get-buffer-create mh-index-temp-buffer))
  (erase-buffer)
  (unless (executable-find "sh")
    (error "Didn't find sh"))
  (with-temp-buffer
    (let ((unseen (symbol-name mh-unseen-seq)))
      (insert "for folder in `flists "
              (cond ((eq mh-flists-search-folders t) mh-inbox)
                    ((eq mh-flists-search-folders nil) "")
                    ((listp mh-flists-search-folders)
                     (loop for folder in mh-flists-search-folders
                           concat (concat " " folder))))
              (if mh-recursive-folders-flag " -recurse" "")
              " -sequence " unseen " -noshowzero -fast` ; do\n"
              "mhpath \"+$folder\" " unseen "\n" "done\n"))
    (call-process-region
     (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer))))

;;;###mh-autoload
(defun mh-index-new-messages (folders)
  "Display new messages.
All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-new-messages-folders' are
searched. With a prefix argument, enter a space-separated list of folders, or
nothing to search all folders."
  (interactive
   (list (if current-prefix-arg
             (split-string (read-string "Folders to search: "))
           mh-index-new-messages-folders)))
  (let* ((mh-flists-search-folders folders)
         (mh-indexer 'flists)
         (mh-index-execute-search-function 'mh-flists-execute)
         (mh-index-next-result-function 'mh-mairix-next-result)
         (mh-mairix-folder mh-user-path)
         (mh-index-regexp-builder nil)
         (new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder))
         (window-config (if (equal new-folder mh-current-folder)
                            mh-previous-window-config
                          (current-window-configuration)))
         (redo-flag nil))
    (cond ((buffer-live-p (get-buffer new-folder))
           ;; The destination folder is being visited. Trick `mh-index-search'
           ;; into thinking that the folder was the result of a previous search.
           (set-buffer new-folder)
           (setq mh-index-previous-search (list "+" mh-flists-results-folder))
           (setq redo-flag t))
          ((mh-folder-exists-p new-folder)
           ;; Folder exists but we don't have it open. That means they are
           ;; stale results from a old flists search. Clear it out.
           (mh-exec-cmd-quiet nil "rmf" new-folder)))
    (mh-index-search redo-flag "+" mh-flists-results-folder window-config t)))



;; Swish interface

(defalias 'mh-swish++-next-result 'mh-swish-next-result)

(defun mh-swish++-regexp-builder (regexp-list)
  "Generate query for swish++.
REGEXP-LIST is an alist of fields and values."
  (let ((regexp ""))
    (dolist (elem regexp-list)
      (when (cdr elem)
        (setq regexp (concat regexp " and "
                             (if (car elem) "(" "")
                             (if (car elem) (symbol-name (car elem)) "")

                  nil))))
    (forward-line)))



;;;###mh-autoload
(defun mh-index-choose ()
  "Choose an indexing function.
The side-effects of this function are that the variables `mh-indexer',
`mh-index-execute-search-function', and `mh-index-next-result-function' are
set according to the first indexer in `mh-indexer-choices' present on the