|
0
|
1 ;;; Incremental search through a mail folder (for Lucid and FSF Emacs 19)
|
|
|
2 ;;; Copyright (C) 1994 Kyle E. Jones
|
|
|
3 ;;;
|
|
|
4 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
5 ;;; it under the terms of the GNU General Public License as published by
|
|
|
6 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
7 ;;; any later version.
|
|
|
8 ;;;
|
|
|
9 ;;; This program is distributed in the hope that it will be useful,
|
|
|
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
12 ;;; GNU General Public License for more details.
|
|
|
13 ;;;
|
|
|
14 ;;; You should have received a copy of the GNU General Public License
|
|
|
15 ;;; along with this program; if not, write to the Free Software
|
|
|
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
17
|
|
|
18 (provide 'vm-search)
|
|
|
19
|
|
|
20 (defun vm-isearch-forward (&optional arg)
|
|
|
21 "Incrementally search forward through the current folder's messages.
|
|
|
22 Usage is identical to the standard Emacs incremental search.
|
|
|
23 When the search terminates the message containing point will be selected.
|
|
|
24
|
|
|
25 If the variable vm-search-using-regexps is non-nil, regular expressions
|
|
|
26 are understood; nil means the search will be for the input string taken
|
|
|
27 literally. Specifying a prefix ARG interactively toggles the value of
|
|
|
28 vm-search-using-regexps for this search."
|
|
|
29 (interactive "P")
|
|
|
30 (let ((vm-search-using-regexps
|
|
|
31 (if arg (not vm-search-using-regexps) vm-search-using-regexps)))
|
|
|
32 (vm-isearch t)))
|
|
|
33
|
|
|
34 (defun vm-isearch-backward (&optional arg)
|
|
|
35 "Incrementally search backward through the current folder's messages.
|
|
|
36 Usage is identical to the standard Emacs incremental search.
|
|
|
37 When the search terminates the message containing point will be selected.
|
|
|
38
|
|
|
39 If the variable vm-search-using-regexps is non-nil, regular expressions
|
|
|
40 are understood; nil means the search will be for the input string taken
|
|
|
41 literally. Specifying a prefix ARG interactively toggles the value of
|
|
|
42 vm-search-using-regexps for this search."
|
|
|
43 (interactive "P")
|
|
|
44 (let ((vm-search-using-regexps
|
|
|
45 (if arg (not vm-search-using-regexps) vm-search-using-regexps)))
|
|
|
46 (vm-isearch nil)))
|
|
|
47
|
|
|
48 (defun vm-isearch (forward)
|
|
|
49 (vm-follow-summary-cursor)
|
|
|
50 (vm-select-folder-buffer)
|
|
|
51 (vm-check-for-killed-summary)
|
|
|
52 (vm-error-if-folder-empty)
|
|
|
53 (vm-error-if-virtual-folder)
|
|
|
54 (vm-display (current-buffer) t '(vm-isearch-forward vm-isearch-backward)
|
|
|
55 (list this-command 'searching-message))
|
|
|
56 (let ((clip-head (point-min))
|
|
|
57 (clip-tail (point-max))
|
|
|
58 (old-vm-message-pointer vm-message-pointer))
|
|
|
59 (unwind-protect
|
|
|
60 (progn (select-window (vm-get-visible-buffer-window (current-buffer)))
|
|
|
61 (widen)
|
|
|
62 (add-hook 'pre-command-hook 'vm-isearch-widen)
|
|
|
63 ;; order is significant, we want to narrow after
|
|
|
64 ;; the update
|
|
|
65 (add-hook 'post-command-hook 'vm-isearch-narrow)
|
|
|
66 (add-hook 'post-command-hook 'vm-isearch-update)
|
|
|
67 (isearch-mode forward vm-search-using-regexps nil t)
|
|
|
68 (vm-isearch-update)
|
|
|
69 (if (not (eq vm-message-pointer old-vm-message-pointer))
|
|
|
70 (progn
|
|
|
71 (vm-record-and-change-message-pointer
|
|
|
72 old-vm-message-pointer vm-message-pointer)
|
|
|
73 (vm-update-summary-and-mode-line)
|
|
|
74 ;; vm-show-current-message only adjusts (point-max),
|
|
|
75 ;; it doesn't change (point-min).
|
|
|
76 (widen)
|
|
|
77 (narrow-to-region
|
|
|
78 (if (< (point) (vm-vheaders-of (car vm-message-pointer)))
|
|
|
79 (vm-start-of (car vm-message-pointer))
|
|
|
80 (vm-vheaders-of (car vm-message-pointer)))
|
|
|
81 (vm-text-end-of (car vm-message-pointer)))
|
|
|
82 (vm-display nil nil
|
|
|
83 '(vm-isearch-forward vm-isearch-backward)
|
|
|
84 '(reading-message))
|
|
|
85 ;; turn the unwinds into a noop
|
|
|
86 (setq old-vm-message-pointer vm-message-pointer)
|
|
|
87 (setq clip-head (point-min))
|
|
|
88 (setq clip-tail (point-max)))))
|
|
|
89 (remove-hook 'pre-command-hook 'vm-isearch-widen)
|
|
|
90 (remove-hook 'post-command-hook 'vm-isearch-update)
|
|
|
91 (remove-hook 'post-command-hook 'vm-isearch-narrow)
|
|
|
92 (narrow-to-region clip-head clip-tail)
|
|
|
93 (setq vm-message-pointer old-vm-message-pointer))))
|
|
|
94
|
|
|
95 (defun vm-isearch-widen ()
|
|
|
96 (if (eq major-mode 'vm-mode)
|
|
|
97 (widen)))
|
|
|
98
|
|
|
99 (defun vm-isearch-narrow ()
|
|
|
100 (if (eq major-mode 'vm-mode)
|
|
|
101 (narrow-to-region
|
|
|
102 (if (< (point) (vm-vheaders-of (car vm-message-pointer)))
|
|
|
103 (vm-start-of (car vm-message-pointer))
|
|
|
104 (vm-vheaders-of (car vm-message-pointer)))
|
|
|
105 (vm-text-end-of (car vm-message-pointer)))))
|
|
|
106
|
|
|
107 (defun vm-isearch-update ()
|
|
|
108 (if (eq major-mode 'vm-mode)
|
|
|
109 (if (and (>= (point) (vm-start-of (car vm-message-pointer)))
|
|
|
110 (<= (point) (vm-end-of (car vm-message-pointer))))
|
|
|
111 nil
|
|
|
112 (let ((mp vm-message-list)
|
|
|
113 (point (point)))
|
|
|
114 (while mp
|
|
|
115 (if (and (>= point (vm-start-of (car mp)))
|
|
|
116 (<= point (vm-end-of (car mp))))
|
|
|
117 (setq vm-message-pointer mp mp nil)
|
|
|
118 (setq mp (cdr mp))))
|
|
|
119 (setq vm-need-summary-pointer-update t)
|
|
|
120 (intern (buffer-name) vm-buffers-needing-display-update)
|
|
|
121 (vm-update-summary-and-mode-line)))))
|
