annotate lisp/vm/vm-search18.el @ 172:a38aed19690b

Added tag r20-3b12 for changeset 929b76928fce
author cvs
date Mon, 13 Aug 2007 09:47:55 +0200
parents 376386a54a3c
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;; Incremental search through a mail folder
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 ;; For version 18 of FSF Emacs only.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;; This file is part of GNU Emacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;; GNU Emacs is distributed in the hope that it will be useful,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;; but WITHOUT ANY WARRANTY. No author or distributor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;; accepts responsibility to anyone for the consequences of using it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; or for whether it serves any particular purpose or works at all,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;; unless he says so in writing. Refer to the GNU Emacs General Public
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;; License for full details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;; Everyone is granted permission to copy, modify and redistribute
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;; GNU Emacs, but only under the conditions described in the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;; GNU Emacs General Public License. A copy of this license is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;; supposed to have been given to you along with GNU Emacs so you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 ;; can know your rights and responsibilities. It should be in a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;; file named COPYING. Among other things, the copyright notice
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;; and this notice must be preserved on all copies.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 (provide 'vm-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 ;; Adapted for the VM mail reader, Kyle Jones, May 1989
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 ;; This function does all the work of incremental search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 ;; The functions attached to ^R and ^S are trivial,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 ;; merely calling this one, but they are always loaded by default
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 ;; whereas this file can optionally be autoloadable.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 ;; This is the only entry point in this file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 (defun vm-isearch (forward &optional regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 (let ((search-string "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 (search-message "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 (cmds nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 (success t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 (wrapped nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 (barrier (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 adjusted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 (invalid-regexp nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 (slow-terminal-mode (and (<= (baud-rate) search-slow-speed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 (> (window-height)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 (* 4 search-slow-window-lines))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 (other-end nil) ;Start of last match if fwd, end if backwd.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 (small-window nil) ;if t, using a small window
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 (found-point nil) ;to restore point from a small window
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49 ;; This is the window-start value found by the search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 (found-start nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 (opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 (vm-ml-message-new vm-ml-message-new)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 (vm-ml-message-unread vm-ml-message-unread)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 (vm-ml-message-read vm-ml-message-read)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 (vm-ml-message-edited vm-ml-message-edited)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 (vm-ml-message-replied vm-ml-message-replied)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 (vm-ml-message-forwarded vm-ml-message-forwarded)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 (vm-ml-message-filed vm-ml-message-filed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 (vm-ml-message-written vm-ml-message-written)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 (vm-ml-message-marked vm-ml-message-marked)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 (vm-ml-message-deleted vm-ml-message-deleted)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 (vm-ml-message-number vm-ml-message-number)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 (vm-message-pointer vm-message-pointer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 (inhibit-quit t)) ;Prevent ^G from quitting immediately.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 (vm-isearch-push-state)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 (save-window-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 (catch 'search-done
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 (while t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 (or (>= unread-command-char 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 (or (input-pending-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 (vm-isearch-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 (if (and slow-terminal-mode
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 (not (or small-window (pos-visible-in-window-p))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 (setq small-window t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 (setq found-point (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 (move-to-window-line 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 (let ((window-min-height 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 (split-window nil (if (< search-slow-window-lines 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 (1+ (- search-slow-window-lines))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 (- (window-height)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 (1+ search-slow-window-lines)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 (if (< search-slow-window-lines 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 (progn (vertical-motion (- 1 search-slow-window-lines))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 (set-window-start (next-window) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 (set-window-hscroll (next-window)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 (window-hscroll))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 (set-window-hscroll (selected-window) 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 (other-window 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 (goto-char found-point)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 (let ((char (if quit-flag
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 ?\C-g
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 (read-char))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 (setq quit-flag nil adjusted nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 ;; Meta character means exit search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 (cond ((and (>= char 128)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 search-exit-option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 (setq unread-command-char char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 (throw 'search-done t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 ((eq char search-exit-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 ;; Esc means exit search normally.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 ;; Except, if first thing typed, it means do nonincremental
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 (if (= 0 (length search-string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 (vm-nonincremental-search forward regexp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 (throw 'search-done t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 ((= char ?\C-g)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 ;; ^G means the user tried to quit.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 (ding)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 (discard-input)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 (if success
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 ;; If search is successful, move back to starting point
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 ;; and really do quit.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 (progn (goto-char opoint)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 (vm-update-search-position)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 (signal 'quit nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 ;; If search is failing, rub out until it is once more
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118 ;; successful.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 (while (not success) (vm-isearch-pop))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 ((or (eq char search-repeat-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 (eq char search-reverse-char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 (if (eq forward (eq char search-repeat-char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 ;; C-s in forward or C-r in reverse.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 (if (equal search-string "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 ;; If search string is empty, use last one.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 (setq search-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 (if regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 search-last-regexp search-last-string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 search-message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 (mapconcat 'text-char-description
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 search-string ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 ;; If already have what to search for, repeat it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 (or success
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 (progn (goto-char (if forward (point-min) (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 (setq wrapped t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 ;; C-s in reverse or C-r in forward, change direction.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 (setq forward (not forward)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 (setq barrier (point)) ; For subsequent \| if regexp.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 (setq success t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 (or (equal search-string "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 (vm-isearch-search))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 (vm-isearch-push-state))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 ((= char search-delete-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144 ;; Rubout means discard last input item and move point
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 ;; back. If buffer is empty, just beep.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
146 (if (null (cdr cmds))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147 (ding)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148 (vm-isearch-pop)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 (cond ((or (eq char search-yank-word-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 (eq char search-yank-line-char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 ;; ^W means gobble next word from buffer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153 ;; ^Y means gobble rest of line from buffer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154 (let ((word (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
155 (and (not forward) other-end
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 (goto-char other-end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 (if (eq char search-yank-line-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 (end-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 (forward-word 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 (point))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 (setq search-string (concat search-string word)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 search-message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 (concat search-message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 (mapconcat 'text-char-description
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 word "")))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 ;; Any other control char =>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 ;; unread it and exit the search normally.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 ((and search-exit-option
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 (/= char search-quote-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173 (or (= char ?\177)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
174 (and (< char ? ) (/= char ?\t) (/= char ?\r))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 (setq unread-command-char char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 (throw 'search-done t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 ;; Any other character => add it to the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179 ;; search string and search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 (cond ((= char search-quote-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 (setq char (read-quoted-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 (vm-isearch-message t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 ((= char ?\r)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 ;; unix braindeath
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 (setq char ?\n)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186 (setq search-string (concat search-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 (char-to-string char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 search-message (concat search-message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 (text-char-description char)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190 (if (and (not success)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191 ;; unsuccessful regexp search may become
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 ;; successful by addition of characters which
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193 ;; make search-string valid
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194 (not regexp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196 ;; If a regexp search may have been made more
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
197 ;; liberal, retreat the search start.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 ;; Go back to place last successful search started
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
199 ;; or to the last ^S/^R (barrier), whichever is nearer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
200 (and regexp success cmds
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
201 (cond ((memq char '(?* ??))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
202 (setq adjusted t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
203 (let ((cs (nth (if forward
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
204 5 ; other-end
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
205 2) ; saved (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
206 (car (cdr cmds)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
207 ;; (car cmds) is after last search;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
208 ;; (car (cdr cmds)) is from before it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
209 (setq cs (or cs barrier))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
210 (goto-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
211 (if forward
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
212 (max cs barrier)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
213 (min cs barrier)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
214 ((eq char ?\|)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
215 (setq adjusted t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
216 (goto-char barrier))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
217 ;; In reverse regexp search, adding a character at
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
218 ;; the end may cause zero or many more chars to be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
219 ;; matched, in the string following point.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
220 ;; Allow all those possibilities without moving point as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
221 ;; long as the match does not extend past search origin.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
222 (if (and regexp (not forward) (not adjusted)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
223 (condition-case ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
224 (looking-at search-string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
225 (error nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
226 (<= (match-end 0) (min opoint barrier)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
227 (setq success t invalid-regexp nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
228 other-end (match-end 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
229 ;; Not regexp, not reverse, or no match at point.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
230 (if (and other-end (not adjusted))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
231 (goto-char (if forward other-end
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
232 (min opoint barrier (1+ other-end)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
233 (vm-isearch-search)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
234 (vm-isearch-push-state))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
235 (setq found-start (window-start (selected-window)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
236 (setq found-point (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
237 (if (> (length search-string) 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
238 (if regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
239 (setq search-last-regexp search-string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
240 (setq search-last-string search-string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
241 (message "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
242 (if small-window
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
243 (goto-char found-point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
244 ;; Exiting the save-window-excursion clobbers this; restore it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
245 (set-window-start (selected-window) found-start t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
246
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
247 (defun vm-isearch-message (&optional c-q-hack ellipsis)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
248 ;; If about to search, and previous search regexp was invalid,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
249 ;; check that it still is. If it is valid now,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
250 ;; let the message we display while searching say that it is valid.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
251 (and invalid-regexp ellipsis
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
252 (condition-case ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
253 (progn (re-search-forward search-string (point) t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
254 (setq invalid-regexp nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
255 (error nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
256 ;; If currently failing, display no ellipsis.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
257 (or success (setq ellipsis nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
258 (let ((m (concat (if success "" "failing ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
259 (if wrapped "wrapped ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
260 (if regexp "regexp " "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
261 "VM I-search"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
262 (if forward ": " " backward: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
263 search-message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
264 (if c-q-hack "^Q" "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
265 (if invalid-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
266 (concat " [" invalid-regexp "]")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
267 ""))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
268 (aset m 0 (upcase (aref m 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
269 (let ((cursor-in-echo-area ellipsis))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
270 (if c-q-hack m (message "%s" m)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
271
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
272 (defun vm-isearch-pop ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
273 (setq cmds (cdr cmds))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
274 (let ((cmd (car cmds)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
275 (setq search-string (car cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
276 search-message (car (cdr cmd))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
277 success (nth 3 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
278 forward (nth 4 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
279 other-end (nth 5 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
280 invalid-regexp (nth 6 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
281 wrapped (nth 7 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
282 barrier (nth 8 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
283 ; unused now
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
284 ; vm-ml-attributes-string (nth 9 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
285 vm-ml-message-number (nth 10 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
286 vm-message-pointer (nth 11 cmd))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
287 (if vm-summary-buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
288 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
289 (set-buffer vm-summary-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
290 (setq
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
291 ; unused now
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
292 ;vm-ml-attributes-string (nth 9 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
293 vm-ml-message-number (nth 10 cmd))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
294 (goto-char (car (cdr (cdr cmd))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
295 (vm-set-summary-pointer (car vm-message-pointer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
296
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
297 (defun vm-isearch-push-state ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
298 (setq cmds (cons (list search-string search-message (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
299 success forward other-end invalid-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
300 wrapped barrier
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
301 ; unused now
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
302 ; vm-ml-attributes-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
303 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
304 vm-ml-message-number
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
305 vm-message-pointer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
306 cmds)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
307
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
308 (defun vm-isearch-search ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
309 (vm-isearch-message nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
310 (condition-case lossage
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
311 (let ((inhibit-quit nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
312 (if regexp (setq invalid-regexp nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
313 (setq success
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
314 (funcall
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
315 (if regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
316 (if forward 're-search-forward 're-search-backward)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
317 (if forward 'search-forward 'search-backward))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
318 search-string nil t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
319 (if success
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
320 (setq other-end
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
321 (if forward (match-beginning 0) (match-end 0)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
322 (quit (setq unread-command-char ?\C-g)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
323 (setq success nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
324 (invalid-regexp (setq invalid-regexp (car (cdr lossage)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
325 (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
326 invalid-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
327 (setq invalid-regexp "incomplete input"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
328 (if success
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
329 (vm-update-search-position)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
330 ;; Ding if failed this time after succeeding last time.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
331 (and (nth 3 (car cmds))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
332 (ding))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
333 (goto-char (nth 2 (car cmds)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
334
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
335 ;; This is called from incremental-search
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
336 ;; if the first input character is the exit character.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
337 ;; The interactive-arg-reader uses free variables `forward' and `regexp'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
338 ;; which are bound by `incremental-search'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
339
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
340 ;; We store the search string in `search-string'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
341 ;; which has been bound already by `incremental-search'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
342 ;; so that, when we exit, it is copied into `search-last-string'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
343
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
344 (defun vm-nonincremental-search (forward regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
345 (let (message char function string inhibit-quit
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
346 (cursor-in-echo-area t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
347 ;; Prompt assuming not word search,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
348 (setq message (if regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
349 (if forward "VM Regexp search: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
350 "VM Regexp search backward: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
351 (if forward "VM Search: " "VM Search backward: ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
352 (message "%s" message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
353 ;; Read 1 char and switch to word search if it is ^W.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
354 (setq char (read-char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
355 (if (eq char search-yank-word-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
356 (setq message (if forward "VM Word search: " "VM Word search backward: "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
357 ;; Otherwise let that 1 char be part of the search string.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
358 (setq unread-command-char char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
359 (setq function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
360 (if (eq char search-yank-word-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
361 (if forward 'word-search-forward 'word-search-backward)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
362 (if regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
363 (if forward 're-search-forward 're-search-backward)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
364 (if forward 'search-forward 'search-backward))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
365 ;; Read the search string with corrected prompt.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
366 (setq string (read-string message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
367 ;; Empty means use default.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
368 (if (= 0 (length string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
369 (setq string search-last-string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
370 ;; Set last search string now so it is set even if we fail.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
371 (setq search-last-string string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
372 ;; Since we used the minibuffer, we should be available for redo.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
373 (setq command-history (cons (list function string) command-history))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
374 ;; Go ahead and search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
375 (funcall function string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
376
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
377 (defun vm-update-search-position (&optional record-change)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
378 (if (and (>= (point) (vm-start-of (car vm-message-pointer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
379 (<= (point) (vm-end-of (car vm-message-pointer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
380 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
381 (let ((mp vm-message-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
382 (point (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
383 (while mp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
384 (if (and (>= point (vm-start-of (car mp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
385 (<= point (vm-end-of (car mp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
386 (if record-change
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
387 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
388 (vm-record-and-change-message-pointer vm-message-pointer mp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
389 (setq mp nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
390 (setq vm-message-pointer mp mp nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
391 (setq mp (cdr mp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
392 (setq vm-need-summary-pointer-update t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
393 (vm-update-summary-and-mode-line))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
394
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
395 (defun vm-isearch-forward (&optional arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
396 "Incrementally search forward through the current folder's messages.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
397 Usage is identical to the standard Emacs incremental search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
398 When the search terminates the message containing point will be selected.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
399
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
400 If the variable vm-search-using-regexps is non-nil, regular expressions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
401 are understood; nil means the search will be for the input string taken
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
402 literally. Specifying a prefix ARG interactively toggles the value of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
403 vm-search-using-regexps for this search."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
404 (interactive "P")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
405 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
406 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
407 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
408 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
409 (vm-error-if-virtual-folder)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
410 (vm-display (current-buffer) t '(vm-isearch-forward) '(vm-isearch-forward))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
411 (let ((clip-head (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
412 (clip-tail (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
413 (old-w (selected-window)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
414 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
415 (progn (select-window (get-buffer-window (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
416 (widen)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
417 (vm-isearch t (if arg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
418 (not vm-search-using-regexps)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
419 vm-search-using-regexps))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
420 (vm-update-search-position t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
421 ;; vm-show-current-message only adjusts (point-max),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
422 ;; it doesn't change (point-min).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
423 (narrow-to-region
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
424 (if (< (point) (vm-vheaders-of (car vm-message-pointer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
425 (vm-start-of (car vm-message-pointer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
426 (vm-vheaders-of (car vm-message-pointer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
427 (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
428 (vm-show-current-message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
429 (setq vm-system-state 'reading)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
430 ;; turn the clipping unwind into a noop
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
431 (setq clip-head (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
432 (setq clip-tail (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
433 (narrow-to-region clip-head clip-tail)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
434 (select-window old-w))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
435
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
436 (defun vm-isearch-backward (&optional arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
437 "Incrementally search backward through the current folder's messages.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
438 Usage is identical to the standard Emacs incremental search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
439 When the search terminates the message containing point will be selected.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
440
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
441 If the variable vm-search-using-regexps is non-nil, regular expressions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
442 are understood; nil means the search will be for the input string taken
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
443 literally. Specifying a prefix ARG interactively toggles the value of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
444 vm-search-using-regexps for this search."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
445 (interactive "P")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
446 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
447 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
448 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
449 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
450 (vm-error-if-virtual-folder)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
451 (vm-display (current-buffer) t '(vm-isearch-backward)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
452 (list 'vm-isearch-backward 'searching-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
453 (let ((clip-head (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
454 (clip-tail (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
455 (old-w (selected-window)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
456 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
457 (progn (select-window (get-buffer-window (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
458 (widen)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
459 (vm-isearch nil (if arg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
460 (not vm-search-using-regexps)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
461 vm-search-using-regexps))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
462 (vm-update-search-position t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
463 ;; vm-show-current-message only adjusts (point-max),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
464 ;; it doesn't change (point-min).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
465 (narrow-to-region
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
466 (if (< (point) (vm-vheaders-of (car vm-message-pointer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
467 (vm-start-of (car vm-message-pointer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
468 (vm-vheaders-of (car vm-message-pointer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
469 (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
470 (vm-show-current-message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
471 (setq vm-system-state 'reading)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
472 ;; turn the clipping unwind into a noop
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
473 (setq clip-head (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
474 (setq clip-tail (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
475 (narrow-to-region clip-head clip-tail)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
476 (select-window old-w))))