Mercurial > emacs
annotate lisp/mail/mh-pick.el @ 48540:283a6d8bdf2b
Comment.
author | Dave Love <fx@gnu.org> |
---|---|
date | Mon, 25 Nov 2002 19:06:07 +0000 |
parents | 2568d5a27317 |
children | 8aaba207e44b |
rev | line source |
---|---|
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
1 ;;; mh-pick.el --- make a search pattern and search for a message in mh-e |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
2 |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
3 ;; Copyright (C) 1993, 1995, 2001 Free Software Foundation, Inc. |
6365 | 4 |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
5 ;; Author: Bill Wohler <wohler@newt.com> |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
6 ;; Maintainer: Bill Wohler <wohler@newt.com> |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
7 ;; Keywords: mail |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
8 ;; See: mh-e.el |
6365 | 9 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
10 ;; This file is part of GNU Emacs. |
6365 | 11 |
11333 | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
6365 | 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 | |
11333 | 17 ;; GNU Emacs is distributed in the hope that it will be useful, |
6365 | 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 | |
14169 | 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. | |
6365 | 26 |
27 ;;; Commentary: | |
28 | |
29 ;; Internal support for mh-e package. | |
30 | |
11332 | 31 ;;; Change Log: |
32 | |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
33 ;; $Id: mh-pick.el,v 1.11 2001/12/29 00:10:41 wohler Exp $ |
11332 | 34 |
6365 | 35 ;;; Code: |
36 | |
37 (provide 'mh-pick) | |
38 (require 'mh-e) | |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
39 (require 'easymenu) |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
40 (require 'gnus-util) |
6365 | 41 |
42 (defvar mh-pick-mode-hook nil | |
43 "Invoked in `mh-pick-mode' on a new pattern.") | |
44 | |
11332 | 45 ;;; Internal variables: |
46 | |
47 (defvar mh-pick-mode-map (make-sparse-keymap) | |
48 "Keymap for searching folder.") | |
49 | |
50 (defvar mh-searching-folder nil) ;Folder this pick is searching. | |
6365 | 51 |
52 (defun mh-search-folder (folder) | |
11332 | 53 "Search FOLDER for messages matching a pattern. |
54 Add the messages found to the sequence named `search'." | |
6365 | 55 (interactive (list (mh-prompt-for-folder "Search" |
56 mh-current-folder | |
57 t))) | |
58 (switch-to-buffer-other-window "pick-pattern") | |
59 (if (or (zerop (buffer-size)) | |
60 (not (y-or-n-p "Reuse pattern? "))) | |
61 (mh-make-pick-template) | |
62 (message "")) | |
63 (setq mh-searching-folder folder)) | |
64 | |
65 (defun mh-make-pick-template () | |
66 ;; Initialize the current buffer with a template for a pick pattern. | |
67 (erase-buffer) | |
68 (insert "From: \n" | |
69 "To: \n" | |
70 "Cc: \n" | |
71 "Date: \n" | |
72 "Subject: \n" | |
73 "---------\n") | |
74 (mh-pick-mode) | |
75 (goto-char (point-min)) | |
76 (end-of-line)) | |
77 | |
78 (put 'mh-pick-mode 'mode-class 'special) | |
79 | |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
80 (define-derived-mode mh-pick-mode fundamental-mode "MH-Pick" |
6365 | 81 "Mode for creating search templates in mh-e.\\<mh-pick-mode-map> |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
82 |
11332 | 83 After each field name, enter the pattern to search for. If a field's |
84 value does not matter for the search, leave it empty. To search the | |
85 entire message, supply the pattern in the \"body\" of the template. | |
86 Each non-empty field must be matched for a message to be selected. | |
87 To effect a logical \"or\", use \\[mh-search-folder] multiple times. | |
6365 | 88 When you have finished, type \\[mh-do-pick-search] to do the search. |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
89 |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
90 This mode runs the hook `mh-pick-mode-hook'. |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
91 |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
92 \\{mh-pick-mode-map}" |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
93 |
6365 | 94 (make-local-variable 'mh-searching-folder) |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
95 (easy-menu-add mh-pick-menu)) |
6365 | 96 |
97 | |
98 (defun mh-do-pick-search () | |
99 "Find messages that match the qualifications in the current pattern buffer. | |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
100 Messages are searched for in the folder named in `mh-searching-folder'. |
11332 | 101 Add the messages found to the sequence named `search'." |
6365 | 102 (interactive) |
103 (let ((pattern-buffer (buffer-name)) | |
104 (searching-buffer mh-searching-folder) | |
11332 | 105 range |
106 msgs | |
107 (finding-messages t) | |
6365 | 108 (pattern nil) |
109 (new-buffer nil)) | |
110 (save-excursion | |
111 (cond ((get-buffer searching-buffer) | |
112 (set-buffer searching-buffer) | |
11332 | 113 (setq range (list (format "%d-%d" |
114 mh-first-msg-num mh-last-msg-num)))) | |
6365 | 115 (t |
116 (mh-make-folder searching-buffer) | |
11332 | 117 (setq range '("all")) |
6365 | 118 (setq new-buffer t)))) |
119 (message "Searching...") | |
120 (goto-char (point-min)) | |
11332 | 121 (while (and range |
122 (setq pattern (mh-next-pick-field pattern-buffer))) | |
6365 | 123 (setq msgs (mh-seq-from-command searching-buffer |
124 'search | |
11332 | 125 (mh-list-to-string |
126 (list "pick" pattern searching-buffer | |
127 "-list" | |
128 (mh-coalesce-msg-list range))))) | |
129 (setq range msgs)) ;restrict the pick range for next pass | |
6365 | 130 (message "Searching...done") |
131 (if new-buffer | |
132 (mh-scan-folder searching-buffer msgs) | |
133 (switch-to-buffer searching-buffer)) | |
11332 | 134 (mh-add-msgs-to-seq msgs 'search) |
135 (delete-other-windows))) | |
6365 | 136 |
137 | |
138 (defun mh-seq-from-command (folder seq seq-command) | |
139 ;; In FOLDER, make a sequence named SEQ by executing COMMAND. | |
140 ;; COMMAND is a list. The first element is a program name | |
141 ;; and the subsequent elements are its arguments, all strings. | |
142 (let ((msg) | |
143 (msgs ()) | |
144 (case-fold-search t)) | |
145 (save-excursion | |
146 (save-window-excursion | |
147 (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command)) | |
11332 | 148 ;; "pick" outputs one number per line |
6365 | 149 (while (setq msg (car (mh-read-msg-list))) |
150 (setq msgs (cons msg msgs)) | |
151 (forward-line 1)))) | |
152 (set-buffer folder) | |
11332 | 153 (setq msgs (nreverse msgs)) ;put in ascending order |
6365 | 154 msgs))) |
155 | |
156 | |
157 (defun mh-next-pick-field (buffer) | |
158 ;; Return the next piece of a pick argument that can be extracted from the | |
11332 | 159 ;; BUFFER. |
160 ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat") | |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
161 ;; or NIL if no pieces remain. |
6365 | 162 (set-buffer buffer) |
163 (let ((case-fold-search t)) | |
164 (cond ((eobp) | |
165 nil) | |
166 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t) | |
167 (let* ((component | |
168 (format "--%s" | |
169 (downcase (buffer-substring (match-beginning 1) | |
170 (match-end 1))))) | |
171 (pat (buffer-substring (match-beginning 2) (match-end 2)))) | |
172 (forward-line 1) | |
173 (list component pat))) | |
174 ((re-search-forward "^-*$" nil t) | |
175 (forward-char 1) | |
176 (let ((body (buffer-substring (point) (point-max)))) | |
177 (if (and (> (length body) 0) (not (equal body "\n"))) | |
178 (list "-search" body) | |
179 nil))) | |
180 (t | |
181 nil)))) | |
182 | |
183 ;;; Build the pick-mode keymap: | |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
184 (gnus-define-keys mh-pick-mode-map |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
185 "\C-c\C-c" mh-do-pick-search |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
186 "\C-c\C-f\C-b" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
187 "\C-c\C-f\C-c" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
188 "\C-c\C-f\C-d" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
189 "\C-c\C-f\C-f" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
190 "\C-c\C-f\C-r" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
191 "\C-c\C-f\C-s" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
192 "\C-c\C-f\C-t" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
193 "\C-c\C-fb" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
194 "\C-c\C-fc" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
195 "\C-c\C-fd" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
196 "\C-c\C-ff" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
197 "\C-c\C-fr" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
198 "\C-c\C-fs" mh-to-field |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
199 "\C-c\C-ft" mh-to-field) |
6365 | 200 |
47730
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
201 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
202 (easy-menu-define |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
203 mh-pick-menu mh-pick-mode-map "Menu for mh-e pick-mode" |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
204 '("Pick" |
2568d5a27317
Upgraded to mh-e version 6.1.1.
Bill Wohler <wohler@newt.com>
parents:
42206
diff
changeset
|
205 ["Execute the Search" mh-do-pick-search t])) |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
206 |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
207 ;;; mh-pick.el ends here |