;;; 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:
;;; MH-Folder Commands
;;;###mh-autoload
-(defun* mh-search (folder search-regexp
- &optional redo-search-flag window-config)
+(defun mh-search (folder search-regexp
+ &optional redo-search-flag window-config)
"Search your MH mail.
This command helps you find messages in your entire corpus of
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-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))
+ (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-searcher 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 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))))))
+ (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)))))))
;; Shush compiler.
-(eval-when-compile (mh-do-in-xemacs (defvar pick-folder)))
+(mh-do-in-xemacs
+ (defvar pick-folder))
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
(mh-index-sequenced-messages folders mh-tick-seq))
;; Shush compiler.
-(eval-when-compile
- (mh-do-in-xemacs
- (defvar mh-mairix-folder)
- (defvar mh-flists-search-folders)))
+(mh-do-in-xemacs
+ (defvar mh-mairix-folder)
+ (defvar mh-flists-search-folders))
;;;###mh-autoload
(defun mh-index-sequenced-messages (folders sequence)
(defvar mh-flists-search-folders)
-(defun mh-flists-execute (&rest args)
+(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 parameters ARGS are ignored."
+recursively. All arguments are IGNORED."
(set-buffer (get-buffer-create mh-temp-index-buffer))
(erase-buffer)
(unless (executable-find "sh")
(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
((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))
(while op-stack
(setq op (pop op-stack))
(cond ((eq op 'paren)
- (return-from mh-index-evaluate (values op-stack operand-stack)))
+ (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))
# 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:
(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 ""))
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."
(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)))
;;;###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
+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 hash-keys of mh-index-msg-checksum-map
+ (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))
(mh-require 'which-func nil t)
;; Shush compiler.
-(eval-when-compile
- (if (or mh-xemacs-flag (< emacs-major-version 22))
- (defvar which-func-mode)))
+(defvar which-func-mode) ; < Emacs 22, XEmacs
;;;###mh-autoload
(defun mh-index-create-imenu-index ()
mh-index-data)
;; Shush compiler
-(eval-when-compile (if mh-xemacs-flag (defvar mh-speed-flists-inhibit-flag)))
+(mh-do-in-xemacs
+ (defvar mh-speed-flists-inhibit-flag))
;;;###mh-autoload
(defun mh-index-execute-commands ()
;; 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)
+ (with-current-buffer folder
(let ((old-refile-list mh-refile-list)
(old-delete-list mh-delete-list))
(setq mh-refile-list nil
(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)
(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))
(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))))
;; 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
+;; checksum program and should set mh-checksum-parser to a function
;; which returns a cons cell containing the message number and
;; checksum string.
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
(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