1 ;;; mh-pick.el --- make a search pattern and search for a message in MH-E
3 ;; Copyright (C) 1993, 1995, 2001, 2003, 2004 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.
35 (eval-when-compile (require 'mh-acros
))
41 ;;; Internal variables:
43 (defvar mh-pick-mode-map
(make-sparse-keymap)
44 "Keymap for searching folder.")
46 (defvar mh-searching-folder nil
) ;Folder this pick is searching.
47 (defvar mh-searching-function nil
)
49 (defconst mh-pick-single-dash
'(cc date from subject to
)
50 "Search components that are supported by single-dash option in pick.")
53 (defun mh-search-folder (folder window-config
)
54 "Search FOLDER for messages matching a pattern.
55 This function uses the MH command `pick' to do the work.
56 Add the messages found to the sequence named `search'.
57 Argument WINDOW-CONFIG is the current window configuration and is used when
58 the search folder is dismissed."
59 (interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t
)
60 (current-window-configuration)))
61 (let ((pick-folder (if (equal folder
"+") mh-current-folder folder
)))
62 (switch-to-buffer-other-window "search-pattern")
63 (if (or (zerop (buffer-size))
64 (not (y-or-n-p "Reuse pattern? ")))
65 (mh-make-pick-template)
67 (setq mh-searching-function
'mh-pick-do-search
68 mh-searching-folder pick-folder
)
69 (mh-make-local-vars 'mh-current-folder folder
70 'mh-previous-window-config window-config
)
71 (message "%s" (substitute-command-keys
72 (concat "Type \\[mh-do-search] to search messages, "
73 "\\[mh-help] for help.")))))
75 (defun mh-make-pick-template ()
76 "Initialize the current buffer with a template for a pick pattern."
77 (let ((inhibit-read-only t
)) (erase-buffer))
85 (goto-char (point-min))
87 (add-text-properties (point) (1+ (point)) '(front-sticky t
))
88 (add-text-properties (- (line-end-position) 2) (1- (line-end-position))
90 (add-text-properties (point) (1- (line-end-position)) '(read-only t
))
92 (add-text-properties (point) (1+ (point)) '(front-sticky t
))
93 (add-text-properties (point) (1- (line-end-position)) '(read-only t
))
94 (goto-char (point-max)))
96 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
98 mh-pick-menu mh-pick-mode-map
"Menu for MH-E pick-mode"
100 ["Execute the Search" mh-pick-do-search t
]))
104 ;;; Group messages logically, more or less.
105 (defvar mh-pick-mode-help-messages
107 "Search messages using pick: \\[mh-pick-do-search]\n"
108 "Search messages using index: \\[mh-index-do-search]\n"
109 "Move to a field by typing C-c C-f C-<field>\n"
110 "where <field> is the first letter of the desired field."))
111 "Key binding cheat sheet.
113 This is an associative array which is used to show the most common commands.
114 The key is a prefix char. The value is one or more strings which are
115 concatenated together and displayed in the minibuffer if ? is pressed after
116 the prefix character. The special key nil is used to display the
117 non-prefixed commands.
119 The substitutions described in `substitute-command-keys' are performed as
122 (put 'mh-pick-mode
'mode-class
'special
)
124 (define-derived-mode mh-pick-mode fundamental-mode
"MH-Pick"
125 "Mode for creating search templates in MH-E.\\<mh-pick-mode-map>
127 After each field name, enter the pattern to search for. If a field's
128 value does not matter for the search, leave it empty. To search the
129 entire message, supply the pattern in the \"body\" of the template.
130 Each non-empty field must be matched for a message to be selected.
131 To effect a logical \"or\", use \\[mh-search-folder] multiple times.
132 When you have finished, type \\[mh-pick-do-search] to do the search.
134 The value of `mh-pick-mode-hook' is a list of functions to be called,
135 with no arguments, upon entry to this mode.
137 \\{mh-pick-mode-map}"
139 (make-local-variable 'mh-searching-folder
)
140 (make-local-variable 'mh-searching-function
)
141 (make-local-variable 'mh-help-messages
)
142 (easy-menu-add mh-pick-menu
)
143 (setq mh-help-messages mh-pick-mode-help-messages
)
144 (run-hooks 'mh-pick-mode-hook
))
147 (defun mh-pick-do-search ()
148 "Find messages that match the qualifications in the current pattern buffer.
149 Messages are searched for in the folder named in `mh-searching-folder'.
150 Add the messages found to the sequence named `search'."
152 (let ((pattern-list (mh-pick-parse-search-buffer))
153 (folder mh-searching-folder
)
154 (new-buffer-flag nil
)
155 (window-config mh-previous-window-config
)
156 range pick-args msgs
)
158 (error "No search pattern specified"))
160 (cond ((get-buffer folder
)
162 (setq range
(if (and mh-first-msg-num mh-last-msg-num
)
163 (format "%d-%d" mh-first-msg-num mh-last-msg-num
)
166 (mh-make-folder folder
)
168 (setq new-buffer-flag t
))))
169 (setq pick-args
(mh-pick-regexp-builder pattern-list
))
171 (setq msgs
(mh-seq-from-command folder
'search
172 `("pick" ,folder
,range
,@pick-args
))))
173 (message "Searching...done")
174 (if (not new-buffer-flag
)
175 (switch-to-buffer folder
)
176 (mh-scan-folder folder msgs
)
177 (setq mh-previous-window-config window-config
))
178 (mh-add-msgs-to-seq msgs
'search
)
179 (delete-other-windows)))
182 (defun mh-do-search ()
183 "Use the default searching function.
184 If \\[mh-search-folder] was used to create the search pattern then pick is used
185 to search the folder. Otherwise if \\[mh-index-search] was used then the
186 indexing program specified in `mh-index-program' is used."
188 (if (symbolp mh-searching-function
)
189 (funcall mh-searching-function
)
190 (error "No searching function defined")))
192 (defun mh-seq-from-command (folder seq command
)
193 "In FOLDER, make a sequence named SEQ by executing COMMAND.
194 COMMAND is a list. The first element is a program name
195 and the subsequent elements are its arguments, all strings."
198 (case-fold-search t
))
200 (save-window-excursion
201 (if (eq 0 (apply 'mh-exec-cmd-quiet nil command
))
202 ;; "pick" outputs one number per line
203 (while (setq msg
(car (mh-read-msg-list)))
204 (setq msgs
(cons msg msgs
))
207 (setq msgs
(nreverse msgs
)) ;put in ascending order
210 (defun mh-pick-parse-search-buffer ()
211 "Parse the search buffer contents.
212 The function returns a alist. The car of each element is either the header name
213 to search in or nil to search the whole message. The cdr of the element is the
216 (let ((pattern-list ())
219 (goto-char (point-min))
221 (if (search-forward "--------" (line-end-position) t
)
222 (setq in-body-flag t
)
225 (setq start
(if in-body-flag
227 (search-forward ":" (line-end-position) t
)
229 (push (cons (and (not in-body-flag
)
231 (buffer-substring-no-properties
233 (mh-index-parse-search-regexp
234 (buffer-substring-no-properties
235 start
(line-end-position))))
242 ;; Functions specific to how pick works...
243 (defun mh-pick-construct-regexp (expr component
)
244 "Construct pick compatible expression corresponding to EXPR.
245 COMPONENT is the component to search."
246 (cond ((atom expr
) (list component expr
))
247 ((eq (car expr
) 'and
)
248 `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr
) component
) "-and"
249 ,@(mh-pick-construct-regexp (caddr expr
) component
) "-rbrace"))
251 `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr
) component
) "-or"
252 ,@(mh-pick-construct-regexp (caddr expr
) component
) "-rbrace"))
253 ((eq (car expr
) 'not
)
254 `("-lbrace" "-not" ,@(mh-pick-construct-regexp (cadr expr
) component
)
256 (t (error "Unknown operator '%s' seen" (car expr
)))))
258 ;; All implementations of pick have special options -cc, -date, -from and
259 ;; -subject that allow to search for corresponding components. Any other
260 ;; component is searched using option --COMPNAME, for example: `pick
261 ;; --x-mailer mh-e'. Mailutils `pick' supports this option using a certain
262 ;; kludge, but it prefers the following syntax for this purpose:
263 ;; `--component=COMPNAME --pattern=PATTERN'.
264 ;; -- Sergey Poznyakoff, Aug 2003
265 (defun mh-pick-regexp-builder (pattern-list)
266 "Generate pick search expression from PATTERN-LIST."
268 (dolist (pattern pattern-list
)
270 (setq result
`(,@result
"-and" "-lbrace"
271 ,@(mh-pick-construct-regexp
272 (if (and (mh-variant-p 'mu-mh
) (car pattern
))
273 (format "--pattern=%s" (cdr pattern
))
277 ((mh-variant-p 'mu-mh
)
278 (format "--component=%s" (car pattern
)))
279 ((member (car pattern
) mh-pick-single-dash
)
280 (format "-%s" (car pattern
)))
282 (format "--%s" (car pattern
))))
289 ;;; Build the pick-mode keymap:
290 ;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
291 (gnus-define-keys mh-pick-mode-map
293 "\C-c\C-i" mh-index-do-search
294 "\C-c\C-p" mh-pick-do-search
295 "\C-c\C-c" mh-do-search
296 "\C-c\C-f\C-b" mh-to-field
297 "\C-c\C-f\C-c" mh-to-field
298 "\C-c\C-f\C-d" mh-to-field
299 "\C-c\C-f\C-f" mh-to-field
300 "\C-c\C-f\C-r" mh-to-field
301 "\C-c\C-f\C-s" mh-to-field
302 "\C-c\C-f\C-t" mh-to-field
303 "\C-c\C-fb" mh-to-field
304 "\C-c\C-fc" mh-to-field
305 "\C-c\C-fd" mh-to-field
306 "\C-c\C-ff" mh-to-field
307 "\C-c\C-fr" mh-to-field
308 "\C-c\C-fs" mh-to-field
309 "\C-c\C-ft" mh-to-field
)
314 ;;; indent-tabs-mode: nil
315 ;;; sentence-end-double-space: nil
318 ;;; arch-tag: aef2b271-7768-42bd-a782-9a14ba9f83f7
319 ;;; mh-pick.el ends here