[bpt/emacs.git] / lisp / mh-e / mh-pick.el

;;; mh-pick.el --- make a search pattern and search for a message in MH-E

;; Copyright (C) 1993, 1995, 2001, 2003, 2004 Free Software Foundation, Inc.

;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Internal support for MH-E package.

;;; Change Log:

;;; Code:

(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'easymenu)
(require 'gnus-util)

;;; Internal variables:

(defvar mh-pick-mode-map (make-sparse-keymap)
  "Keymap for searching folder.")

(defvar mh-searching-folder nil)        ;Folder this pick is searching.
(defvar mh-searching-function nil)

(defconst mh-pick-single-dash  '(cc date from subject to)
  "Search components that are supported by single-dash option in pick.")

;;;###mh-autoload
(defun mh-search-folder (folder window-config)
  "Search FOLDER for messages matching a pattern.
This function uses the MH command `pick' to do the work.
Add the messages found to the sequence named `search'.
Argument WINDOW-CONFIG is the current window configuration and is used when
the search folder is dismissed."
  (interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t)
                     (current-window-configuration)))
  (let ((pick-folder (if (equal folder "+") mh-current-folder folder)))
    (switch-to-buffer-other-window "search-pattern")
    (if (or (zerop (buffer-size))
            (not (y-or-n-p "Reuse pattern? ")))
        (mh-make-pick-template)
      (message ""))
    (setq mh-searching-function 'mh-pick-do-search
          mh-searching-folder pick-folder)
    (mh-make-local-vars 'mh-current-folder folder
                        'mh-previous-window-config window-config)
    (message "%s" (substitute-command-keys
                   (concat "Type \\[mh-do-search] to search messages, "
                           "\\[mh-help] for help.")))))

(defun mh-make-pick-template ()
  "Initialize the current buffer with a template for a pick pattern."
  (let ((inhibit-read-only t)) (erase-buffer))
  (insert "From: \n"
          "To: \n"
          "Cc: \n"
          "Date: \n"
          "Subject: \n"
          "---------\n")
  (mh-pick-mode)
  (goto-char (point-min))
  (dotimes (i 5)
    (add-text-properties (point) (1+ (point)) '(front-sticky t))
    (add-text-properties (- (line-end-position) 2) (1- (line-end-position))
                         '(rear-nonsticky t))
    (add-text-properties (point) (1- (line-end-position)) '(read-only t))
    (forward-line))
  (add-text-properties (point) (1+ (point)) '(front-sticky t))
  (add-text-properties (point) (1- (line-end-position)) '(read-only t))
  (goto-char (point-max)))

;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
(easy-menu-define
  mh-pick-menu mh-pick-mode-map "Menu for MH-E pick-mode"
  '("Pick"
    ["Execute the Search"       mh-pick-do-search t]))


;;; Help Messages
;;; Group messages logically, more or less.
(defvar mh-pick-mode-help-messages
  '((nil
     "Search messages using pick:  \\[mh-pick-do-search]\n"
     "Search messages using index:  \\[mh-index-do-search]\n"
     "Move to a field by typing C-c C-f C-<field>\n"
     "where <field> is the first letter of the desired field."))
  "Key binding cheat sheet.

This is an associative array which is used to show the most common commands.
The key is a prefix char. The value is one or more strings which are
concatenated together and displayed in the minibuffer if ? is pressed after
the prefix character. The special key nil is used to display the
non-prefixed commands.

The substitutions described in `substitute-command-keys' are performed as
well.")

(put 'mh-pick-mode 'mode-class 'special)

(define-derived-mode mh-pick-mode fundamental-mode "MH-Pick"
  "Mode for creating search templates in MH-E.\\<mh-pick-mode-map>

After each field name, enter the pattern to search for.  If a field's
value does not matter for the search, leave it empty.  To search the
entire message, supply the pattern in the \"body\" of the template.
Each non-empty field must be matched for a message to be selected.
To effect a logical \"or\", use \\[mh-search-folder] multiple times.
When you have finished, type  \\[mh-pick-do-search]  to do the search.

The value of `mh-pick-mode-hook' is a list of functions to be called,
with no arguments, upon entry to this mode.

\\{mh-pick-mode-map}"

  (make-local-variable 'mh-searching-folder)
  (make-local-variable 'mh-searching-function)
  (make-local-variable 'mh-help-messages)
  (easy-menu-add mh-pick-menu)
  (setq mh-help-messages mh-pick-mode-help-messages)
  (run-hooks 'mh-pick-mode-hook))

;;;###mh-autoload
(defun mh-pick-do-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'."
  (interactive)
  (let ((pattern-list (mh-pick-parse-search-buffer))
        (folder mh-searching-folder)
        (new-buffer-flag nil)
        (window-config mh-previous-window-config)
        range pick-args msgs)
    (unless pattern-list
      (error "No search pattern specified"))
    (save-excursion
      (cond ((get-buffer folder)
             (set-buffer folder)
             (setq range (if (and mh-first-msg-num mh-last-msg-num)
                             (format "%d-%d" mh-first-msg-num mh-last-msg-num)
                           "all")))
            (t
             (mh-make-folder folder)
             (setq range "all")
             (setq new-buffer-flag t))))
    (setq pick-args (mh-pick-regexp-builder pattern-list))
    (when pick-args
      (setq msgs (mh-seq-from-command folder 'search
                                      `("pick" ,folder ,range ,@pick-args))))
    (message "Searching...done")
    (if (not new-buffer-flag)
        (switch-to-buffer folder)
      (mh-scan-folder folder msgs)
      (setq mh-previous-window-config window-config))
    (mh-add-msgs-to-seq msgs 'search)
    (delete-other-windows)))

;;;###mh-autoload
(defun mh-do-search ()
  "Use the default searching function.
If \\[mh-search-folder] was used to create the search pattern then pick is used
to search the folder. Otherwise if \\[mh-index-search] was used then the
indexing program specified in `mh-index-program' is used."
  (interactive)
  (if (symbolp mh-searching-function)
      (funcall mh-searching-function)
    (error "No searching function defined")))

(defun mh-seq-from-command (folder seq command)
  "In FOLDER, make a sequence named SEQ by executing COMMAND.
COMMAND is a list.  The first element is a program name
and the subsequent elements are its arguments, all strings."
  (let ((msg)
        (msgs ())
        (case-fold-search t))
    (save-excursion
      (save-window-excursion
        (if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
            ;; "pick" outputs one number per line
            (while (setq msg (car (mh-read-msg-list)))
              (setq msgs (cons msg msgs))
              (forward-line 1))))
      (set-buffer folder)
      (setq msgs (nreverse msgs))       ;put in ascending order
      msgs)))

(defun mh-pick-parse-search-buffer ()
  "Parse the search buffer contents.
The function returns a alist. The car of each element is either the header name
to search in or nil to search the whole message. The cdr of the element is the
pattern to search."
  (save-excursion
    (let ((pattern-list ())
          (in-body-flag nil)
          start begin)
      (goto-char (point-min))
      (while (not (eobp))
        (if (search-forward "--------" (line-end-position) t)
            (setq in-body-flag t)
          (beginning-of-line)
          (setq begin (point))
          (setq start (if in-body-flag
                          (point)
                        (search-forward ":" (line-end-position) t)
                        (point)))
          (push (cons (and (not in-body-flag)
                           (intern (downcase
                                    (buffer-substring-no-properties
                                     begin (1- start)))))
                      (mh-index-parse-search-regexp
                       (buffer-substring-no-properties
                        start (line-end-position))))
                pattern-list))
        (forward-line))
      pattern-list)))

\f

;; Functions specific to how pick works...
(defun mh-pick-construct-regexp (expr component)
  "Construct pick compatible expression corresponding to EXPR.
COMPONENT is the component to search."
  (cond ((atom expr) (list component expr))
        ((eq (car expr) 'and)
         `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-and"
           ,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace"))
        ((eq (car expr) 'or)
         `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-or"
           ,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace"))
        ((eq (car expr) 'not)
         `("-lbrace" "-not" ,@(mh-pick-construct-regexp (cadr expr) component)
           "-rbrace"))
        (t (error "Unknown operator '%s' seen" (car expr)))))

;; All implementations of pick have special options -cc, -date, -from and
;; -subject that allow to search for corresponding components. Any other
;; component is searched using option --COMPNAME, for example: `pick
;; --x-mailer mh-e'. Mailutils `pick' supports this option using a certain
;; kludge, but it prefers the following syntax for this purpose:
;; `--component=COMPNAME --pattern=PATTERN'.
;;                                           -- Sergey Poznyakoff, Aug 2003
(defun mh-pick-regexp-builder (pattern-list)
  "Generate pick search expression from PATTERN-LIST."
  (let ((result ()))
    (dolist (pattern pattern-list)
      (when (cdr pattern)
        (setq result `(,@result "-and" "-lbrace"
                       ,@(mh-pick-construct-regexp
                          (if (and (mh-variant-p 'mu-mh) (car pattern))
                              (format "--pattern=%s" (cdr pattern))
                            (cdr pattern))
                          (if (car pattern)
                              (cond
                               ((mh-variant-p 'mu-mh)
                                (format "--component=%s" (car pattern)))
                               ((member (car pattern) mh-pick-single-dash)
                                (format "-%s" (car pattern)))
                               (t
                                (format "--%s" (car pattern))))
                            "-search"))
                       "-rbrace"))))
    (cdr result)))

\f

;;; Build the pick-mode keymap:
;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
(gnus-define-keys  mh-pick-mode-map
  "\C-c?"               mh-help
  "\C-c\C-i"            mh-index-do-search
  "\C-c\C-p"            mh-pick-do-search
  "\C-c\C-c"            mh-do-search
  "\C-c\C-f\C-b"        mh-to-field
  "\C-c\C-f\C-c"        mh-to-field
  "\C-c\C-f\C-d"        mh-to-field
  "\C-c\C-f\C-f"        mh-to-field
  "\C-c\C-f\C-r"        mh-to-field
  "\C-c\C-f\C-s"        mh-to-field
  "\C-c\C-f\C-t"        mh-to-field
  "\C-c\C-fb"           mh-to-field
  "\C-c\C-fc"           mh-to-field
  "\C-c\C-fd"           mh-to-field
  "\C-c\C-ff"           mh-to-field
  "\C-c\C-fr"           mh-to-field
  "\C-c\C-fs"           mh-to-field
  "\C-c\C-ft"           mh-to-field)

(provide 'mh-pick)

;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:

;;; arch-tag: aef2b271-7768-42bd-a782-9a14ba9f83f7
;;; mh-pick.el ends here
Commit	Line	Data
bdcfe844	1	;;; mh-pick.el --- make a search pattern and search for a message in MH-E
c26cf6c8	2
f0d73c14	3	;; Copyright (C) 1993, 1995, 2001, 2003, 2004 Free Software Foundation, Inc.
a1b4049d BW	4
	5	;; Author: Bill Wohler <wohler@newt.com>
	6	;; Maintainer: Bill Wohler <wohler@newt.com>
	7	;; Keywords: mail
	8	;; See: mh-e.el
c26cf6c8	9
60370d40	10	;; This file is part of GNU Emacs.
c26cf6c8	11
9b7bc076	12	;; GNU Emacs is free software; you can redistribute it and/or modify
c26cf6c8 RS	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)
	15	;; any later version.
	16
9b7bc076	17	;; GNU Emacs is distributed in the hope that it will be useful,
c26cf6c8 RS	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.
	21
	22	;; You should have received a copy of the GNU General Public License
b578f267 EN	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.
c26cf6c8 RS	26
	27	;;; Commentary:
	28
bdcfe844	29	;; Internal support for MH-E package.
c26cf6c8	30
847b8219 KH	31	;;; Change Log:
847b8219 KH	32
c26cf6c8 RS	33	;;; Code:
c26cf6c8 RS	34
f0d73c14 BW	35	(eval-when-compile (require 'mh-acros))
f0d73c14 BW	36	(mh-require-cl)
c26cf6c8	37	(require 'mh-e)
a1b4049d BW	38	(require 'easymenu)
a1b4049d BW	39	(require 'gnus-util)
c26cf6c8	40
847b8219 KH	41	;;; Internal variables:
	42
	43	(defvar mh-pick-mode-map (make-sparse-keymap)
	44	"Keymap for searching folder.")
	45
c3d9274a	46	(defvar mh-searching-folder nil) ;Folder this pick is searching.
3d7ca223	47	(defvar mh-searching-function nil)
c26cf6c8	48
f0d73c14 BW	49	(defconst mh-pick-single-dash '(cc date from subject to)
	50	"Search components that are supported by single-dash option in pick.")
	51
c3d9274a	52	;;;###mh-autoload
3d7ca223	53	(defun mh-search-folder (folder window-config)
847b8219	54	"Search FOLDER for messages matching a pattern.
bdcfe844	55	This function uses the MH command `pick' to do the work.
3d7ca223 BW	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)
	66	(message ""))
	67	(setq mh-searching-function 'mh-pick-do-search
924df208 BW	68	mh-searching-folder pick-folder)
	69	(mh-make-local-vars 'mh-current-folder folder
	70	'mh-previous-window-config window-config)
3d7ca223 BW	71	(message "%s" (substitute-command-keys
	72	(concat "Type \\[mh-do-search] to search messages, "
	73	"\\[mh-help] for help.")))))
c26cf6c8 RS	74
c26cf6c8 RS	75	(defun mh-make-pick-template ()
bdcfe844	76	"Initialize the current buffer with a template for a pick pattern."
3d7ca223	77	(let ((inhibit-read-only t)) (erase-buffer))
c26cf6c8	78	(insert "From: \n"
c3d9274a BW	79	"To: \n"
	80	"Cc: \n"
	81	"Date: \n"
	82	"Subject: \n"
	83	"---------\n")
c26cf6c8 RS	84	(mh-pick-mode)
c26cf6c8 RS	85	(goto-char (point-min))
3d7ca223 BW	86	(dotimes (i 5)
	87	(add-text-properties (point) (1+ (point)) '(front-sticky t))
	88	(add-text-properties (- (line-end-position) 2) (1- (line-end-position))
	89	'(rear-nonsticky t))
	90	(add-text-properties (point) (1- (line-end-position)) '(read-only t))
	91	(forward-line))
	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)))
c26cf6c8	95
bdcfe844 BW	96	;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
	97	(easy-menu-define
	98	mh-pick-menu mh-pick-mode-map "Menu for MH-E pick-mode"
	99	'("Pick"
3d7ca223	100	["Execute the Search" mh-pick-do-search t]))
bdcfe844 BW	101
	102
	103	;;; Help Messages
	104	;;; Group messages logically, more or less.
	105	(defvar mh-pick-mode-help-messages
	106	'((nil
3d7ca223 BW	107	"Search messages using pick: \\[mh-pick-do-search]\n"
3d7ca223 BW	108	"Search messages using index: \\[mh-index-do-search]\n"
bdcfe844 BW	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.
	112
	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.
	118
	119	The substitutions described in `substitute-command-keys' are performed as
	120	well.")
	121
c26cf6c8 RS	122	(put 'mh-pick-mode 'mode-class 'special)
c26cf6c8 RS	123
a1b4049d	124	(define-derived-mode mh-pick-mode fundamental-mode "MH-Pick"
bdcfe844	125	"Mode for creating search templates in MH-E.\\<mh-pick-mode-map>
a1b4049d	126
847b8219 KH	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.
3d7ca223	132	When you have finished, type \\[mh-pick-do-search] to do the search.
a1b4049d	133
bdcfe844 BW	134	The value of `mh-pick-mode-hook' is a list of functions to be called,
bdcfe844 BW	135	with no arguments, upon entry to this mode.
a1b4049d BW	136
	137	\\{mh-pick-mode-map}"
	138
c26cf6c8	139	(make-local-variable 'mh-searching-folder)
3d7ca223	140	(make-local-variable 'mh-searching-function)
bdcfe844	141	(make-local-variable 'mh-help-messages)
3d7ca223	142	(easy-menu-add mh-pick-menu)
bdcfe844 BW	143	(setq mh-help-messages mh-pick-mode-help-messages)
bdcfe844 BW	144	(run-hooks 'mh-pick-mode-hook))
c26cf6c8	145
3d7ca223 BW	146	;;;###mh-autoload
	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'.
847b8219	150	Add the messages found to the sequence named `search'."
c26cf6c8	151	(interactive)
3d7ca223 BW	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)
	157	(unless pattern-list
	158	(error "No search pattern specified"))
c26cf6c8	159	(save-excursion
3d7ca223 BW	160	(cond ((get-buffer folder)
	161	(set-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)
	164	"all")))
c3d9274a	165	(t
3d7ca223 BW	166	(mh-make-folder folder)
	167	(setq range "all")
	168	(setq new-buffer-flag t))))
	169	(setq pick-args (mh-pick-regexp-builder pattern-list))
	170	(when pick-args
	171	(setq msgs (mh-seq-from-command folder 'search
	172	`("pick" ,folder ,range ,@pick-args))))
c26cf6c8	173	(message "Searching...done")
3d7ca223 BW	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))
847b8219 KH	178	(mh-add-msgs-to-seq msgs 'search)
847b8219 KH	179	(delete-other-windows)))
c26cf6c8	180
3d7ca223 BW	181	;;;###mh-autoload
	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."
	187	(interactive)
	188	(if (symbolp mh-searching-function)
	189	(funcall mh-searching-function)
	190	(error "No searching function defined")))
	191
bdcfe844 BW	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."
c26cf6c8	196	(let ((msg)
c3d9274a BW	197	(msgs ())
c3d9274a BW	198	(case-fold-search t))
c26cf6c8 RS	199	(save-excursion
c26cf6c8 RS	200	(save-window-excursion
c3d9274a BW	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))
	205	(forward-line 1))))
c26cf6c8	206	(set-buffer folder)
c3d9274a	207	(setq msgs (nreverse msgs)) ;put in ascending order
c26cf6c8 RS	208	msgs)))
c26cf6c8 RS	209
3d7ca223 BW	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
	214	pattern to search."
	215	(save-excursion
	216	(let ((pattern-list ())
	217	(in-body-flag nil)
	218	start begin)
	219	(goto-char (point-min))
	220	(while (not (eobp))
	221	(if (search-forward "--------" (line-end-position) t)
	222	(setq in-body-flag t)
	223	(beginning-of-line)
	224	(setq begin (point))
	225	(setq start (if in-body-flag
	226	(point)
	227	(search-forward ":" (line-end-position) t)
	228	(point)))
	229	(push (cons (and (not in-body-flag)
	230	(intern (downcase
	231	(buffer-substring-no-properties
	232	begin (1- start)))))
	233	(mh-index-parse-search-regexp
	234	(buffer-substring-no-properties
	235	start (line-end-position))))
	236	pattern-list))
	237	(forward-line))
	238	pattern-list)))
	239
	240	\f
	241
	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"))
	250	((eq (car expr) 'or)
	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)
	255	"-rbrace"))
	256	(t (error "Unknown operator '%s' seen" (car expr)))))
	257
f0d73c14 BW	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
3d7ca223 BW	265	(defun mh-pick-regexp-builder (pattern-list)
	266	"Generate pick search expression from PATTERN-LIST."
	267	(let ((result ()))
	268	(dolist (pattern pattern-list)
	269	(when (cdr pattern)
	270	(setq result `(,@result "-and" "-lbrace"
	271	,@(mh-pick-construct-regexp
f0d73c14 BW	272	(if (and (mh-variant-p 'mu-mh) (car pattern))
	273	(format "--pattern=%s" (cdr pattern))
	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"))
3d7ca223 BW	284	"-rbrace"))))
3d7ca223 BW	285	(cdr result)))
c26cf6c8	286
bdcfe844 BW	287	\f
bdcfe844 BW	288
c26cf6c8	289	;;; Build the pick-mode keymap:
bdcfe844	290	;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
a1b4049d	291	(gnus-define-keys mh-pick-mode-map
c3d9274a	292	"\C-c?" mh-help
3d7ca223 BW	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
c3d9274a BW	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)
a1b4049d	310
bdcfe844 BW	311	(provide 'mh-pick)
	312
	313	;;; Local Variables:
c3d9274a	314	;;; indent-tabs-mode: nil
bdcfe844 BW	315	;;; sentence-end-double-space: nil
bdcfe844 BW	316	;;; End:
60370d40	317
ab5796a9	318	;;; arch-tag: aef2b271-7768-42bd-a782-9a14ba9f83f7
60370d40	319	;;; mh-pick.el ends here