diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2006-02-12 00:15:44 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2006-02-12 00:15:44 +0000 |
commit | 1913a2b35da45eeeb71ef851975be7d57c11de78 (patch) | |
tree | 6cd59883fb931999da5b62c03b321ade6f77e66e /lisp/mh-e/mh-search.el | |
parent | a5805c9d0240fab504f2a3e32db6449392005fb6 (diff) | |
parent | a528b71e55b2b244a5dd35318713ccb20398cbbf (diff) | |
download | emacs-1913a2b35da45eeeb71ef851975be7d57c11de78.tar.gz |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-49
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-50
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-51
Make constrain-to-field notice overlays
* emacs@sv.gnu.org/emacs--devo--0--patch-52
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-53
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-54
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-55
Merge from erc--emacs--0
* emacs@sv.gnu.org/emacs--devo--0--patch-56
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-57
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-58
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-59
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-60
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-61
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-62
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-63
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-64
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-65
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-66
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-67
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-68
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-69
rcirc: Add flexible response formatting; Add nick abbrevs
* emacs@sv.gnu.org/emacs--devo--0--patch-70
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-71
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-72
Update from CVS: man/dired.texi (Tumme): More tumme documentation.
* emacs@sv.gnu.org/gnus--rel--5.10--patch-18
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-19
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-20
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-21
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-22
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-23
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-24
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-25
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-26
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-27
Update from CVS: lisp/gnus.el: Remove bogus comment.
* emacs@sv.gnu.org/gnus--rel--5.10--patch-28
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-29
Add sendmail.el and smptmail.el from Emacs tree to contrib/
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-508
Diffstat (limited to 'lisp/mh-e/mh-search.el')
-rw-r--r-- | lisp/mh-e/mh-search.el | 184 |
1 files changed, 93 insertions, 91 deletions
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index f1292dd8e1e..9980b6a9b68 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -81,8 +81,8 @@ message number, and optionally the match.") ;;; 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 @@ -230,96 +230,98 @@ folder containing the index search results." 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) - - ;; 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)) - - ;; 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)))))) + (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 mh-searcher 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-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))))))) ;; Shush compiler. (eval-when-compile (mh-do-in-xemacs (defvar pick-folder))) |