File: vm-search.el

package info (click to toggle)
xemacs20 20.4-13
  • links: PTS
  • area: main
  • in suites: slink
  • size: 67,324 kB
  • ctags: 57,643
  • sloc: lisp: 586,197; ansic: 184,662; sh: 4,296; asm: 3,179; makefile: 2,021; perl: 1,059; csh: 96; sed: 22
file content (122 lines) | stat: -rw-r--r-- 5,049 bytes parent folder | download | duplicates (12)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
;;; 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)))
		     (save-excursion (vm-energize-urls))
		     (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)))))