Mercurial > emacs

comparison lisp/mh-e/mh-pick.el @ 89966:d8411455de48

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-32 Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-486 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-487 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-488 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-489 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-490 Update from CVS: man/fixit.texi (Spelling): Fix typo. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-491 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-494 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-495 Update from CVS: Add missing lisp/mh-e files * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-496 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-499 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-500 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-513 Update from CVS
author Miles Bader <miles@gnu.org>
date Fri, 27 Aug 2004 07:00:34 +0000
parents 68c22ea6027c e9a6cbc8ca5e
children f042e7c0fe20
comparison
equal deleted inserted replaced
89965:5e9097d1ad99 89966:d8411455de48
1 ;;; mh-pick.el --- make a search pattern and search for a message in MH-E 1 ;;; mh-pick.el --- make a search pattern and search for a message in MH-E
2 2
3 ;; Copyright (C) 1993, 1995, 2001, 2003 Free Software Foundation, Inc. 3 ;; Copyright (C) 1993, 1995, 2001, 2003, 2004 Free Software Foundation, Inc.
4 4
5 ;; Author: Bill Wohler <wohler@newt.com> 5 ;; Author: Bill Wohler <wohler@newt.com>
6 ;; Maintainer: Bill Wohler <wohler@newt.com> 6 ;; Maintainer: Bill Wohler <wohler@newt.com>
7 ;; Keywords: mail 7 ;; Keywords: mail
8 ;; See: mh-e.el 8 ;; See: mh-e.el
30 30
31 ;;; Change Log: 31 ;;; Change Log:
32 32
33 ;;; Code: 33 ;;; Code:
34 34
35 (eval-when-compile (require 'mh-acros))
36 (mh-require-cl)
35 (require 'mh-e) 37 (require 'mh-e)
36 (require 'easymenu) 38 (require 'easymenu)
37 (require 'gnus-util) 39 (require 'gnus-util)
38 40
39 ;;; Internal variables: 41 ;;; Internal variables:
41 (defvar mh-pick-mode-map (make-sparse-keymap) 43 (defvar mh-pick-mode-map (make-sparse-keymap)
42 "Keymap for searching folder.") 44 "Keymap for searching folder.")
43 45
44 (defvar mh-searching-folder nil) ;Folder this pick is searching. 46 (defvar mh-searching-folder nil) ;Folder this pick is searching.
45 (defvar mh-searching-function nil) 47 (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.")
46 51
47 ;;;###mh-autoload 52 ;;;###mh-autoload
48 (defun mh-search-folder (folder window-config) 53 (defun mh-search-folder (folder window-config)
49 "Search FOLDER for messages matching a pattern. 54 "Search FOLDER for messages matching a pattern.
50 This function uses the MH command `pick' to do the work. 55 This function uses the MH command `pick' to do the work.
135 (make-local-variable 'mh-searching-function) 140 (make-local-variable 'mh-searching-function)
136 (make-local-variable 'mh-help-messages) 141 (make-local-variable 'mh-help-messages)
137 (easy-menu-add mh-pick-menu) 142 (easy-menu-add mh-pick-menu)
138 (setq mh-help-messages mh-pick-mode-help-messages) 143 (setq mh-help-messages mh-pick-mode-help-messages)
139 (run-hooks 'mh-pick-mode-hook)) 144 (run-hooks 'mh-pick-mode-hook))
140
141 ;;;###mh-autoload
142 (defun mh-do-pick-search ()
143 "Find messages that match the qualifications in the current pattern buffer.
144 Messages are searched for in the folder named in `mh-searching-folder'.
145 Add the messages found to the sequence named `search'.
146
147 This is a deprecated function and `mh-pick-do-search' should be used instead."
148 (interactive)
149 (mh-pick-do-search))
150 145
151 ;;;###mh-autoload 146 ;;;###mh-autoload
152 (defun mh-pick-do-search () 147 (defun mh-pick-do-search ()
153 "Find messages that match the qualifications in the current pattern buffer. 148 "Find messages that match the qualifications in the current pattern buffer.
154 Messages are searched for in the folder named in `mh-searching-folder'. 149 Messages are searched for in the folder named in `mh-searching-folder'.
258 ((eq (car expr) 'not) 253 ((eq (car expr) 'not)
259 `("-lbrace" "-not" ,@(mh-pick-construct-regexp (cadr expr) component) 254 `("-lbrace" "-not" ,@(mh-pick-construct-regexp (cadr expr) component)
260 "-rbrace")) 255 "-rbrace"))
261 (t (error "Unknown operator '%s' seen" (car expr))))) 256 (t (error "Unknown operator '%s' seen" (car expr)))))
262 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
263 (defun mh-pick-regexp-builder (pattern-list) 265 (defun mh-pick-regexp-builder (pattern-list)
264 "Generate pick search expression from PATTERN-LIST." 266 "Generate pick search expression from PATTERN-LIST."
265 (let ((result ())) 267 (let ((result ()))
266 (dolist (pattern pattern-list) 268 (dolist (pattern pattern-list)
267 (when (cdr pattern) 269 (when (cdr pattern)
268 (setq result `(,@result "-and" "-lbrace" 270 (setq result `(,@result "-and" "-lbrace"
269 ,@(mh-pick-construct-regexp 271 ,@(mh-pick-construct-regexp
270 (cdr pattern) (if (car pattern) 272 (if (and (mh-variant-p 'mu-mh) (car pattern))
271 (format "-%s" (car pattern)) 273 (format "--pattern=%s" (cdr pattern))
272 "-search")) 274 (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"))
273 "-rbrace")))) 284 "-rbrace"))))
274 (cdr result))) 285 (cdr result)))
275 286
276 287
277 288