diff lisp/vm/vm-search.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/vm/vm-search.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,121 @@
+;;; Incremental search through a mail folder (for Lucid and FSF Emacs 19)
+;;; Copyright (C) 1994 Kyle E. Jones
+;;;
+;;; This program 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 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(provide 'vm-search)
+
+(defun vm-isearch-forward (&optional arg)
+  "Incrementally search forward through the current folder's messages.
+Usage is identical to the standard Emacs incremental search.
+When the search terminates the message containing point will be selected.
+
+If the variable vm-search-using-regexps is non-nil, regular expressions
+are understood; nil means the search will be for the input string taken
+literally.  Specifying a prefix ARG interactively toggles the value of
+vm-search-using-regexps for this search."
+  (interactive "P")
+  (let ((vm-search-using-regexps
+	 (if arg (not vm-search-using-regexps) vm-search-using-regexps)))
+    (vm-isearch t)))
+
+(defun vm-isearch-backward (&optional arg)
+  "Incrementally search backward through the current folder's messages.
+Usage is identical to the standard Emacs incremental search.
+When the search terminates the message containing point will be selected.
+
+If the variable vm-search-using-regexps is non-nil, regular expressions
+are understood; nil means the search will be for the input string taken
+literally.  Specifying a prefix ARG interactively toggles the value of
+vm-search-using-regexps for this search."
+  (interactive "P")
+  (let ((vm-search-using-regexps
+	 (if arg (not vm-search-using-regexps) vm-search-using-regexps)))
+    (vm-isearch nil)))
+
+(defun vm-isearch (forward)
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-error-if-virtual-folder)
+  (vm-display (current-buffer) t '(vm-isearch-forward vm-isearch-backward)
+	      (list this-command 'searching-message))
+  (let ((clip-head (point-min))
+	(clip-tail (point-max))
+	(old-vm-message-pointer vm-message-pointer))
+    (unwind-protect
+	(progn (select-window (vm-get-visible-buffer-window (current-buffer)))
+	       (widen)
+	       (add-hook 'pre-command-hook 'vm-isearch-widen)
+	       ;; order is significant, we want to narrow after
+	       ;; the update
+	       (add-hook 'post-command-hook 'vm-isearch-narrow)
+	       (add-hook 'post-command-hook 'vm-isearch-update)
+	       (isearch-mode forward vm-search-using-regexps nil t)
+	       (vm-isearch-update)
+	       (if (not (eq vm-message-pointer old-vm-message-pointer))
+		   (progn
+		     (vm-record-and-change-message-pointer
+		      old-vm-message-pointer vm-message-pointer)
+		     (vm-update-summary-and-mode-line)
+		     ;; vm-show-current-message only adjusts (point-max),
+		     ;; it doesn't change (point-min).
+		     (widen)
+		     (narrow-to-region
+		      (if (< (point) (vm-vheaders-of (car vm-message-pointer)))
+			  (vm-start-of (car vm-message-pointer))
+			(vm-vheaders-of (car vm-message-pointer)))
+		      (vm-text-end-of (car vm-message-pointer)))
+		     (vm-display nil nil
+				 '(vm-isearch-forward vm-isearch-backward)
+				 '(reading-message))
+		     ;; turn the unwinds into a noop
+		     (setq old-vm-message-pointer vm-message-pointer)
+		     (setq clip-head (point-min))
+		     (setq clip-tail (point-max)))))
+      (remove-hook 'pre-command-hook 'vm-isearch-widen)
+      (remove-hook 'post-command-hook 'vm-isearch-update)
+      (remove-hook 'post-command-hook 'vm-isearch-narrow)
+      (narrow-to-region clip-head clip-tail)
+      (setq vm-message-pointer old-vm-message-pointer))))
+
+(defun vm-isearch-widen ()
+  (if (eq major-mode 'vm-mode)
+      (widen)))
+
+(defun vm-isearch-narrow ()
+  (if (eq major-mode 'vm-mode)
+      (narrow-to-region
+       (if (< (point) (vm-vheaders-of (car vm-message-pointer)))
+	   (vm-start-of (car vm-message-pointer))
+	 (vm-vheaders-of (car vm-message-pointer)))
+       (vm-text-end-of (car vm-message-pointer)))))
+
+(defun vm-isearch-update ()
+  (if (eq major-mode 'vm-mode)
+      (if (and (>= (point) (vm-start-of (car vm-message-pointer)))
+	       (<= (point) (vm-end-of (car vm-message-pointer))))
+	  nil
+	(let ((mp vm-message-list)
+	      (point (point)))
+	  (while mp
+	    (if (and (>= point (vm-start-of (car mp)))
+		     (<= point (vm-end-of (car mp))))
+		(setq vm-message-pointer mp mp nil)
+	      (setq mp (cdr mp))))
+	  (setq vm-need-summary-pointer-update t)
+	  (intern (buffer-name) vm-buffers-needing-display-update)
+	  (vm-update-summary-and-mode-line)))))