Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 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))))) |