[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-index.el [gnus-5_10-branch]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-index.el [gnus-5_10-branch] |
Date: |
Sat, 04 Sep 2004 08:22:56 -0400 |
Index: emacs/lisp/mh-e/mh-index.el
diff -c /dev/null emacs/lisp/mh-e/mh-index.el:1.6.2.1
*** /dev/null Sat Sep 4 12:01:54 2004
--- emacs/lisp/mh-e/mh-index.el Sat Sep 4 12:01:04 2004
***************
*** 0 ****
--- 1,1622 ----
+ ;;; mh-index -- MH-E interface to indexing programs
+
+ ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+ ;; Author: Satyaki Das <address@hidden>
+ ;; Maintainer: Bill Wohler <address@hidden>
+ ;; Keywords: mail
+ ;; See: mh-e.el
+
+ ;; This file is part of GNU Emacs.
+
+ ;; GNU Emacs is free software; you can redistribute it and/or modify
+ ;; it under the terms of the GNU General Public License as published by
+ ;; the Free Software Foundation; either version 2, or (at your option)
+ ;; any later version.
+
+ ;; GNU Emacs is distributed in the hope that it will be useful,
+ ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ ;; GNU General Public License for more details.
+
+ ;; You should have received a copy of the GNU General Public License
+ ;; along with GNU Emacs; see the file COPYING. If not, write to the
+ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ ;; Boston, MA 02111-1307, USA.
+
+ ;;; Commentary:
+
+ ;;; (1) The following search engines are supported:
+ ;;; swish++
+ ;;; swish-e
+ ;;; mairix
+ ;;; namazu
+ ;;; 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:
+
+ (eval-when-compile (require 'mh-acros))
+ (mh-require-cl)
+ (require 'mh-e)
+ (require 'mh-mime)
+ (require 'mh-pick)
+
+ (autoload 'gnus-local-map-property "gnus-util")
+ (autoload 'gnus-eval-format "gnus-spec")
+ (autoload 'widget-convert-button "wid-edit")
+ (autoload 'executable-find "executable")
+
+ ;; Support different indexing programs
+ (defvar mh-indexer-choices
+ '((swish++
+ mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result
+ mh-swish++-regexp-builder)
+ (swish
+ mh-swish-binary mh-swish-execute-search mh-swish-next-result nil)
+ (mairix
+ mh-mairix-binary mh-mairix-execute-search mh-mairix-next-result
+ mh-mairix-regexp-builder)
+ (namazu
+ mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
+ (pick
+ mh-pick-binary mh-pick-execute-search mh-pick-next-result
+ mh-pick-regexp-builder)
+ (grep
+ mh-grep-binary mh-grep-execute-search mh-grep-next-result nil))
+ "List of possible indexer choices.")
+ (defvar mh-indexer nil
+ "Chosen index program.")
+ (defvar mh-index-execute-search-function nil
+ "Function which executes the search program.")
+ (defvar mh-index-next-result-function nil
+ "Function to parse the next line of output.")
+ (defvar mh-index-regexp-builder nil
+ "Function used to construct search regexp.")
+
+ ;; FIXME: This should be a defcustom...
+ (defvar mh-index-folder "+mhe-index"
+ "Folder that contains the folders resulting from the index searches.")
+
+ ;; Temporary buffers for search results
+ (defvar mh-index-temp-buffer " *mh-index-temp*")
+ (defvar mh-checksum-buffer " *mh-checksum-buffer*")
+
+
+
+ ;;; A few different checksum programs are supported. The supported programs
+ ;;; are:
+ ;;; 1. md5sum
+ ;;; 2. md5
+ ;;; 3. openssl
+ ;;;
+ ;;; To add support for your favorite checksum program add a clause to the cond
+ ;;; statement in mh-checksum-choose. This should set the variable
+ ;;; mh-checksum-cmd to the command line needed to run the checsum program and
+ ;;; should set mh-checksum-parser to a function which returns a cons cell
+ ;;; containing the message number and checksum string.
+
+ (defvar mh-checksum-cmd)
+ (defvar mh-checksum-parser)
+
+ (defun mh-checksum-choose ()
+ "Check if a program to create a checksum is present."
+ (unless (boundp 'mh-checksum-cmd)
+ (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
+ (cond ((executable-find "md5sum")
+ (setq mh-checksum-cmd (list (executable-find "md5sum")))
+ (setq mh-checksum-parser #'mh-md5sum-parser))
+ ((executable-find "openssl")
+ (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
+ (setq mh-checksum-parser #'mh-openssl-parser))
+ ((executable-find "md5")
+ (setq mh-checksum-cmd (list (executable-find "md5")))
+ (setq mh-checksum-parser #'mh-md5-parser))
+ (t (error "No suitable checksum program"))))))
+
+ (defun mh-md5sum-parser ()
+ "Parse md5sum output."
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
+ first-space last-slash)
+ (setq first-space (search-forward " " end t))
+ (goto-char end)
+ (setq last-slash (search-backward "/" begin t))
+ (cond ((and first-space last-slash)
+ (cons (car (read-from-string (buffer-substring-no-properties
+ (1+ last-slash) end)))
+ (buffer-substring-no-properties begin (1- first-space))))
+ (t (cons nil nil)))))
+
+ (defun mh-openssl-parser ()
+ "Parse openssl output."
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
+ last-space last-slash)
+ (goto-char end)
+ (setq last-space (search-backward " " begin t))
+ (setq last-slash (search-backward "/" begin t))
+ (cond ((and last-slash last-space)
+ (cons (car (read-from-string (buffer-substring-no-properties
+ (1+ last-slash) (1- last-space))))
+ (buffer-substring-no-properties (1+ last-space) end))))))
+
+ (defalias 'mh-md5-parser 'mh-openssl-parser)
+
+
+
+ ;;; Make sure that we don't produce too long a command line.
+
+ (defvar mh-index-max-cmdline-args 500
+ "Maximum number of command line args.")
+
+ (defun mh-index-execute (cmd &rest args)
+ "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.
+ MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
+ non-nil, a hashtable containing which maps each message in the index folder to
+ the folder and message that it was copied from. The function updates the hash
+ tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
+
+ This function should only be called in the appropriate index folder buffer."
+ (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
+ (let* ((intermediate (gethash msg origin-map))
+ (ofolder (car intermediate))
+ (omsg (cdr intermediate)))
+ ;; This is most probably a duplicate. So eliminate it.
+ (call-process "rm" nil nil nil
+ (format "%s%s/%s" mh-user-path
+ (substring mh-current-folder 1) msg))
+ (when (gethash ofolder mh-index-data)
+ (remhash omsg (gethash ofolder mh-index-data)))))
+ (t
+ (setf (gethash msg mh-index-msg-checksum-map) checksum)
+ (when origin-map
+ (setf (gethash checksum mh-index-checksum-origin-map)
+ (gethash msg origin-map))))))
+
+ ;;;###mh-autoload
+ (defun mh-index-update-maps (folder &optional origin-map)
+ "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
+ As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
+ is a hashtable which maps each message in the index folder to the original
+ folder and message from whence it was copied. If present the
+ checksum -> (origin-folder, origin-index) map is updated too."
+ (clrhash mh-index-msg-checksum-map)
+ (save-excursion
+ ;; Clear temp buffer
+ (set-buffer (get-buffer-create mh-checksum-buffer))
+ (erase-buffer)
+ ;; Run scan to check if any messages needs MD5 annotations at all
+ (with-temp-buffer
+ (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
+ "-format" "%(msg)\n%{x-mhe-checksum}\n"
+ folder "all")
+ (goto-char (point-min))
+ (let (msg checksum)
+ (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
+ (setq checksum (buffer-substring-no-properties
+ (point) (line-end-position)))
+ (let ((msg (car (read-from-string msg))))
+ (set-buffer folder)
+ (mh-index-update-single-msg msg checksum origin-map)))))
+ (forward-line))))
+ ;; Run checksum program if needed
+ (unless (and (eobp) (bobp))
+ (apply #'mh-index-execute mh-checksum-cmd)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((intermediate (funcall mh-checksum-parser))
+ (msg (car intermediate))
+ (checksum (cdr intermediate)))
+ (when msg
+ ;; annotate
+ (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
+ "-nodate" "-text" checksum "-inplace")
+ ;; update maps
+ (save-excursion
+ (set-buffer folder)
+ (mh-index-update-single-msg msg checksum origin-map)))
+ (forward-line)))))
+ (mh-index-write-data))
+
+ (defvar mh-unpropagated-sequences '(cur range subject search)
+ "List of sequences that aren't preserved.")
+
+ (defun mh-unpropagated-sequences ()
+ "Return a list of sequences that aren't propagated to the source folders.
+ It is just the sequences in the variable `mh-unpropagated-sequences' in
+ addition to the Previous-Sequence (see mh-profile 5)."
+ (if mh-previous-seq
+ (cons mh-previous-seq mh-unpropagated-sequences)
+ mh-unpropagated-sequences))
+
+ ;;;###mh-autoload
+ (defun mh-create-sequence-map (seq-list)
+ "Return a map from msg number to list of sequences in which it is present.
+ SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the
+ list of messages in that sequence."
+ (loop with map = (make-hash-table)
+ for seq in seq-list
+ when (and (not (memq (car seq) (mh-unpropagated-sequences)))
+ (mh-valid-seq-p (car seq)))
+ do (loop for msg in (cdr seq)
+ do (push (car seq) (gethash msg map)))
+ finally return map))
+
+ ;;;###mh-autoload
+ (defun mh-index-create-sequences ()
+ "Mirror sequences present in source folders in index folder."
+ (let ((seq-hash (make-hash-table :test #'equal))
+ (seq-list ()))
+ (loop for folder being the hash-keys of mh-index-data
+ do (setf (gethash folder seq-hash)
+ (mh-create-sequence-map
+ (mh-read-folder-sequences folder nil))))
+ (dolist (msg (mh-translate-range mh-current-folder "all"))
+ (let* ((checksum (gethash msg mh-index-msg-checksum-map))
+ (pair (gethash checksum mh-index-checksum-origin-map))
+ (ofolder (car pair))
+ (omsg (cdr pair)))
+ (loop for seq in (ignore-errors
+ (gethash omsg (gethash ofolder seq-hash)))
+ do (if (assoc seq seq-list)
+ (push msg (cdr (assoc seq seq-list)))
+ (push (list seq msg) seq-list)))))
+ (loop for seq in seq-list
+ do (apply #'mh-exec-cmd "mark" mh-current-folder
+ "-sequence" (symbol-name (car seq)) "-add"
+ (mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
+
+ (defvar mh-flists-results-folder "sequence"
+ "Subfolder for `mh-index-folder' where flists output is placed.")
+ (defvar mh-flists-sequence)
+ (defvar mh-flists-called-flag nil)
+
+ (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
+ they are concatenated to construct the base name."
+ (with-temp-buffer
+ (if (stringp string)
+ (insert string)
+ (when (car string) (insert (car string)))
+ (dolist (s (cdr string))
+ (insert "_" s)))
+ (setq string (mh-replace-string "-lbrace" " "))
+ (setq string (mh-replace-string "-rbrace" " "))
+ (subst-char-in-region (point-min) (point-max) ?( ? t)
+ (subst-char-in-region (point-min) (point-max) ?) ? t)
+ (subst-char-in-region (point-min) (point-max) ?- ? t)
+ (goto-char (point-min))
+ (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_)))
+ (delete-char 1))
+ (goto-char (point-max))
+ (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_)))
+ (delete-backward-char 1))
+ (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)
+ (format "%s/%s" mh-flists-results-folder mh-flists-sequence))
+ ((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)
+ "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.
+
+ 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.
+
+ The documentation for the following functions describes how to generate the
+ index for each program:
+
+ - `mh-swish++-execute-search'
+ - `mh-swish-execute-search'
+ - `mh-mairix-execute-search'
+ - `mh-namazu-execute-search'
+
+ If none of these programs are present then we use pick. If desired grep can be
+ used instead. Details about these methods can be found in:
+
+ - `mh-pick-execute-search'
+ - `mh-grep-execute-search'
+
+ This and related functions use an X-MHE-Checksum header to cache the MD5
+ checksum of a message. This means that already present X-MHE-Checksum headers
+ in the incoming email could result in messages not being found. The following
+ procmail recipe should avoid this:
+
+ :0 wf
+ | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
+
+ This has the effect of renaming already present X-MHE-Checksum headers."
+ (interactive
+ (list current-prefix-arg
+ (progn
+ (unless mh-find-path-run (mh-find-path))
+ (or (and current-prefix-arg mh-index-sequence-search-flag)
+ (and current-prefix-arg (car mh-index-previous-search))
+ (mh-prompt-for-folder "Search" "+" nil "all" t)))
+ (progn
+ ;; Yes, we do want to call mh-index-choose every time in case the
+ ;; user has switched the indexer manually.
+ (unless (mh-index-choose) (error "No indexing program found"))
+ (or (and current-prefix-arg (cadr mh-index-previous-search))
+ mh-index-regexp-builder
+ (read-string (format "%s regexp: "
+ (upcase-initials
+ (symbol-name mh-indexer))))))
+ (if (and (not
+ (and current-prefix-arg (cadr mh-index-previous-search)))
+ mh-index-regexp-builder)
+ (current-window-configuration)
+ nil)))
+ ;; Redoing a sequence search?
+ (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag
+ (not mh-flists-called-flag))
+ (let ((mh-flists-called-flag t))
+ (apply #'mh-index-sequenced-messages mh-index-previous-search))
+ (return-from mh-index-search))
+ ;; We have fancy query parsing
+ (when (symbolp search-regexp)
+ (mh-search-folder folder window-config)
+ (setq mh-searching-function 'mh-index-do-search)
+ (return-from mh-index-search))
+ (mh-checksum-choose)
+ (let ((result-count 0)
+ (old-window-config (or window-config mh-previous-window-config))
+ (previous-search mh-index-previous-search)
+ (index-folder (format "%s/%s" mh-index-folder
+ (mh-index-generate-pretty-name search-regexp))))
+ ;; Create a new folder for the search results or recreate the old one...
+ (if (and redo-search-flag mh-index-previous-search)
+ (let ((buffer-name (buffer-name (current-buffer))))
+ (mh-process-or-undo-commands buffer-name)
+ (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
+ (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
+ (setq index-folder buffer-name))
+ (setq index-folder (mh-index-new-folder index-folder search-regexp)))
+
+ (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
+ (folder-results-map (make-hash-table :test #'equal))
+ (origin-map (make-hash-table :test #'equal)))
+ ;; Run search program...
+ (message "Executing %s... " mh-indexer)
+ (funcall mh-index-execute-search-function folder-path search-regexp)
+
+ ;; 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)
+ (gethash (car next-result)
folder-results-map))
+ t)))
+
+ ;; Copy the search results over
+ (maphash #'(lambda (folder msgs)
+ (let ((cur (car (mh-translate-range folder "cur")))
+ (msgs (sort (loop for msg being the hash-keys of msgs
+ collect msg)
+ #'<)))
+ (mh-exec-cmd "refile" msgs "-src" folder
+ "-link" index-folder)
+ ;; Restore cur to old value, that refile changed
+ (when cur
+ (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
+ "-sequence" "cur" (format "%s"
cur)))
+ (loop for msg in msgs
+ do (incf result-count)
+ (setf (gethash result-count origin-map)
+ (cons folder msg)))))
+ folder-results-map)
+
+ ;; Vist the results folder
+ (mh-visit-folder index-folder () (list folder-results-map origin-map))
+
+ (goto-char (point-min))
+ (forward-line)
+ (mh-update-sequences)
+ (mh-recenter nil)
+
+ ;; Update the speedbar, if needed
+ (when (mh-speed-flists-active-p)
+ (mh-speed-flists t mh-current-folder))
+
+ ;; Maintain history
+ (when (or (and redo-search-flag previous-search) window-config)
+ (setq mh-previous-window-config old-window-config))
+ (setq mh-index-previous-search (list folder search-regexp))
+
+ ;; Write out data to disk
+ (unless mh-flists-called-flag (mh-index-write-data))
+
+ (message "%s found %s matches in %s folders"
+ (upcase-initials (symbol-name mh-indexer))
+ (loop for msg-hash being hash-values of mh-index-data
+ sum (hash-table-count msg-hash))
+ (loop for msg-hash being hash-values of mh-index-data
+ count (> (hash-table-count msg-hash) 0))))))
+
+
+
+ ;;; Functions to serialize index data...
+
+ (defun mh-index-write-data ()
+ "Write index data to file."
+ (ignore-errors
+ (unless (eq major-mode 'mh-folder-mode)
+ (error "Can't be called from folder in `%s'" major-mode))
+ (let ((data mh-index-data)
+ (msg-checksum-map mh-index-msg-checksum-map)
+ (checksum-origin-map mh-index-checksum-origin-map)
+ (previous-search mh-index-previous-search)
+ (sequence-search-flag mh-index-sequence-search-flag)
+ (outfile (concat buffer-file-name mh-index-data-file))
+ (print-length nil)
+ (print-level nil))
+ (with-temp-file outfile
+ (mh-index-write-hashtable
+ data (lambda (x) (loop for y being the hash-keys of x collect y)))
+ (mh-index-write-hashtable msg-checksum-map #'identity)
+ (mh-index-write-hashtable checksum-origin-map #'identity)
+ (pp previous-search (current-buffer)) (insert "\n")
+ (pp sequence-search-flag (current-buffer)) (insert "\n")))))
+
+ ;;;###mh-autoload
+ (defun mh-index-read-data ()
+ "Read index data from file."
+ (ignore-errors
+ (unless (eq major-mode 'mh-folder-mode)
+ (error "Can't be called from folder in `%s'" major-mode))
+ (let ((infile (concat buffer-file-name mh-index-data-file))
+ t1 t2 t3 t4 t5)
+ (with-temp-buffer
+ (insert-file-contents-literally infile)
+ (goto-char (point-min))
+ (setq t1 (mh-index-read-hashtable
+ (lambda (data)
+ (loop with table = (make-hash-table :test #'equal)
+ for x in data do (setf (gethash x table) t)
+ finally return table)))
+ t2 (mh-index-read-hashtable #'identity)
+ t3 (mh-index-read-hashtable #'identity)
+ t4 (read (current-buffer))
+ t5 (read (current-buffer))))
+ (setq mh-index-data t1
+ mh-index-msg-checksum-map t2
+ mh-index-checksum-origin-map t3
+ mh-index-previous-search t4
+ mh-index-sequence-search-flag t5))))
+
+ (defun mh-index-write-hashtable (table proc)
+ "Write TABLE to `current-buffer'.
+ PROC is used to serialize the values corresponding to the hash table keys."
+ (pp (loop for x being the hash-keys of table
+ collect (cons x (funcall proc (gethash x table))))
+ (current-buffer))
+ (insert "\n"))
+
+ (defun mh-index-read-hashtable (proc)
+ "From BUFFER read a hash table serialized as a list.
+ PROC is used to convert the value to actual data."
+ (loop with table = (make-hash-table :test #'equal)
+ for pair in (read (current-buffer))
+ do (setf (gethash (car pair) table) (funcall proc (cdr pair)))
+ finally return table))
+
+ ;;;###mh-autoload
+ (defun mh-index-p ()
+ "Non-nil means that this folder was generated by an index search."
+ mh-index-data)
+
+ ;;;###mh-autoload
+ (defun mh-index-do-search ()
+ "Construct appropriate regexp and call `mh-index-search'."
+ (interactive)
+ (unless (mh-index-choose) (error "No indexing program found"))
+ (let* ((regexp-list (mh-pick-parse-search-buffer))
+ (pattern (funcall mh-index-regexp-builder regexp-list)))
+ (if pattern
+ (mh-index-search nil mh-current-folder pattern
+ mh-previous-window-config)
+ (error "No search terms"))))
+
+ ;;;###mh-autoload
+ (defun mh-index-parse-search-regexp (input-string)
+ "Construct parse tree for INPUT-STRING.
+ All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by AND, OR and
+ NOT as appropriate. Then the resulting string is parsed."
+ (let (input)
+ (with-temp-buffer
+ (insert input-string)
+ ;; replace tabs
+ (mh-replace-string "\t" " ")
+ ;; synonyms of AND
+ (mh-replace-string " AND " " and ")
+ (mh-replace-string "&" " and ")
+ (mh-replace-string " -and " " and ")
+ ;; synonyms of OR
+ (mh-replace-string " OR " " or ")
+ (mh-replace-string "|" " or ")
+ (mh-replace-string " -or " " or ")
+ ;; synonyms of NOT
+ (mh-replace-string " NOT " " not ")
+ (mh-replace-string "!" " not ")
+ (mh-replace-string "~" " not ")
+ (mh-replace-string " -not " " not ")
+ ;; synonyms of left brace
+ (mh-replace-string "(" " ( ")
+ (mh-replace-string " -lbrace " " ( ")
+ ;; synonyms of right brace
+ (mh-replace-string ")" " ) ")
+ (mh-replace-string " -rbrace " " ) ")
+ ;; get the normalized input
+ (setq input (format "( %s )" (buffer-substring (point-min)
(point-max)))))
+
+ (let ((tokens (mh-index-add-implicit-ops (split-string input)))
+ (op-stack ())
+ (operand-stack ())
+ oper1)
+ (dolist (token tokens)
+ (cond ((equal token "(") (push 'paren op-stack))
+ ((equal token "not") (push 'not op-stack))
+ ((equal token "or") (push 'or op-stack))
+ ((equal token "and") (push 'and op-stack))
+ ((equal token ")")
+ (multiple-value-setq (op-stack operand-stack)
+ (mh-index-evaluate op-stack operand-stack))
+ (when (eq (car op-stack) 'not)
+ (setq op-stack (cdr op-stack))
+ (push `(not ,(pop operand-stack)) operand-stack))
+ (when (eq (car op-stack) 'and)
+ (setq op-stack (cdr op-stack))
+ (setq oper1 (pop operand-stack))
+ (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
+ ((eq (car op-stack) 'not)
+ (setq op-stack (cdr op-stack))
+ (push `(not ,token) operand-stack)
+ (when (eq (car op-stack) 'and)
+ (setq op-stack (cdr op-stack))
+ (setq oper1 (pop operand-stack))
+ (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
+ ((eq (car op-stack) 'and)
+ (setq op-stack (cdr op-stack))
+ (push `(and ,(pop operand-stack) ,token) operand-stack))
+ (t (push token operand-stack))))
+ (prog1 (pop operand-stack)
+ (when (or op-stack operand-stack)
+ (error "Invalid regexp: %s" input))))))
+
+ (defun mh-index-add-implicit-ops (tokens)
+ "Add implicit operators in the list TOKENS."
+ (let ((result ())
+ (literal-seen nil)
+ current)
+ (while tokens
+ (setq current (pop tokens))
+ (cond ((or (equal current ")") (equal current "and") (equal current
"or"))
+ (setq literal-seen nil)
+ (push current result))
+ ((and literal-seen
+ (push "and" result)
+ (setq literal-seen nil)
+ nil))
+ (t
+ (push current result)
+ (unless (or (equal current "(") (equal current "not"))
+ (setq literal-seen t)))))
+ (nreverse result)))
+
+ (defun mh-index-evaluate (op-stack operand-stack)
+ "Read expression till starting paren based on OP-STACK and OPERAND-STACK."
+ (block mh-index-evaluate
+ (let (op oper1)
+ (while op-stack
+ (setq op (pop op-stack))
+ (cond ((eq op 'paren)
+ (return-from mh-index-evaluate (values op-stack
operand-stack)))
+ ((eq op 'not)
+ (push `(not ,(pop operand-stack)) operand-stack))
+ ((or (eq op 'and) (eq op 'or))
+ (setq oper1 (pop operand-stack))
+ (push `(,op ,(pop operand-stack) ,oper1) operand-stack))))
+ (error "Ran out of tokens"))))
+
+ ;;;###mh-autoload
+ (defun mh-index-next-folder (&optional backward-flag)
+ "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))
+ (beginning-of-line))
+ ((and (if backward-flag
+ (goto-char (point-max))
+ (goto-char (point-min)))
+ nil))
+ ((if backward-flag
+ (re-search-backward "^+" (point-min) t)
+ (re-search-forward "^+" (point-max) t))
+ (beginning-of-line))
+ (t (goto-char point))))))
+
+ ;;;###mh-autoload
+ (defun mh-index-previous-folder ()
+ "Jump to the previous folder marker."
+ (interactive)
+ (mh-index-next-folder t))
+
+ (defun mh-folder-exists-p (folder)
+ "Check if FOLDER exists."
+ (and (mh-folder-name-p folder)
+ (save-excursion
+ (with-temp-buffer
+ (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
+ (goto-char (point-min))
+ (not (eobp))))))
+
+ (defun mh-msg-exists-p (msg folder)
+ "Check if MSG exists in FOLDER."
+ (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
+
+ (defun mh-index-new-folder (name search-regexp)
+ "Return a folder name based on NAME for search results of SEARCH-REGEXP.
+
+ If folder NAME already exists and was generated for the same SEARCH-REGEXP
+ then it is reused.
+
+ Otherwise if the folder NAME was generated from a different search then check
+ if NAME<2> can be used. Otherwise try NAME<3>. This is repeated till we find a
+ new folder name.
+
+ If the folder returned doesn't exist then it is created."
+ (unless (mh-folder-name-p name)
+ (error "The argument should be a valid MH folder name"))
+ (let ((chosen-name
+ (loop for i from 1
+ for candidate = (if (equal i 1) name (format "%s<%s>" name i))
+ when (or (not (mh-folder-exists-p candidate))
+ (equal (mh-index-folder-search-regexp candidate)
+ search-regexp))
+ return candidate)))
+ ;; Do pending refiles/deletes...
+ (when (get-buffer chosen-name)
+ (mh-process-or-undo-commands chosen-name))
+ ;; Recreate folder...
+ (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name))
+ (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
+ (mh-remove-from-sub-folders-cache chosen-name)
+ (when (boundp 'mh-speed-folder-map)
+ (mh-speed-add-folder chosen-name))
+ chosen-name))
+
+ (defun mh-index-folder-search-regexp (folder)
+ "If FOLDER was created by a index search, return the search regexp.
+ Return nil if FOLDER doesn't exist or the .mhe_index file is garbled."
+ (ignore-errors
+ (with-temp-buffer
+ (insert-file-contents
+ (format "%s%s/%s" mh-user-path (substring folder 1)
mh-index-data-file))
+ (goto-char (point-min))
+ (forward-list 3)
+ (cadr (read (current-buffer))))))
+
+ ;;;###mh-autoload
+ (defun mh-index-insert-folder-headers ()
+ "Annotate the search results with original folder names."
+ (let ((cur-msg (mh-get-msg-num nil))
+ (old-buffer-modified-flag (buffer-modified-p))
+ (buffer-read-only nil)
+ current-folder last-folder)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
+ mh-index-msg-checksum-map)
+ mh-index-checksum-origin-map)))
+ (when (and current-folder (not (equal current-folder last-folder)))
+ (insert (if last-folder "\n" "") current-folder "\n")
+ (setq last-folder current-folder))
+ (forward-line))
+ (when cur-msg
+ (mh-notate-cur)
+ (mh-goto-msg cur-msg t))
+ (set-buffer-modified-p old-buffer-modified-flag))
+ (mh-index-create-imenu-index))
+
+ ;;;###mh-autoload
+ (defun mh-index-create-imenu-index ()
+ "Create alist of folder names and positions in index folder buffers."
+ (save-excursion
+ (setq which-func-mode t)
+ (let ((alist ()))
+ (goto-char (point-min))
+ (while (re-search-forward "^+" nil t)
+ (save-excursion
+ (beginning-of-line)
+ (push (cons (buffer-substring-no-properties
+ (point) (line-end-position))
+ (set-marker (make-marker) (point)))
+ alist)))
+ (setq imenu--index-alist (nreverse alist)))))
+
+ ;;;###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 :test #'equal)))
+ (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))
+ (while (and (not cur-msg) (not (eobp)))
+ (forward-line)
+ (setq cur-msg (mh-get-msg-num nil)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
+ (delete-region (point) (progn (forward-line) (point)))
+ (forward-line)))
+ (when cur-msg (mh-goto-msg cur-msg t t))
+ (set-buffer-modified-p old-buffer-modified-flag)))
+
+ ;;;###mh-autoload
+ (defun mh-index-visit-folder ()
+ "Visit original folder from where the message at point was found."
+ (interactive)
+ (unless mh-index-data
+ (error "Not in an index folder"))
+ (let (folder msg)
+ (save-excursion
+ (cond ((and (bolp) (eolp))
+ (ignore-errors (forward-line -1))
+ (setq msg (mh-get-msg-num t)))
+ ((equal (char-after (line-beginning-position)) ?+)
+ (setq folder (buffer-substring-no-properties
+ (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)))))
+
+ (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"
+ "-format" "%{x-mhe-checksum}\n" folder msg)
+ (goto-char (point-min))
+ (string-equal (buffer-substring-no-properties (point) (line-end-position))
+ checksum)))
+
+ (defun mh-index-matching-source-msgs (msgs &optional delete-from-index-data)
+ "Return a table of original messages and folders for messages in MSGS.
+ If optional argument DELETE-FROM-INDEX-DATA is non-nil, then each of the
+ messages, whose counter-part is found in some source folder, is removed from
+ `mh-index-data'."
+ (let ((table (make-hash-table :test #'equal)))
+ (dolist (msg msgs)
+ (let* ((checksum (gethash msg mh-index-msg-checksum-map))
+ (pair (gethash checksum mh-index-checksum-origin-map)))
+ (when (and checksum (car pair) (cdr pair)
+ (mh-index-match-checksum (cdr pair) (car pair) checksum))
+ (push (cdr pair) (gethash (car pair) table))
+ (when delete-from-index-data
+ (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
+ table))
+
+ ;;;###mh-autoload
+ (defun mh-index-execute-commands ()
+ "Delete/refile the actual messages.
+ The copies in the searched folder are then deleted/refiled to get the desired
+ result. Before deleting the messages we make sure that the message being
+ deleted is identical to the one that the user has marked in the index buffer."
+ (save-excursion
+ (let ((folders ())
+ (mh-speed-flists-inhibit-flag t))
+ (maphash
+ (lambda (folder msgs)
+ (push folder folders)
+ (if (not (get-buffer folder))
+ ;; If source folder not open, just delete the messages...
+ (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))
+ ;; Otherwise delete the messages in the source buffer...
+ (save-excursion
+ (set-buffer folder)
+ (let ((old-refile-list mh-refile-list)
+ (old-delete-list mh-delete-list))
+ (setq mh-refile-list nil
+ mh-delete-list msgs)
+ (unwind-protect (mh-execute-commands)
+ (setq mh-refile-list
+ (mapcar (lambda (x)
+ (cons (car x)
+ (loop for y in (cdr x)
+ unless (memq y msgs) collect y)))
+ old-refile-list)
+ mh-delete-list
+ (loop for x in old-delete-list
+ unless (memq x msgs) collect x))
+ (mh-set-folder-modified-p (mh-outstanding-commands-p))
+ (when (mh-outstanding-commands-p)
+ (mh-notate-deleted-and-refiled)))))))
+ (mh-index-matching-source-msgs (append (loop for x in mh-refile-list
+ append (cdr x))
+ mh-delete-list)
+ t))
+ folders)))
+
+ ;;;###mh-autoload
+ (defun mh-index-add-to-sequence (seq msgs)
+ "Add to SEQ the messages in the list MSGS.
+ This function updates the source folder sequences. Also makes an attempt to
+ update the source folder buffer if we have it open."
+ ;; Don't need to do anything for cur
+ (save-excursion
+ (when (and (not (memq seq (mh-unpropagated-sequences)))
+ (mh-valid-seq-p seq))
+ (let ((folders ())
+ (mh-speed-flists-inhibit-flag t))
+ (maphash (lambda (folder msgs)
+ (push folder folders)
+ ;; Add messages to sequence in source folder...
+ (apply #'mh-exec-cmd-quiet nil "mark" folder
+ "-add" "-nozero" "-sequence" (symbol-name seq)
+ (mapcar (lambda (x) (format "%s" x))
+ (mh-coalesce-msg-list msgs)))
+ ;; Update source folder buffer if we have it open...
+ (when (get-buffer folder)
+ (save-excursion
+ (set-buffer folder)
+ (mh-put-msg-in-seq msgs seq))))
+ (mh-index-matching-source-msgs msgs))
+ folders))))
+
+ ;;;###mh-autoload
+ (defun mh-index-delete-from-sequence (seq msgs)
+ "Delete from SEQ the messages in MSGS.
+ This function updates the source folder sequences. Also makes an attempt to
+ update the source folder buffer if present."
+ (save-excursion
+ (when (and (not (memq seq (mh-unpropagated-sequences)))
+ (mh-valid-seq-p seq))
+ (let ((folders ())
+ (mh-speed-flists-inhibit-flag t))
+ (maphash (lambda (folder msgs)
+ (push folder folders)
+ ;; Remove messages from sequence in source folder...
+ (apply #'mh-exec-cmd-quiet nil "mark" folder
+ "-del" "-nozero" "-sequence" (symbol-name seq)
+ (mapcar (lambda (x) (format "%s" x))
+ (mh-coalesce-msg-list msgs)))
+ ;; Update source folder buffer if we have it open...
+ (when (get-buffer folder)
+ (save-excursion
+ (set-buffer folder)
+ (mh-delete-msg-from-seq msgs seq t))))
+ (mh-index-matching-source-msgs msgs))
+ folders))))
+
+
+
+ ;; Pick interface
+
+ (defvar mh-index-pick-folder)
+ (defvar mh-pick-binary "pick")
+
+ (defun mh-pick-execute-search (folder-path search-regexp)
+ "Execute pick.
+
+ Unlike the other index search programs \"pick\" only searches messages present
+ in the folder itself and does not descend into any sub-folders that may be
+ present.
+
+ FOLDER-PATH is the directory containing the mails to be searched and
+ SEARCH-REGEXP is the pattern that pick gets."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (setq mh-index-pick-folder
+ (concat "+" (substring folder-path (length mh-user-path))))
+ (apply #'call-process (expand-file-name "pick" mh-progs) nil '(t nil) nil
+ mh-index-pick-folder "-list" search-regexp)
+ (goto-char (point-min)))
+
+ (defun mh-pick-next-result ()
+ "Return the next pick search result."
+ (prog1 (block nil
+ (when (eobp) (return nil))
+ (unless (re-search-forward "^[1-9][0-9]*$" (line-end-position) t)
+ (return 'error))
+ (list mh-index-pick-folder
+ (car (read-from-string (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))))
+ nil))
+ (forward-line)))
+
+
+
+ ;; Grep interface
+
+ (defvar mh-grep-binary (executable-find "grep"))
+
+ (defun mh-grep-execute-search (folder-path search-regexp)
+ "Execute grep and read the results.
+ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (call-process mh-grep-binary nil '(t nil) nil
+ "-i" "-r" search-regexp folder-path)
+ (goto-char (point-min)))
+
+ (defun mh-grep-next-result ()
+ "Read the next result.
+ Parse it and return the message folder, message index and the match. If no
+ other matches left then return nil. If the current record is invalid return
+ 'error."
+ (prog1
+ (block nil
+ (when (eobp)
+ (return nil))
+ (let ((eol-pos (line-end-position))
+ (bol-pos (line-beginning-position))
+ folder-start msg-end)
+ (goto-char bol-pos)
+ (unless (search-forward mh-user-path eol-pos t)
+ (return 'error))
+ (setq folder-start (point))
+ (unless (search-forward ":" eol-pos t)
+ (return 'error))
+ (let ((match (buffer-substring-no-properties (point) eol-pos)))
+ (forward-char -1)
+ (setq msg-end (point))
+ (unless (search-backward "/" folder-start t)
+ (return 'error))
+ (list (format "+%s" (buffer-substring-no-properties
+ folder-start (point)))
+ (let ((val (ignore-errors (read-from-string
+ (buffer-substring-no-properties
+ (1+ (point)) msg-end)))))
+ (if (and (consp val) (integerp (car val)))
+ (car val)
+ (return 'error)))
+ match))))
+ (forward-line)))
+
+
+
+ ;; Mairix interface
+
+ (defvar mh-mairix-binary (executable-find "mairix"))
+ (defvar mh-mairix-directory ".mairix")
+ (defvar mh-mairix-folder nil)
+
+ (defun mh-mairix-execute-search (folder-path search-regexp-list)
+ "Execute mairix and read the results.
+
+ In the examples below replace /home/user/Mail with the path to your MH
+ directory.
+
+ First create the directory /home/user/Mail/.mairix. Then create the file
+ /home/user/Mail/.mairix/config with the following contents:
+
+ # This should contain the same thing as your `mh-user-path'
+ base=/home/user/Mail
+
+ # List of folders that should be indexed. 3 dots at the end means there are
+ # subfolders within the folder
+ mh_folders=archive...:inbox:drafts:news:sent:trash
+
+ vfolder_format=raw
+ database=/home/user/Mail/mairix/database
+
+ Use the following command line to generate the mairix index. Run this daily
+ from cron:
+
+ mairix -f /home/user/Mail/.mairix/config
+
+ FOLDER-PATH is the directory in which SEARCH-REGEXP-LIST is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (unless mh-mairix-binary
+ (error "Set mh-mairix-binary appropriately"))
+ (apply #'call-process mh-mairix-binary nil '(t nil) nil
+ "-f" (format "%s%s/config" mh-user-path mh-mairix-directory)
+ search-regexp-list)
+ (goto-char (point-min))
+ (setq mh-mairix-folder
+ (let ((last-char (substring folder-path (1- (length folder-path)))))
+ (if (equal last-char "/")
+ folder-path
+ (format "%s/" folder-path)))))
+
+ (defun mh-mairix-next-result ()
+ "Return next result from mairix output."
+ (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))
+ (goto-char (match-beginning 0))
+ (unless (equal (point) start)
+ (return 'error))
+ (goto-char end)
+ (unless (search-backward "/" start t)
+ (return 'error))
+ (setq msg-start (1+ (point)))
+ (goto-char start)
+ (unless (search-forward mh-user-path end t)
+ (return 'error))
+ (list (format "+%s" (buffer-substring-no-properties
+ (point) (1- msg-start)))
+ (car (read-from-string
+ (buffer-substring-no-properties msg-start end)))
+ ())))
+ (forward-line)))
+
+ (defun mh-mairix-regexp-builder (regexp-list)
+ "Generate query for mairix.
+ REGEXP-LIST is an alist of fields and values."
+ (let ((result ()))
+ (dolist (pair regexp-list)
+ (when (cdr pair)
+ (push
+ (concat
+ (cond ((eq (car pair) 'to) "t:")
+ ((eq (car pair) 'from) "f:")
+ ((eq (car pair) 'cc) "c:")
+ ((eq (car pair) 'subject) "s:")
+ ((eq (car pair) 'date) "d:")
+ (t ""))
+ (let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair))))
+ (final ""))
+ (dolist (conjunct sop)
+ (let ((expr-list (cdr conjunct))
+ (expr-string ""))
+ (dolist (e expr-list)
+ (setq expr-string (concat expr-string "+"
+ (if (atom e) "" "~")
+ (if (atom e) e (cadr e)))))
+ (setq final (concat final "," (substring expr-string 1)))))
+ (substring final 1)))
+ result)))
+ result))
+
+ (defun mh-mairix-convert-to-sop* (expr)
+ "Convert EXPR to sum of product form."
+ (cond ((atom expr) `(or (and ,expr)))
+ ((eq (car expr) 'or)
+ (cons 'or
+ (loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr))
+ append (cdr e))))
+ ((eq (car expr) 'and)
+ (let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr)))
+ result next-factor)
+ (setq result (pop conjuncts))
+ (while conjuncts
+ (setq next-factor (pop conjuncts))
+ (setq result (let ((res ()))
+ (dolist (t1 (cdr result))
+ (dolist (t2 (cdr next-factor))
+ (push `(and ,@(cdr t1) ,@(cdr t2)) res)))
+ (cons 'or res))))
+ result))
+ ((atom (cadr expr)) `(or (and ,expr)))
+ ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr)))
+ ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop*
+ `(or ,@(mapcar #'(lambda (x) `(not ,x))
+ (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)
+
+ ;; XXX: This should probably be in mh-utils.el and used in other places where
+ ;; MH-E calls out to /bin/sh.
+ (defun mh-index-quote-for-shell (string)
+ "Quote STRING for /bin/sh."
+ (concat "\""
+ (loop for x across string
+ concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x))
+ "\""))
+
+ (defun mh-flists-execute (&rest args)
+ "Execute flists.
+ Search for messages belonging to `mh-flists-sequence' in the folders
+ specified by `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 ((seq (symbol-name mh-flists-sequence)))
+ (insert "for folder in `" (expand-file-name "flists" mh-progs) " "
+ (cond ((eq mh-flists-search-folders t)
+ (mh-index-quote-for-shell mh-inbox))
+ ((eq mh-flists-search-folders nil) "")
+ ((listp mh-flists-search-folders)
+ (loop for folder in mh-flists-search-folders
+ concat
+ (concat " " (mh-index-quote-for-shell folder)))))
+ (if mh-recursive-folders-flag " -recurse" "")
+ " -sequence " seq " -noshowzero -fast` ; do\n"
+ (expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n"
+ "done\n"))
+ (call-process-region
+ (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer))))
+
+ ;;;###mh-autoload
+ (defun mh-index-sequenced-messages (folders sequence)
+ "Display messages from FOLDERS in SEQUENCE.
+ All messages in the sequence you provide from the folders in
+ `mh-index-new-messages-folders' are listed. 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 "Search folder(s): [all] "))
+ mh-index-new-messages-folders)
+ (mh-read-seq-default "Search" nil)))
+ (unless sequence (setq sequence mh-unseen-seq))
+ (let* ((mh-flists-search-folders folders)
+ (mh-flists-sequence sequence)
+ (mh-flists-called-flag t)
+ (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/%s" mh-index-folder
+ mh-flists-results-folder sequence))
+ (window-config (if (equal new-folder mh-current-folder)
+ mh-previous-window-config
+ (current-window-configuration)))
+ (redo-flag nil)
+ message)
+ (cond ((buffer-live-p (get-buffer new-folder))
+ ;; The destination folder is being visited. Trick `mh-index-search'
+ ;; into thinking that the folder resulted from a previous search.
+ (set-buffer new-folder)
+ (setq mh-index-previous-search (list folders sequence))
+ (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)))
+ (setq message (mh-index-search redo-flag "+" mh-flists-results-folder
+ window-config)
+ mh-index-sequence-search-flag t
+ mh-index-previous-search (list folders sequence))
+ (mh-index-write-data)
+ (when (stringp message) (message message))))
+
+ ;;;###mh-autoload
+ (defun mh-index-new-messages (folders)
+ "Display unseen messages.
+ If you use a program such as `procmail' to use `rcvstore' to file your
+ incoming mail automatically, you can display new, unseen, messages using this
+ command. All messages in the `unseen' sequence from the folders in
+ `mh-index-new-messages-folders' are listed. 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 "Search folder(s): [all] "))
+ mh-index-new-messages-folders)))
+ (mh-index-sequenced-messages folders mh-unseen-seq))
+
+ ;;;###mh-autoload
+ (defun mh-index-ticked-messages (folders)
+ "Display ticked messages.
+ All messages in `mh-tick-seq' from the folders in
+ `mh-index-ticked-messages-folders' are listed. 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 "Search folder(s): [all] "))
+ mh-index-ticked-messages-folders)))
+ (mh-index-sequenced-messages folders mh-tick-seq))
+
+
+
+ ;; Swish interface
+
+ (defvar mh-swish-binary (executable-find "swish-e"))
+ (defvar mh-swish-directory ".swish")
+ (defvar mh-swish-folder nil)
+
+ ;;;###mh-autoload
+ (defun mh-swish-execute-search (folder-path search-regexp)
+ "Execute swish-e and read the results.
+
+ In the examples below, replace /home/user/Mail with the path to your MH
+ directory.
+
+ First create the directory /home/user/Mail/.swish. Then create the file
+ /home/user/Mail/.swish/config with the following contents:
+
+ IndexDir /home/user/Mail
+ IndexFile /home/user/Mail/.swish/index
+ IndexName \"Mail Index\"
+ IndexDescription \"Mail Index\"
+ IndexPointer \"http://nowhere\"
+ IndexAdmin \"nobody\"
+ #MetaNames automatic
+ IndexReport 3
+ FollowSymLinks no
+ UseStemming no
+ IgnoreTotalWordCountWhenRanking yes
+ WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
+ BeginCharacters abcdefghijklmnopqrstuvwxyz
+ EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
+ IgnoreLimit 50 1000
+ IndexComments 0
+ FileRules pathname contains /home/user/Mail/.swish
+ FileRules pathname contains /home/user/Mail/mhe-index
+ FileRules filename is index
+ FileRules filename is \\..*
+ FileRules filename is #.*
+ FileRules filename is ,.*
+ FileRules filename is .*~
+
+ If there are any directories you would like to ignore, append lines like the
+ following to config:
+
+ FileRules pathname contains /home/user/Mail/scripts
+
+ You do not want to index the folders that hold the results of your searches
+ since they tend to be ephemeral and the original messages are indexed anyway.
+ The configuration file above assumes that the results are found in sub-folders
+ of `mh-index-folder' which is +mhe-index by default.
+
+ Use the following command line to generate the swish index. Run this
+ daily from cron:
+
+ swish-e -c /home/user/Mail/.swish/config
+
+ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (unless mh-swish-binary
+ (error "Set mh-swish-binary appropriately"))
+ (call-process mh-swish-binary nil '(t nil) nil
+ "-w" search-regexp
+ "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
+ (goto-char (point-min))
+ (setq mh-swish-folder
+ (let ((last-char (substring folder-path (1- (length folder-path)))))
+ (if (equal last-char "/")
+ folder-path
+ (format "%s/" folder-path)))))
+
+ (defun mh-swish-next-result ()
+ "Get the next result from swish output."
+ (prog1
+ (block nil
+ (when (or (eobp) (equal (char-after (point)) ?.))
+ (return nil))
+ (when (equal (char-after (point)) ?#)
+ (return 'error))
+ (let* ((start (search-forward " " (line-end-position) t))
+ (end (search-forward " " (line-end-position) t)))
+ (unless (and start end)
+ (return 'error))
+ (setq end (1- end))
+ (unless (file-exists-p (buffer-substring-no-properties start end))
+ (return 'error))
+ (unless (search-backward "/" start t)
+ (return 'error))
+ (list (let* ((s (buffer-substring-no-properties start (1+
(point)))))
+ (unless (string-match mh-swish-folder s)
+ (return 'error))
+ (if (string-match mh-user-path s)
+ (format "+%s"
+ (substring s (match-end 0) (1- (length s))))
+ (return 'error)))
+ (let* ((s (buffer-substring-no-properties (1+ (point)) end))
+ (val (ignore-errors (read-from-string s))))
+ (if (and (consp val) (numberp (car val)))
+ (car val)
+ (return 'error)))
+ nil)))
+ (forward-line)))
+
+
+
+ ;; Swish++ interface
+
+ (defvar mh-swish++-binary (or (executable-find "search++")
+ (executable-find "search")))
+ (defvar mh-swish++-directory ".swish++")
+
+ ;;;###mh-autoload
+ (defun mh-swish++-execute-search (folder-path search-regexp)
+ "Execute swish++ and read the results.
+
+ In the examples below, replace /home/user/Mail with the path to your MH
+ directory.
+
+ First create the directory /home/user/Mail/.swish++. Then create the file
+ /home/user/Mail/.swish++/swish++.conf with the following contents:
+
+ IncludeMeta Bcc Cc Comments Content-Description From Keywords
+ IncludeMeta Newsgroups Resent-To Subject To
+ IncludeMeta Message-Id References In-Reply-To
+ IncludeFile Mail *
+ IndexFile /home/user/Mail/.swish++/swish++.index
+
+ Use the following command line to generate the swish index. Run this
+ daily from cron:
+
+ find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
+ -o -path /home/user/Mail/.swish++ -prune \\
+ -o -name \"[0-9]*\" -print \\
+ | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
+
+ You do not want to index the folders that hold the results of your searches
+ since they tend to be ephemeral and the original messages are indexed anyway.
+ The command above assumes that the results are found in sub-folders of
+ `mh-index-folder' which is +mhe-index by default.
+
+ On some systems (Debian GNU/Linux, for example), use index++ instead of index.
+
+ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (unless mh-swish++-binary
+ (error "Set mh-swish++-binary appropriately"))
+ (call-process mh-swish++-binary nil '(t nil) nil
+ "-m" "10000"
+ (format "-i%s%s/swish++.index"
+ mh-user-path mh-swish++-directory)
+ search-regexp)
+ (goto-char (point-min))
+ (setq mh-swish-folder
+ (let ((last-char (substring folder-path (1- (length folder-path)))))
+ (if (equal last-char "/")
+ folder-path
+ (format "%s/" folder-path)))))
+
+ (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)) "")
+ (if (car elem) " = " "")
+ (mh-swish++-print-regexp (cdr elem))
+ (if (car elem) ")" "")))))
+ (substring regexp 4)))
+
+ (defun mh-swish++-print-regexp (expr)
+ "Return infix expression corresponding to EXPR."
+ (cond ((atom expr) (format "%s" expr))
+ ((eq (car expr) 'not)
+ (format "(not %s)" (mh-swish++-print-regexp (cadr expr))))
+ (t (format "(%s %s %s)" (mh-swish++-print-regexp (cadr expr))
+ (symbol-name (car expr))
+ (mh-swish++-print-regexp (caddr expr))))))
+
+
+
+ ;; Namazu interface
+
+ (defvar mh-namazu-binary (executable-find "namazu"))
+ (defvar mh-namazu-directory ".namazu")
+ (defvar mh-namazu-folder nil)
+
+ ;;;###mh-autoload
+ (defun mh-namazu-execute-search (folder-path search-regexp)
+ "Execute namazu and read the results.
+
+ In the examples below, replace /home/user/Mail with the path to your MH
+ directory.
+
+ First create the directory /home/user/Mail/.namazu. Then create the file
+ /home/user/Mail/.namazu/mknmzrc with the following contents:
+
+ package conf; # Don't remove this line!
+ $ADDRESS = 'address@hidden';
+ $ALLOW_FILE = \"[0-9]*\";
+ $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
+
+ In the above example configuration, none of the mail files contained in the
+ directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
+
+ You do not want to index the folders that hold the results of your searches
+ since they tend to be ephemeral and the original messages are indexed anyway.
+ The configuration file above assumes that the results are found in sub-folders
+ of `mh-index-folder' which is +mhe-index by default.
+
+ Use the following command line to generate the namazu index. Run this
+ daily from cron:
+
+ mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
+ /home/user/Mail
+
+ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
+ (let ((namazu-index-directory
+ (format "%s%s" mh-user-path mh-namazu-directory)))
+ (unless (file-exists-p namazu-index-directory)
+ (error "Namazu directory %s not present" namazu-index-directory))
+ (unless (executable-find mh-namazu-binary)
+ (error "Set mh-namazu-binary appropriately"))
+ (set-buffer (get-buffer-create mh-index-temp-buffer))
+ (erase-buffer)
+ (call-process mh-namazu-binary nil '(t nil) nil
+ "-alR" search-regexp namazu-index-directory)
+ (goto-char (point-min))
+ (setq mh-namazu-folder
+ (let ((last (substring folder-path (1- (length folder-path)))))
+ (if (equal last "/")
+ folder-path
+ (format "%s/" folder-path))))))
+
+ (defun mh-namazu-next-result ()
+ "Get the next result from namazu output."
+ (prog1
+ (block nil
+ (when (eobp) (return nil))
+ (let ((file-name (buffer-substring-no-properties
+ (point) (line-end-position))))
+ (unless (equal (string-match mh-namazu-folder file-name) 0)
+ (return 'error))
+ (unless (file-exists-p file-name)
+ (return 'error))
+ (string-match mh-user-path file-name)
+ (let* ((folder/msg (substring file-name (match-end 0)))
+ (mark (mh-search-from-end ?/ folder/msg)))
+ (unless mark (return 'error))
+ (list (format "+%s" (substring folder/msg 0 mark))
+ (let ((n (ignore-errors (read-from-string
+ (substring folder/msg (1+
mark))))))
+ (if (and (consp n) (numberp (car n)))
+ (car n)
+ (return 'error)))
+ 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
+ system."
+ (block nil
+ ;; The following favors the user's preference; otherwise, the last
+ ;; automatically chosen indexer is used for efficiency rather than going
+ ;; through the list.
+ (let ((program-alist (cond (mh-index-program
+ (list
+ (assoc mh-index-program mh-indexer-choices)))
+ (mh-indexer
+ (list (assoc mh-indexer mh-indexer-choices)))
+ (t mh-indexer-choices))))
+ (while program-alist
+ (let* ((current (pop program-alist))
+ (executable (symbol-value (cadr current))))
+ (when executable
+ (setq mh-indexer (car current))
+ (setq mh-index-execute-search-function (nth 2 current))
+ (setq mh-index-next-result-function (nth 3 current))
+ (setq mh-index-regexp-builder (nth 4 current))
+ (return mh-indexer))))
+ nil)))
+
+
+
+ (provide 'mh-index)
+
+ ;;; Local Variables:
+ ;;; indent-tabs-mode: nil
+ ;;; sentence-end-double-space: nil
+ ;;; End:
+
+ ;;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47
+ ;;; mh-index ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/mh-e/mh-index.el [gnus-5_10-branch],
Miles Bader <=