1 |
;;; mh-pick.el --- make a search pattern and search for a message in MH-E |
;;; mh-pick.el --- make a search pattern and search for a message in MH-E |
2 |
|
|
3 |
;; Copyright (C) 1993, 1995, 2001, 2003 Free Software Foundation, Inc. |
;; Copyright (C) 1993, 1995, 2001, 2003, 2004 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Bill Wohler <wohler@newt.com> |
;; Author: Bill Wohler <wohler@newt.com> |
6 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
32 |
|
|
33 |
;;; Code: |
;;; Code: |
34 |
|
|
35 |
|
(eval-when-compile (require 'mh-acros)) |
36 |
|
(mh-require-cl) |
37 |
(require 'mh-e) |
(require 'mh-e) |
38 |
(require 'easymenu) |
(require 'easymenu) |
39 |
(require 'gnus-util) |
(require 'gnus-util) |
46 |
(defvar mh-searching-folder nil) ;Folder this pick is searching. |
(defvar mh-searching-folder nil) ;Folder this pick is searching. |
47 |
(defvar mh-searching-function nil) |
(defvar mh-searching-function nil) |
48 |
|
|
49 |
|
(defconst mh-pick-single-dash '(cc date from subject to) |
50 |
|
"Search components that are supported by single-dash option in pick.") |
51 |
|
|
52 |
;;;###mh-autoload |
;;;###mh-autoload |
53 |
(defun mh-search-folder (folder window-config) |
(defun mh-search-folder (folder window-config) |
54 |
"Search FOLDER for messages matching a pattern. |
"Search FOLDER for messages matching a pattern. |
144 |
(run-hooks 'mh-pick-mode-hook)) |
(run-hooks 'mh-pick-mode-hook)) |
145 |
|
|
146 |
;;;###mh-autoload |
;;;###mh-autoload |
|
(defun mh-do-pick-search () |
|
|
"Find messages that match the qualifications in the current pattern buffer. |
|
|
Messages are searched for in the folder named in `mh-searching-folder'. |
|
|
Add the messages found to the sequence named `search'. |
|
|
|
|
|
This is a deprecated function and `mh-pick-do-search' should be used instead." |
|
|
(interactive) |
|
|
(mh-pick-do-search)) |
|
|
|
|
|
;;;###mh-autoload |
|
147 |
(defun mh-pick-do-search () |
(defun mh-pick-do-search () |
148 |
"Find messages that match the qualifications in the current pattern buffer. |
"Find messages that match the qualifications in the current pattern buffer. |
149 |
Messages are searched for in the folder named in `mh-searching-folder'. |
Messages are searched for in the folder named in `mh-searching-folder'. |
255 |
"-rbrace")) |
"-rbrace")) |
256 |
(t (error "Unknown operator '%s' seen" (car expr))))) |
(t (error "Unknown operator '%s' seen" (car expr))))) |
257 |
|
|
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) |
(defun mh-pick-regexp-builder (pattern-list) |
266 |
"Generate pick search expression from PATTERN-LIST." |
"Generate pick search expression from PATTERN-LIST." |
267 |
(let ((result ())) |
(let ((result ())) |
269 |
(when (cdr pattern) |
(when (cdr pattern) |
270 |
(setq result `(,@result "-and" "-lbrace" |
(setq result `(,@result "-and" "-lbrace" |
271 |
,@(mh-pick-construct-regexp |
,@(mh-pick-construct-regexp |
272 |
(cdr pattern) (if (car pattern) |
(if (and (mh-variant-p 'mu-mh) (car pattern)) |
273 |
(format "-%s" (car pattern)) |
(format "--pattern=%s" (cdr pattern)) |
274 |
"-search")) |
(cdr pattern)) |
275 |
|
(if (car pattern) |
276 |
|
(cond |
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))) |
281 |
|
(t |
282 |
|
(format "--%s" (car pattern)))) |
283 |
|
"-search")) |
284 |
"-rbrace")))) |
"-rbrace")))) |
285 |
(cdr result))) |
(cdr result))) |
286 |
|
|