1 ;;; mh-pick.el --- make a search pattern and search for a message in mh-e
3 ;; Copyright (C) 1993, 1995, 2001 Free Software Foundation, Inc.
5 ;; Author: Bill Wohler <wohler@newt.com>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;; Internal support for mh-e package.
33 ;; $Id: mh-pick.el,v 1.11 2001/12/29 00:10:41 wohler Exp $
42 (defvar mh-pick-mode-hook nil
43 "Invoked in `mh-pick-mode' on a new pattern.")
45 ;;; Internal variables:
47 (defvar mh-pick-mode-map
(make-sparse-keymap)
48 "Keymap for searching folder.")
50 (defvar mh-searching-folder nil
) ;Folder this pick is searching.
52 (defun mh-search-folder (folder)
53 "Search FOLDER for messages matching a pattern.
54 Add the messages found to the sequence named `search'."
55 (interactive (list (mh-prompt-for-folder "Search"
58 (switch-to-buffer-other-window "pick-pattern")
59 (if (or (zerop (buffer-size))
60 (not (y-or-n-p "Reuse pattern? ")))
61 (mh-make-pick-template)
63 (setq mh-searching-folder folder
))
65 (defun mh-make-pick-template ()
66 ;; Initialize the current buffer with a template for a pick pattern.
75 (goto-char (point-min))
78 (put 'mh-pick-mode
'mode-class
'special
)
80 (define-derived-mode mh-pick-mode fundamental-mode
"MH-Pick"
81 "Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
83 After each field name, enter the pattern to search for. If a field's
84 value does not matter for the search, leave it empty. To search the
85 entire message, supply the pattern in the \"body\" of the template.
86 Each non-empty field must be matched for a message to be selected.
87 To effect a logical \"or\", use \\[mh-search-folder] multiple times.
88 When you have finished, type \\[mh-do-pick-search] to do the search.
90 This mode runs the hook `mh-pick-mode-hook'.
94 (make-local-variable 'mh-searching-folder
)
95 (easy-menu-add mh-pick-menu
))
98 (defun mh-do-pick-search ()
99 "Find messages that match the qualifications in the current pattern buffer.
100 Messages are searched for in the folder named in `mh-searching-folder'.
101 Add the messages found to the sequence named `search'."
103 (let ((pattern-buffer (buffer-name))
104 (searching-buffer mh-searching-folder
)
111 (cond ((get-buffer searching-buffer
)
112 (set-buffer searching-buffer
)
113 (setq range
(list (format "%d-%d"
114 mh-first-msg-num mh-last-msg-num
))))
116 (mh-make-folder searching-buffer
)
117 (setq range
'("all"))
118 (setq new-buffer t
))))
119 (message "Searching...")
120 (goto-char (point-min))
122 (setq pattern
(mh-next-pick-field pattern-buffer
)))
123 (setq msgs
(mh-seq-from-command searching-buffer
126 (list "pick" pattern searching-buffer
128 (mh-coalesce-msg-list range
)))))
129 (setq range msgs
)) ;restrict the pick range for next pass
130 (message "Searching...done")
132 (mh-scan-folder searching-buffer msgs
)
133 (switch-to-buffer searching-buffer
))
134 (mh-add-msgs-to-seq msgs
'search
)
135 (delete-other-windows)))
138 (defun mh-seq-from-command (folder seq seq-command
)
139 ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
140 ;; COMMAND is a list. The first element is a program name
141 ;; and the subsequent elements are its arguments, all strings.
144 (case-fold-search t
))
146 (save-window-excursion
147 (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command
))
148 ;; "pick" outputs one number per line
149 (while (setq msg
(car (mh-read-msg-list)))
150 (setq msgs
(cons msg msgs
))
153 (setq msgs
(nreverse msgs
)) ;put in ascending order
157 (defun mh-next-pick-field (buffer)
158 ;; Return the next piece of a pick argument that can be extracted from the
160 ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat")
161 ;; or NIL if no pieces remain.
163 (let ((case-fold-search t
))
166 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t
)
169 (downcase (buffer-substring (match-beginning 1)
171 (pat (buffer-substring (match-beginning 2) (match-end 2))))
173 (list component pat
)))
174 ((re-search-forward "^-*$" nil t
)
176 (let ((body (buffer-substring (point) (point-max))))
177 (if (and (> (length body
) 0) (not (equal body
"\n")))
178 (list "-search" body
)
183 ;;; Build the pick-mode keymap:
184 (gnus-define-keys mh-pick-mode-map
185 "\C-c\C-c" mh-do-pick-search
186 "\C-c\C-f\C-b" mh-to-field
187 "\C-c\C-f\C-c" mh-to-field
188 "\C-c\C-f\C-d" mh-to-field
189 "\C-c\C-f\C-f" mh-to-field
190 "\C-c\C-f\C-r" mh-to-field
191 "\C-c\C-f\C-s" mh-to-field
192 "\C-c\C-f\C-t" mh-to-field
193 "\C-c\C-fb" mh-to-field
194 "\C-c\C-fc" mh-to-field
195 "\C-c\C-fd" mh-to-field
196 "\C-c\C-ff" mh-to-field
197 "\C-c\C-fr" mh-to-field
198 "\C-c\C-fs" mh-to-field
199 "\C-c\C-ft" mh-to-field
)
201 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
203 mh-pick-menu mh-pick-mode-map
"Menu for mh-e pick-mode"
205 ["Execute the Search" mh-do-pick-search t
]))
207 ;;; mh-pick.el ends here