1 ;;; mh-pick --- make a search pattern and search for a message in mh-e
2 ;; Time-stamp: <95/08/19 16:45:16 gildea>
4 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
6 ;; This file is part of mh-e, part of GNU Emacs.
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA.
25 ;; Internal support for mh-e package.
29 ;; $Id: mh-pick.el,v 1.4 1995/11/03 02:30:09 kwzh Exp erik $
36 (defvar mh-pick-mode-hook nil
37 "Invoked in `mh-pick-mode' on a new pattern.")
39 ;;; Internal variables:
41 (defvar mh-pick-mode-map
(make-sparse-keymap)
42 "Keymap for searching folder.")
44 (defvar mh-searching-folder nil
) ;Folder this pick is searching.
46 (defun mh-search-folder (folder)
47 "Search FOLDER for messages matching a pattern.
48 Add the messages found to the sequence named `search'."
49 (interactive (list (mh-prompt-for-folder "Search"
52 (switch-to-buffer-other-window "pick-pattern")
53 (if (or (zerop (buffer-size))
54 (not (y-or-n-p "Reuse pattern? ")))
55 (mh-make-pick-template)
57 (setq mh-searching-folder folder
))
59 (defun mh-make-pick-template ()
60 ;; Initialize the current buffer with a template for a pick pattern.
69 (goto-char (point-min))
72 (put 'mh-pick-mode
'mode-class
'special
)
74 (defun mh-pick-mode ()
75 "Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
76 After each field name, enter the pattern to search for. If a field's
77 value does not matter for the search, leave it empty. To search the
78 entire message, supply the pattern in the \"body\" of the template.
79 Each non-empty field must be matched for a message to be selected.
80 To effect a logical \"or\", use \\[mh-search-folder] multiple times.
81 When you have finished, type \\[mh-do-pick-search] to do the search.
83 Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook
84 if that value is non-nil."
86 (kill-all-local-variables)
87 (make-local-variable 'mh-searching-folder
)
88 (use-local-map mh-pick-mode-map
)
89 (setq major-mode
'mh-pick-mode
)
90 (mh-set-mode-name "MH-Pick")
91 (run-hooks 'mh-pick-mode-hook
))
94 (defun mh-do-pick-search ()
95 "Find messages that match the qualifications in the current pattern buffer.
96 Messages are searched for in the folder named in mh-searching-folder.
97 Add the messages found to the sequence named `search'."
99 (let ((pattern-buffer (buffer-name))
100 (searching-buffer mh-searching-folder
)
107 (cond ((get-buffer searching-buffer
)
108 (set-buffer searching-buffer
)
109 (setq range
(list (format "%d-%d"
110 mh-first-msg-num mh-last-msg-num
))))
112 (mh-make-folder searching-buffer
)
113 (setq range
'("all"))
114 (setq new-buffer t
))))
115 (message "Searching...")
116 (goto-char (point-min))
118 (setq pattern
(mh-next-pick-field pattern-buffer
)))
119 (setq msgs
(mh-seq-from-command searching-buffer
122 (list "pick" pattern searching-buffer
124 (mh-coalesce-msg-list range
)))))
125 (setq range msgs
)) ;restrict the pick range for next pass
126 (message "Searching...done")
128 (mh-scan-folder searching-buffer msgs
)
129 (switch-to-buffer searching-buffer
))
130 (mh-add-msgs-to-seq msgs
'search
)
131 (delete-other-windows)))
134 (defun mh-seq-from-command (folder seq seq-command
)
135 ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
136 ;; COMMAND is a list. The first element is a program name
137 ;; and the subsequent elements are its arguments, all strings.
140 (case-fold-search t
))
142 (save-window-excursion
143 (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command
))
144 ;; "pick" outputs one number per line
145 (while (setq msg
(car (mh-read-msg-list)))
146 (setq msgs
(cons msg msgs
))
149 (setq msgs
(nreverse msgs
)) ;put in ascending order
153 (defun mh-next-pick-field (buffer)
154 ;; Return the next piece of a pick argument that can be extracted from the
156 ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat")
157 ;; or NIL if no pieces remain.
159 (let ((case-fold-search t
))
162 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t
)
165 (downcase (buffer-substring (match-beginning 1)
167 (pat (buffer-substring (match-beginning 2) (match-end 2))))
169 (list component pat
)))
170 ((re-search-forward "^-*$" nil t
)
172 (let ((body (buffer-substring (point) (point-max))))
173 (if (and (> (length body
) 0) (not (equal body
"\n")))
174 (list "-search" body
)
179 ;;; Build the pick-mode keymap:
181 (define-key mh-pick-mode-map
"\C-c\C-c" 'mh-do-pick-search
)
182 (define-key mh-pick-mode-map
"\C-c\C-f\C-b" 'mh-to-field
)
183 (define-key mh-pick-mode-map
"\C-c\C-f\C-c" 'mh-to-field
)
184 (define-key mh-pick-mode-map
"\C-c\C-f\C-d" 'mh-to-field
)
185 (define-key mh-pick-mode-map
"\C-c\C-f\C-f" 'mh-to-field
)
186 (define-key mh-pick-mode-map
"\C-c\C-f\C-r" 'mh-to-field
)
187 (define-key mh-pick-mode-map
"\C-c\C-f\C-s" 'mh-to-field
)
188 (define-key mh-pick-mode-map
"\C-c\C-f\C-t" 'mh-to-field
)
189 (define-key mh-pick-mode-map
"\C-c\C-fb" 'mh-to-field
)
190 (define-key mh-pick-mode-map
"\C-c\C-fc" 'mh-to-field
)
191 (define-key mh-pick-mode-map
"\C-c\C-fd" 'mh-to-field
)
192 (define-key mh-pick-mode-map
"\C-c\C-ff" 'mh-to-field
)
193 (define-key mh-pick-mode-map
"\C-c\C-fr" 'mh-to-field
)
194 (define-key mh-pick-mode-map
"\C-c\C-fs" 'mh-to-field
)
195 (define-key mh-pick-mode-map
"\C-c\C-ft" 'mh-to-field
)