-;;; mh-search -- MH-E search
+;;; mh-search --- MH-Search mode
-;; Copyright (C) 1993, 1995,
-;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Indexed search by Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
+;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
+;; Mode used to compose search criteria.
+
;; (1) The following search engines are supported:
;; swish++
;; swish-e
;; namazu
;; pick
;; grep
-;;
+
;; (2) To use this package, you first have to build an index. Please
;; read the documentation for `mh-search' to get started. That
;; documentation will direct you to the specific instructions for
-;; your particular indexer.
+;; your particular searcher.
;;; Change Log:
;;; Code:
-(eval-when-compile (require 'mh-acros))
+(require 'mh-e)
(mh-require-cl)
(require 'gnus-util)
-(require 'mh-buffers)
-(require 'mh-e)
+(require 'imenu)
-(defvar mh-indexer nil
- "Cached value of chosen index program.")
+(defvar mh-searcher nil
+ "Cached value of chosen search program.")
-(defvar mh-index-execute-search-function nil
+(defvar mh-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-search-next-result-function nil
+ "Function to parse the next line of output.
+Expected to return a list of three strings: name of the folder,
+message number, and optionally the match.")
-(defvar mh-index-regexp-builder nil
+(defvar mh-search-regexp-builder nil
"Function used to construct search regexp.")
(defvar mh-index-folder "+mhe-index"
\f
-;;; MH-Search mode
+;;; MH-Folder Commands
;;;###mh-autoload
-(defun* mh-search (redo-search-flag folder search-regexp
- &optional window-config)
+(defun mh-search (folder search-regexp
+ &optional redo-search-flag window-config)
"Search your MH mail.
-With this command, you can search for messages to or from a
-particular person or about a particular subject. In fact, you can
-also search for messages containing selected strings in any
-arbitrary header field or any string found within the messages.
+This command helps you find messages in your entire corpus of
+mail. You can search for messages to or from a particular person
+or about a particular subject. In fact, you can also search for
+messages containing selected strings in any arbitrary header
+field or any string found within the messages.
-Use a prefix argument REDO-SEARCH-FLAG to repeat the last search.
+Out of the box, MH-E uses \"pick\" to find messages. With a
+little extra effort, you can set an indexing program which
+rewards you with extremely quick results. The drawback is that
+sometimes the index does not contain the words you're looking
+for. You can still use \"pick\" in these situations.
You are prompted for the FOLDER to search. This can be \"all\" to
-search all folders. For most search methods, the search works
-recursively on the listed folder.
+search all folders. Note that the search works recursively on the
+listed folder.
Next, an MH-Search buffer appears where you can enter search
-criteria.
+criteria SEARCH-REGEXP.
From:
To:
anywhere in a message, then place the string underneath the row
of dashes.
-It is all right to specify several search criteria. What happens
-then is that a logical _and_ of the various fields is performed.
-If you prefer a logical _or_ operation, run \\[mh-search]
-multiple times.
-
As an example, let's say that we want to find messages from
Ginnean about horseback riding in the Kosciusko National
Park (Australia) during January, 1994. Normally we would start
with a broad search and narrow it down if necessary to produce a
manageable amount of data, but we'll cut to the chase and create
-a fairly restrictive set of criteria as follows:
+a fairly restrictive set of criteria as follows:\\<mh-search-mode-map>
From: ginnean
To:
kosciusko
As with MH-Letter mode, MH-Search provides commands like
-\\<mh-search-mode-map>\\[mh-to-field] to help you fill in the
-blanks.
+\\[mh-to-field] to help you fill in the blanks.\\<mh-folder-mode-map>
If you find that you do the same thing over and over when editing
the search template, you may wish to bind some shortcuts to keys.
This can be done with the variable `mh-search-mode-hook', which is
-called when \\[mh-search] is run on a new pattern.
+called when \\[mh-search] is run on a new pattern.\\<mh-search-mode-map>
To perform the search, type \\[mh-index-do-search].
with the folder name.\\<mh-folder-mode-map>
The appearance of the heading can be modified by customizing the
-face `mh-index-folder'. You can jump back and forth between the
+face `mh-search-folder'. You can jump back and forth between the
headings using the commands \\[mh-index-next-folder] and
\\[mh-index-previous-folder].
view surrounding messages with the command \\[mh-rescan-folder].
Because this folder is temporary, you'll probably get in the
-habit of killing it when you're done with
-\\[mh-kill-folder].
+habit of killing it when you're done with \\[mh-kill-folder].
+
+You can regenerate the results by running this command with a
+prefix argument REDO-SEARCH-FLAG.
+
+Note: This command uses an \"X-MHE-Checksum:\" header field to
+cache the MD5 checksum of a message. This means that if an
+incoming message already contains an \"X-MHE-Checksum:\" field,
+that message might not be found by this command. The following
+\"procmail\" recipe avoids this problem by renaming the existing
+header field:
-SEARCH METHODS
+ :0 wf
+ | formail -R \"X-MHE-Checksum\" \"X-Old-MHE-Checksum\"
+
+Configuring Indexed Searches
The command \\[mh-search] runs the command defined by the option
-`mh-index-program'. The default value is \"Auto-detect\" which
+`mh-search-program'. The default value is \"Auto-detect\" which
means that MH-E will automatically choose one of \"swish++\",
\"swish-e\", \"mairix\", \"namazu\", \"pick\" and \"grep\" in
that order. If, for example, you have both \"swish++\" and
\"mairix\" installed and you want to use \"mairix\", then you can
set this option to \"mairix\".
- *NOTE*
-
- The \"pick\" and \"grep\" commands do not perform a
- recursive search on the given folder.
-
-This command uses an \"X-MHE-Checksum:\" header field to cache
-the MD5 checksum of a message. This means that if an incoming
-message already contains an \"X-MHE-Checksum:\" field, that
-message might not be found by this command. The following
-\"procmail\" recipe avoids this problem by renaming the existing
-header field:
-
- :0 wf
- | formail -R \"X-MHE-Checksum\" \"X-Old-MHE-Checksum\"
-
The documentation for the following commands describe how to set
-up the various indexing programs to use with MH-E. The \"pick\"
-and \"grep\" commands do not require additional configuration.
+up the various indexing programs to use with MH-E.
- `mh-swish++-execute-search'
- `mh-swish-execute-search'
- `mh-pick-execute-search'
- `mh-grep-execute-search'
-In a program, the folder is searched with SEARCH-REGEXP. 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."
+In a program, if FOLDER is \"+\" or nil, 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."
(interactive
- (list current-prefix-arg
- (progn
+ (list (progn
(mh-find-path)
- ;; Yes, we do want to call mh-index-choose every time in case the
- ;; user has switched the indexer manually.
- (unless (mh-index-choose (and current-prefix-arg
- mh-index-previous-search
- (cadr mh-index-previous-search)))
- (error "No indexing program found"))
+ ;; Yes, we do want to call mh-search-choose every time in case the
+ ;; user has switched the searcher manually.
+ (unless (mh-search-choose (and current-prefix-arg
+ mh-index-previous-search
+ (cadr mh-index-previous-search)))
+ (error "No search program found"))
(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)))
(or (and current-prefix-arg (caddr mh-index-previous-search))
- mh-index-regexp-builder
+ mh-search-regexp-builder
(read-string (format "%s regexp: "
- (upcase-initials (symbol-name mh-indexer)))))
+ (upcase-initials (symbol-name mh-searcher)))))
+ current-prefix-arg
(if (and (not (and current-prefix-arg
(caddr mh-index-previous-search)))
- mh-index-regexp-builder)
+ mh-search-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-search))
- ;; We have fancy query parsing.
- (when (symbolp search-regexp)
- (mh-search-folder folder window-config)
- (return-from mh-search))
- ;; Begin search proper.
- (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))
+ (block mh-search
+ ;; 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-search))
+ ;; We have fancy query parsing.
+ (when (symbolp search-regexp)
+ (mh-search-folder folder window-config)
+ (return-from mh-search))
+ ;; Begin search proper.
+ (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-searcher)
+ (funcall mh-search-function folder-path search-regexp)
+
+ ;; Parse searcher output.
+ (message "Processing %s output... " mh-searcher)
+ (goto-char (point-min))
+ (loop for next-result = (funcall mh-search-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)
+ (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))
- ;; 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 mh-searcher search-regexp))
- ;; 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 mh-indexer search-regexp))
+ ;; Write out data to disk.
+ (unless mh-flists-called-flag (mh-index-write-data))
- ;; 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-searcher))
+ (loop for msg-hash being the hash-values of mh-index-data
+ sum (hash-table-count msg-hash))
+ (loop for msg-hash being the hash-values of mh-index-data
+ count (> (hash-table-count msg-hash) 0)))))))
- (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))))))
+;; Shush compiler.
+(mh-do-in-xemacs
+ (defvar pick-folder))
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
(goto-char (point-min))
(dotimes (i 5)
(add-text-properties (point) (1+ (point)) '(front-sticky t))
- (add-text-properties (- (line-end-position) 2) (1- (line-end-position))
+ (add-text-properties (- (mh-line-end-position) 2)
+ (1- (mh-line-end-position))
'(rear-nonsticky t))
- (add-text-properties (point) (1- (line-end-position)) '(read-only t))
+ (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t))
(forward-line))
(add-text-properties (point) (1+ (point)) '(front-sticky t))
- (add-text-properties (point) (1- (line-end-position)) '(read-only t))
+ (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t))
(goto-char (point-max)))
-(defvar mh-search-mode-map (make-sparse-keymap)
- "Keymap for searching folder.")
+;; Sequence Searches
+
+;;;###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-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) (default all): "))
+ mh-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-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) (default all): "))
+ mh-ticked-messages-folders)))
+ (mh-index-sequenced-messages folders mh-tick-seq))
+
+;; Shush compiler.
+(mh-do-in-xemacs
+ (defvar mh-mairix-folder)
+ (defvar mh-flists-search-folders))
+
+;;;###mh-autoload
+(defun mh-index-sequenced-messages (folders sequence)
+ "Display messages in any sequence.
+
+All messages from the FOLDERS in `mh-new-messages-folders' in the
+SEQUENCE you provide are listed. With a prefix argument, enter a
+space-separated list of folders at the prompt, or nothing to
+search all folders."
+ (interactive
+ (list (if current-prefix-arg
+ (split-string (read-string "Search folder(s) (default all): "))
+ mh-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-searcher 'flists)
+ (mh-search-function 'mh-flists-execute)
+ (mh-search-next-result-function 'mh-mairix-next-result)
+ (mh-mairix-folder mh-user-path)
+ (mh-search-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-search'
+ ;; into thinking that the folder resulted from a previous search.
+ (set-buffer new-folder)
+ (setq mh-index-previous-search (list folders mh-searcher 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-search "+" mh-flists-results-folder
+ redo-flag window-config)
+ mh-index-sequence-search-flag t
+ mh-index-previous-search (list folders mh-searcher sequence))
+ (mh-index-write-data)
+ (when (stringp message) (message "%s" message))))
+
+(defvar mh-flists-search-folders)
+
+(defun mh-flists-execute (&rest ignored)
+ "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 arguments are IGNORED."
+ (set-buffer (get-buffer-create mh-temp-index-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-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-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-temp-index-buffer))))
+
+;; Navigation
+
+;;;###mh-autoload
+(defun mh-index-next-folder (&optional backward-flag)
+ "Jump to the next folder marker.
+
+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 0 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))
+
+;;;###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 (mh-line-beginning-position)) ?+)
+ (setq folder (buffer-substring-no-properties
+ (mh-line-beginning-position)
+ (mh-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)))))
+
+\f
+
+;;; Search Menu
+
+(easy-menu-define
+ mh-pick-menu mh-search-mode-map "Menu for MH-E Search"
+ '("Search"
+ ["Perform Search" mh-index-do-search t]
+ ["Search with pick" mh-pick-do-search t]))
+
+\f
+
+;;; MH-Search Keys
;; If this changes, modify mh-search-mode-help-messages accordingly, below.
(gnus-define-keys mh-search-mode-map
"\C-c\C-p" mh-pick-do-search
"\C-c\C-f\C-b" mh-to-field
"\C-c\C-f\C-c" mh-to-field
- "\C-c\C-f\C-d" mh-to-field
- "\C-c\C-f\C-f" mh-to-field
- "\C-c\C-f\C-r" mh-to-field
+ "\C-c\C-f\C-m" mh-to-field
"\C-c\C-f\C-s" mh-to-field
"\C-c\C-f\C-t" mh-to-field
"\C-c\C-fb" mh-to-field
"\C-c\C-fc" mh-to-field
- "\C-c\C-fd" mh-to-field
- "\C-c\C-ff" mh-to-field
- "\C-c\C-fr" mh-to-field
+ "\C-c\C-fm" mh-to-field
"\C-c\C-fs" mh-to-field
"\C-c\C-ft" mh-to-field)
-(easy-menu-define
- mh-pick-menu mh-search-mode-map "Menu for MH-E Search"
- '("Search"
- ["Perform Search" mh-index-do-search t]
- ["Search with pick" mh-pick-do-search t]))
+\f
+
+;;; MH-Search Help Messages
;; Group messages logically, more or less.
(defvar mh-search-mode-help-messages
'((nil
- "Perform search: \\[mh-index-do-search]\n"
- "Search with pick: \\[mh-pick-do-search]\n"
+ "Perform search: \\[mh-index-do-search]\n"
+ "Search with pick: \\[mh-pick-do-search]\n\n"
"Move to a field by typing C-c C-f C-<field>\n"
"where <field> is the first letter of the desired field\n"
"(except for From: which uses \"m\")."))
The substitutions described in `substitute-command-keys' are performed
as well.")
+\f
+
+;;; MH-Search Mode
+
(put 'mh-search-mode 'mode-class 'special)
(define-derived-mode mh-search-mode fundamental-mode "MH-Search"
"Mode for creating search templates in MH-E.\\<mh-search-mode-map>
-After each field name, enter the pattern to search for. If a field's
-value does not matter for the search, leave it empty. To search the
-entire message, supply the pattern in the \"body\" of the template.
-Each non-empty field must be matched for a message to be selected. To
-effect a logical \"or\", use \\[mh-search-folder] multiple times. When
-you have finished, type \\[mh-pick-do-search] to do the search.
+Edit this template by entering your search criteria in an
+appropriate header field that is already there, or create a new
+field yourself. If the string you're looking for could be
+anywhere in a message, then place the string underneath the row
+of dashes.
+
+To perform the search, type \\[mh-index-do-search].
+
+Sometimes you're searching for text that is either not indexed,
+or hasn't been indexed yet. In this case you can override the
+default method with the pick method by running the command
+\\[mh-pick-do-search].
The hook `mh-search-mode-hook' is called upon entry to this mode.
\\{mh-search-mode-map}"
- (make-local-variable 'mh-help-messages)
(easy-menu-add mh-pick-menu)
- (setq mh-help-messages mh-search-mode-help-messages))
+ (mh-set-help mh-search-mode-help-messages))
-;;;###mh-autoload
-(defun mh-index-do-search (&optional indexer)
- "Find messages that match the qualifications in the current pattern buffer.
-If optional argument INDEXER is present, use it instead of
-`mh-index-program'."
+\f
+
+;;; MH-Search Commands
+
+(defun mh-index-do-search (&optional searcher)
+ "Find messages using `mh-search-program'.
+If optional argument SEARCHER is present, use it instead of
+`mh-search-program'."
(interactive)
- (unless (mh-index-choose indexer) (error "No indexing program found"))
+ (unless (mh-search-choose searcher) (error "No search program found"))
(let* ((regexp-list (mh-pick-parse-search-buffer))
- (pattern (funcall mh-index-regexp-builder regexp-list)))
+ (pattern (funcall mh-search-regexp-builder regexp-list)))
(if pattern
- (mh-search nil mh-current-folder pattern mh-previous-window-config)
+ (mh-search mh-current-folder pattern nil mh-previous-window-config)
(error "No search terms"))))
-;;;###mh-autoload
(defun mh-pick-do-search ()
- "Find messages that match the qualifications in the current pattern buffer.
+ "Find messages using \"pick\".
Uses the pick method described in `mh-pick-execute-search'."
(interactive)
(defun mh-pick-parse-search-buffer ()
"Parse the search buffer contents.
-The function returns a alist. The car of each element is either
+The function returns an alist. The car of each element is either
the header name to search in or nil to search the whole message.
The cdr of the element is the pattern to search."
(save-excursion
start begin)
(goto-char (point-min))
(while (not (eobp))
- (if (search-forward "--------" (line-end-position) t)
+ (if (search-forward "--------" (mh-line-end-position) t)
(setq in-body-flag t)
(beginning-of-line)
(setq begin (point))
(setq start (if in-body-flag
(point)
- (search-forward ":" (line-end-position) t)
+ (search-forward ":" (mh-line-end-position) t)
(point)))
(push (cons (and (not in-body-flag)
(intern (downcase
begin (1- start)))))
(mh-index-parse-search-regexp
(buffer-substring-no-properties
- start (line-end-position))))
+ start (mh-line-end-position))))
pattern-list))
(forward-line))
pattern-list)))
-;;;###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
((equal token "and") (push 'and op-stack))
((equal token ")")
(multiple-value-setq (op-stack operand-stack)
- (mh-index-evaluate op-stack operand-stack))
+ (values-list (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))
(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"))))
-
-\f
-
-;;; Sequence browsing
-
-;;;###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-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) (default all): "))
- mh-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-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) (default all): "))
- mh-ticked-messages-folders)))
- (mh-index-sequenced-messages folders mh-tick-seq))
-
-;;;###mh-autoload
-(defun mh-index-sequenced-messages (folders sequence)
- "Display messages in any sequence.
-
-All messages from the FOLDERS in `mh-new-messages-folders' in the
-SEQUENCE you provide are listed. With a prefix argument, enter a
-space-separated list of folders at the prompt, or nothing to
-search all folders."
- (interactive
- (list (if current-prefix-arg
- (split-string (read-string "Search folder(s) (default all): "))
- mh-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-search'
- ;; into thinking that the folder resulted from a previous search.
- (set-buffer new-folder)
- (setq mh-index-previous-search (list folders mh-indexer 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-search redo-flag "+" mh-flists-results-folder
- window-config)
- mh-index-sequence-search-flag t
- mh-index-previous-search (list folders mh-indexer sequence))
- (mh-index-write-data)
- (when (stringp message) (message "%s" message))))
-
-(defvar mh-flists-search-folders)
-
-(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-temp-index-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-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-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-temp-index-buffer))))
-
-\f
-
-;;; Folder navigation and utilities
-
-;;;###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-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-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-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-next-folder (&optional backward-flag)
- "Jump to the next folder marker.
+ (when (or op-stack operand-stack)
+ (error "Invalid regexp: %s" input))))))
-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 0 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)))
+(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))
- ((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))
-
-;;;###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)))))
-
-;;;###mh-autoload
-(defun mh-index-p ()
- "Non-nil means that this folder was generated by an index search."
- mh-index-data)
+ (t
+ (push current result)
+ (unless (or (equal current "(") (equal current "not"))
+ (setq literal-seen t)))))
+ (nreverse result)))
-;;;###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)))
+(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 (list 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"))))
\f
-;;; Indexing functions
+;;; Indexing Functions
-;; Support different indexing programs
-(defvar mh-indexer-choices
+;; Support different search programs
+(defvar mh-search-choices
'((swish++
mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result
mh-swish++-regexp-builder)
mh-pick-regexp-builder)
(grep
mh-grep-binary mh-grep-execute-search mh-grep-next-result nil))
- "List of possible indexer choices.")
+ "List of possible searcher choices.")
-(defun mh-index-choose (&optional indexer)
- "Choose an indexing function.
+(defun mh-search-choose (&optional searcher)
+ "Choose a searching 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.
-If optional argument INDEXER is present, use it instead of
-`mh-index-program'."
+`mh-searcher', `mh-search-function', and
+`mh-search-next-result-function' are set according to the first
+searcher in `mh-search-choices' present on the system. If
+optional argument SEARCHER is present, use it instead of
+`mh-search-program'."
(block nil
- (let ((program-alist (cond (indexer
- (list (assoc indexer mh-indexer-choices)))
- (mh-index-program
+ (let ((program-alist (cond (searcher
+ (list (assoc searcher mh-search-choices)))
+ (mh-search-program
(list
- (assoc mh-index-program mh-indexer-choices)))
- (t mh-indexer-choices))))
+ (assoc mh-search-program mh-search-choices)))
+ (t mh-search-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))))
+ (setq mh-searcher (car current))
+ (setq mh-search-function (nth 2 current))
+ (setq mh-search-next-result-function (nth 3 current))
+ (setq mh-search-regexp-builder (nth 4 current))
+ (return mh-searcher))))
nil)))
-;;; Swish++ interface
+;;; Swish++
(defvar mh-swish++-binary (or (executable-find "search++")
(executable-find "search")))
(defvar mh-swish++-directory ".swish++")
(defvar mh-swish-folder nil)
-;;;###mh-autoload
(defun mh-swish++-execute-search (folder-path search-regexp)
- "Execute swish++ and read the results.
+ "Execute swish++.
In the examples below, replace \"/home/user/Mail\" with the path to
your MH directory.
(symbol-name (car expr))
(mh-swish++-print-regexp (caddr expr))))))
-;;; Swish interface
+;;; Swish
(defvar mh-swish-binary (executable-find "swish-e"))
(defvar mh-swish-directory ".swish")
-;;;###mh-autoload
(defun mh-swish-execute-search (folder-path search-regexp)
- "Execute swish-e and read the results.
+ "Execute swish-e.
In the examples below, replace \"/home/user/Mail\" with the path
to your MH directory.
(return nil))
(when (equal (char-after (point)) ?#)
(return 'error))
- (let* ((start (search-forward " " (line-end-position) t))
- (end (search-forward " " (line-end-position) t)))
+ (let* ((start (search-forward " " (mh-line-end-position) t))
+ (end (search-forward " " (mh-line-end-position) t)))
(unless (and start end)
(return 'error))
(setq end (1- end))
(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)))
+ (n (ignore-errors (string-to-number s))))
+ (if n n (return 'error)))
nil)))
(forward-line)))
-;;; Mairix interface
+;;; Mairix
(defvar mh-mairix-binary (executable-find "mairix"))
(defvar mh-mairix-directory ".mairix")
(defvar mh-mairix-folder nil)
-;;;###mh-autoload
(defun mh-mairix-execute-search (folder-path search-regexp-list)
- "Execute mairix and read the results.
+ "Execute mairix.
In the examples below, replace \"/home/user/Mail\" with the path
to your MH directory.
# are subfolders within the folder
mh=archive...:inbox:drafts:news:sent:trash
- vfolder_format=raw
- database=/home/user/Mail/mairix/database
+ vfolder_format=mh
+ database=/home/user/Mail/.mairix/database
Use the following command line to generate the mairix index. Run
this daily from cron:
(return 'error))
(let ((start (point))
end msg-start)
- (setq end (line-end-position))
+ (setq end (mh-line-end-position))
(unless (search-forward mh-mairix-folder end t)
(return 'error))
(goto-char (match-beginning 0))
(return 'error))
(list (format "+%s" (buffer-substring-no-properties
(point) (1- msg-start)))
- (car (read-from-string
- (buffer-substring-no-properties msg-start end)))
- ())))
+ (string-to-number
+ (buffer-substring-no-properties msg-start end))
+ nil)))
(forward-line)))
(defun mh-mairix-regexp-builder (regexp-list)
(cond ((eq (car pair) 'to) "t:")
((eq (car pair) 'from) "f:")
((eq (car pair) 'cc) "c:")
+ ((eq (car pair) 'to-or-cc) "tc:")
+ ((eq (car pair) 'address) "a:")
((eq (car pair) 'subject) "s:")
+ ((eq (car pair) 'subject-or-body) "bs:")
((eq (car pair) 'date) "d:")
+ ((eq (car pair) 'message-id) "m:")
+ ((eq (car pair) 'message-body) "b:")
+ ((eq (car pair) 'message-size) "z:")
+ ((eq (car pair) 'message-attachment-name) "n:")
+ ((eq (car pair) 'message-flags) "F:")
(t ""))
(let ((sop (cdr (mh-mairix-convert-to-sop* (cdr pair))))
(final ""))
(cdadr expr)))))
(t (error "Unreachable: %s" expr))))
-;;; Namazu interface
+;;; Namazu
(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.
+ "Execute namazu.
In the examples below, replace \"/home/user/Mail\" with the path to
your MH directory.
daily from cron:
mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
- /home/user/Mail
+ -q /home/user/Mail
In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP
is used to search."
(block nil
(when (eobp) (return nil))
(let ((file-name (buffer-substring-no-properties
- (point) (line-end-position))))
+ (point) (mh-line-end-position))))
(unless (equal (string-match mh-namazu-folder file-name) 0)
(return 'error))
(unless (file-exists-p file-name)
(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
+ (let ((n (ignore-errors (string-to-number
(substring folder/msg (1+ mark))))))
- (if (and (consp n) (numberp (car n)))
- (car n)
- (return 'error)))
+ (if n n (return 'error)))
nil))))
(forward-line)))
-;;; Pick interface
+;;; Pick
(defvar mh-index-pick-folder)
(defvar mh-pick-binary "pick")
(defconst mh-pick-single-dash '(cc date from subject to)
"Search components that are supported by single-dash option in pick.")
-;;;###mh-autoload
(defun mh-pick-execute-search (folder-path search-regexp)
"Execute pick.
-There are no semantics associated with the search criteria--they
-are simply treated as strings. Case is ignored when all lowercase
-is used, and regular expressions (a la \"ed\") are available.
-
-Unlike the other index search programs, you must specify a
-folder. In addition, this command does not descend into any
-sub-folders that may be present.
+Read \"pick(1)\" or the section Finding Messages with pick in the
+MH book to find out more about how to enter the criteria (see URL
+`http://www.ics.uci.edu/~mh/book/mh/finpic.htm').
In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP
is used to search."
(set-buffer (get-buffer-create mh-temp-index-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)
+ (let ((folders
+ (mh-folder-list (substring folder-path (length mh-user-path)))))
+ (loop for folder in folders do
+ (setq folder (concat "+" folder))
+ (insert folder "\n")
+ (apply #'call-process (expand-file-name "pick" mh-progs)
+ nil '(t nil) nil 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))
+ (prog1
+ (block nil
+ (when (eobp) (return nil))
+ (when (search-forward-regexp "^\+" (mh-line-end-position) t)
+ (setq mh-index-pick-folder
+ (buffer-substring-no-properties (mh-line-beginning-position)
+ (mh-line-end-position)))
+ (return 'error))
+ (unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position) t)
+ (return 'error))
+ (list mh-index-pick-folder
+ (string-to-number
+ (buffer-substring-no-properties (mh-line-beginning-position)
+ (mh-line-end-position)))
+ nil))
(forward-line)))
;; All implementations of pick have special options -cc, -date, -from and
(when (cdr pattern)
(setq result `(,@result "-and" "-lbrace"
,@(mh-pick-construct-regexp
- (if (and (mh-variant-p 'mu-mh) (car pattern))
+ (if (and (mh-variant-p 'gnu-mh) (car pattern))
(format "--pattern=%s" (cdr pattern))
(cdr pattern))
(if (car pattern)
(cond
- ((mh-variant-p 'mu-mh)
+ ((mh-variant-p 'gnu-mh)
(format "--component=%s" (car pattern)))
((member (car pattern) mh-pick-single-dash)
(format "-%s" (car pattern)))
"-rbrace"))
(t (error "Unknown operator %s seen" (car expr)))))
-;;; Grep interface
+;;; Grep
(defvar mh-grep-binary (executable-find "grep"))
-;;;###mh-autoload
(defun mh-grep-execute-search (folder-path search-regexp)
- "Execute grep and read the results.
+ "Execute grep.
+
+Unlike the other search methods, this method does not use the
+MH-Search buffer. Instead, you simply enter a regular expression
+in the minibuffer. For help in constructing regular expressions,
+see your man page for \"grep\".
In a program, FOLDER-PATH is the directory in which SEARCH-REGEXP
is used to search."
(block nil
(when (eobp)
(return nil))
- (let ((eol-pos (line-end-position))
- (bol-pos (line-beginning-position))
+ (let ((eol-pos (mh-line-end-position))
+ (bol-pos (mh-line-beginning-position))
folder-start msg-end)
(goto-char bol-pos)
(unless (search-forward mh-user-path eol-pos 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)))
+ (let ((n (ignore-errors (string-to-number
+ (buffer-substring-no-properties
+ (1+ (point)) msg-end)))))
+ (if n n (return 'error)))
match))))
(forward-line)))
\f
-;;; Folder support
+;;; Folder Utilities
+
+;;;###mh-autoload
+(defun mh-index-group-by-folder ()
+ "Partition the messages based on source folder.
+Returns an alist with 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 the 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-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-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-require 'which-func nil t)
+
+;; Shush compiler.
+(defvar which-func-mode) ; < Emacs 22, XEmacs
+
+;;;###mh-autoload
+(defun mh-index-create-imenu-index ()
+ "Create alist of folder names and positions in index folder buffers."
+ (save-excursion
+ (if (boundp 'which-func-mode)
+ (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) (mh-line-end-position))
+ (set-marker (make-marker) (point)))
+ alist)))
+ (setq imenu--index-alist (nreverse alist)))))
+
+;;;###mh-autoload
+(defun mh-search-p ()
+ "Non-nil means that this folder was generated by searching."
+ mh-index-data)
+
+;; Shush compiler
+(mh-do-in-xemacs
+ (defvar mh-speed-flists-inhibit-flag))
+
+;;;###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...
+ (with-current-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)))
(defun mh-index-generate-pretty-name (string)
"Given STRING generate a name which is suitable for use as a folder name.
(insert "_" s)))
(setq string (mh-replace-string "-lbrace" " "))
(setq string (mh-replace-string "-rbrace" " "))
+ (setq string (mh-replace-string "-search" " "))
(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)
(delete-char 1))
(goto-char (point-max))
(while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r ?_)))
- (delete-backward-char 1))
+ (delete-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)
+ (cond ((eq mh-searcher 'flists)
(format "%s/%s" mh-flists-results-folder mh-flists-sequence))
((equal out mh-flists-results-folder) (concat out "1"))
(t out)))))
(with-temp-buffer
(mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
(goto-char (point-min))
- (not (eobp))))))
+ ;; Strip + from folder; use optional + in regexp.
+ (looking-at (format "+?%s" (substring folder 1)))))))
(defun mh-msg-exists-p (msg folder)
"Check if MSG exists in FOLDER."
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>.
+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."
(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))
+ 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))
\f
-;;; Sequence support
+;;; Sequence Support
;;;###mh-autoload
(defun mh-index-create-sequences ()
(mh-coalesce-msg-list msgs)))
;; Update source folder buffer if we have it open...
(when (get-buffer folder)
- (save-excursion
- (set-buffer folder)
+ (with-current-buffer folder
(mh-put-msg-in-seq msgs seq))))
(mh-index-matching-source-msgs msgs))
folders))))
(mh-coalesce-msg-list msgs)))
;; Update source folder buffer if we have it open...
(when (get-buffer folder)
- (save-excursion
- (set-buffer folder)
+ (with-current-buffer folder
(mh-delete-msg-from-seq msgs seq t))))
(mh-index-matching-source-msgs msgs))
folders))))
(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))
+ (string-equal (buffer-substring-no-properties
+ (point) (mh-line-end-position))
checksum)))
\f
-;;; Serialization of index data
+;;; Serialization of Index Data
(defun mh-index-write-data ()
"Write index data to file."
\f
-;;; Checksum routines
+;;; Checksum Routines
+
+;; A few different checksum programs are supported. The supported
+;; programs are:
-;; 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.
+
+;; 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
+;; checksum 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-md5sum-parser ()
"Parse md5sum output."
- (let ((begin (line-beginning-position))
- (end (line-end-position))
+ (let ((begin (mh-line-beginning-position))
+ (end (mh-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)))
+ (cons (string-to-number (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))
+ (let ((begin (mh-line-beginning-position))
+ (end (mh-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))))
+ (cons (string-to-number (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)
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-temp-checksum-buffer))
+ ;; Clear temp buffer
+ (with-current-buffer (get-buffer-create mh-temp-checksum-buffer)
(erase-buffer)
;; Run scan to check if any messages needs MD5 annotations at all
(with-temp-buffer
(let (msg checksum)
(while (not (eobp))
(setq msg (buffer-substring-no-properties
- (point) (line-end-position)))
+ (point) (mh-line-end-position)))
(forward-line)
(save-excursion
(cond ((not (string-match "^[0-9]*$" msg)))
(t
;; update maps
(setq checksum (buffer-substring-no-properties
- (point) (line-end-position)))
- (let ((msg (car (read-from-string msg))))
+ (point) (mh-line-end-position)))
+ (let ((msg (string-to-number msg)))
(set-buffer folder)
(mh-index-update-single-msg msg checksum origin-map)))))
(forward-line))))
(mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
"-nodate" "-text" checksum "-inplace")
;; update maps
- (save-excursion
- (set-buffer folder)
+ (with-current-buffer folder
(mh-index-update-single-msg msg checksum origin-map)))
(forward-line)))))
(mh-index-write-data))
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)))))
+ (cond ((gethash checksum mh-index-checksum-origin-map)
+ (when 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
+ (when (and origin-map (gethash msg origin-map))
(setf (gethash checksum mh-index-checksum-origin-map)
(gethash msg origin-map))))))
+
(provide 'mh-search)
;; Local Variables:
;; sentence-end-double-space: nil
;; End:
-;; arch-tag: 607762ad-0dff-4fe1-a27e-6c0dde0dcc47
;;; mh-search ends here