Commit | Line | Data |
---|---|---|
60370d40 PJ |
1 | ;;; mh-pick.el --- make a search pattern and search for a message in mh-e |
2 | ;; Time-stamp: <2001-07-14 13:09:34 pavel> | |
c26cf6c8 | 3 | |
847b8219 | 4 | ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. |
c26cf6c8 | 5 | |
60370d40 | 6 | ;; This file is part of GNU Emacs. |
c26cf6c8 | 7 | |
9b7bc076 | 8 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
c26cf6c8 RS |
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) | |
11 | ;; any later version. | |
12 | ||
9b7bc076 | 13 | ;; GNU Emacs is distributed in the hope that it will be useful, |
c26cf6c8 RS |
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. | |
17 | ||
18 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
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. | |
c26cf6c8 RS |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; Internal support for mh-e package. | |
26 | ||
847b8219 KH |
27 | ;;; Change Log: |
28 | ||
60370d40 | 29 | ;; $Id: mh-pick.el,v 1.5 1996/01/14 07:34:30 erik Exp $ |
847b8219 | 30 | |
c26cf6c8 RS |
31 | ;;; Code: |
32 | ||
33 | (provide 'mh-pick) | |
34 | (require 'mh-e) | |
35 | ||
c26cf6c8 RS |
36 | (defvar mh-pick-mode-hook nil |
37 | "Invoked in `mh-pick-mode' on a new pattern.") | |
38 | ||
847b8219 KH |
39 | ;;; Internal variables: |
40 | ||
41 | (defvar mh-pick-mode-map (make-sparse-keymap) | |
42 | "Keymap for searching folder.") | |
43 | ||
44 | (defvar mh-searching-folder nil) ;Folder this pick is searching. | |
c26cf6c8 RS |
45 | |
46 | (defun mh-search-folder (folder) | |
847b8219 KH |
47 | "Search FOLDER for messages matching a pattern. |
48 | Add the messages found to the sequence named `search'." | |
c26cf6c8 RS |
49 | (interactive (list (mh-prompt-for-folder "Search" |
50 | mh-current-folder | |
51 | t))) | |
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) | |
56 | (message "")) | |
57 | (setq mh-searching-folder folder)) | |
58 | ||
59 | (defun mh-make-pick-template () | |
60 | ;; Initialize the current buffer with a template for a pick pattern. | |
61 | (erase-buffer) | |
62 | (insert "From: \n" | |
63 | "To: \n" | |
64 | "Cc: \n" | |
65 | "Date: \n" | |
66 | "Subject: \n" | |
67 | "---------\n") | |
68 | (mh-pick-mode) | |
69 | (goto-char (point-min)) | |
70 | (end-of-line)) | |
71 | ||
72 | (put 'mh-pick-mode 'mode-class 'special) | |
73 | ||
74 | (defun mh-pick-mode () | |
75 | "Mode for creating search templates in mh-e.\\<mh-pick-mode-map> | |
847b8219 KH |
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. | |
c26cf6c8 RS |
81 | When you have finished, type \\[mh-do-pick-search] to do the search. |
82 | \\{mh-pick-mode-map} | |
83 | Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook | |
84 | if that value is non-nil." | |
85 | (interactive) | |
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)) | |
92 | ||
93 | ||
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. | |
847b8219 | 97 | Add the messages found to the sequence named `search'." |
c26cf6c8 RS |
98 | (interactive) |
99 | (let ((pattern-buffer (buffer-name)) | |
100 | (searching-buffer mh-searching-folder) | |
847b8219 KH |
101 | range |
102 | msgs | |
103 | (finding-messages t) | |
c26cf6c8 RS |
104 | (pattern nil) |
105 | (new-buffer nil)) | |
106 | (save-excursion | |
107 | (cond ((get-buffer searching-buffer) | |
108 | (set-buffer searching-buffer) | |
847b8219 KH |
109 | (setq range (list (format "%d-%d" |
110 | mh-first-msg-num mh-last-msg-num)))) | |
c26cf6c8 RS |
111 | (t |
112 | (mh-make-folder searching-buffer) | |
847b8219 | 113 | (setq range '("all")) |
c26cf6c8 RS |
114 | (setq new-buffer t)))) |
115 | (message "Searching...") | |
116 | (goto-char (point-min)) | |
847b8219 KH |
117 | (while (and range |
118 | (setq pattern (mh-next-pick-field pattern-buffer))) | |
c26cf6c8 RS |
119 | (setq msgs (mh-seq-from-command searching-buffer |
120 | 'search | |
847b8219 KH |
121 | (mh-list-to-string |
122 | (list "pick" pattern searching-buffer | |
123 | "-list" | |
124 | (mh-coalesce-msg-list range))))) | |
125 | (setq range msgs)) ;restrict the pick range for next pass | |
c26cf6c8 RS |
126 | (message "Searching...done") |
127 | (if new-buffer | |
128 | (mh-scan-folder searching-buffer msgs) | |
129 | (switch-to-buffer searching-buffer)) | |
847b8219 KH |
130 | (mh-add-msgs-to-seq msgs 'search) |
131 | (delete-other-windows))) | |
c26cf6c8 RS |
132 | |
133 | ||
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. | |
138 | (let ((msg) | |
139 | (msgs ()) | |
140 | (case-fold-search t)) | |
141 | (save-excursion | |
142 | (save-window-excursion | |
143 | (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command)) | |
847b8219 | 144 | ;; "pick" outputs one number per line |
c26cf6c8 RS |
145 | (while (setq msg (car (mh-read-msg-list))) |
146 | (setq msgs (cons msg msgs)) | |
147 | (forward-line 1)))) | |
148 | (set-buffer folder) | |
847b8219 | 149 | (setq msgs (nreverse msgs)) ;put in ascending order |
c26cf6c8 RS |
150 | msgs))) |
151 | ||
152 | ||
153 | (defun mh-next-pick-field (buffer) | |
154 | ;; Return the next piece of a pick argument that can be extracted from the | |
847b8219 KH |
155 | ;; BUFFER. |
156 | ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat") | |
157 | ;; or NIL if no pieces remain. | |
c26cf6c8 RS |
158 | (set-buffer buffer) |
159 | (let ((case-fold-search t)) | |
160 | (cond ((eobp) | |
161 | nil) | |
162 | ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t) | |
163 | (let* ((component | |
164 | (format "--%s" | |
165 | (downcase (buffer-substring (match-beginning 1) | |
166 | (match-end 1))))) | |
167 | (pat (buffer-substring (match-beginning 2) (match-end 2)))) | |
168 | (forward-line 1) | |
169 | (list component pat))) | |
170 | ((re-search-forward "^-*$" nil t) | |
171 | (forward-char 1) | |
172 | (let ((body (buffer-substring (point) (point-max)))) | |
173 | (if (and (> (length body) 0) (not (equal body "\n"))) | |
174 | (list "-search" body) | |
175 | nil))) | |
176 | (t | |
177 | nil)))) | |
178 | ||
179 | ;;; Build the pick-mode keymap: | |
180 | ||
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) | |
847b8219 | 184 | (define-key mh-pick-mode-map "\C-c\C-f\C-d" 'mh-to-field) |
c26cf6c8 | 185 | (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field) |
847b8219 | 186 | (define-key mh-pick-mode-map "\C-c\C-f\C-r" 'mh-to-field) |
c26cf6c8 RS |
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) | |
847b8219 | 191 | (define-key mh-pick-mode-map "\C-c\C-fd" 'mh-to-field) |
c26cf6c8 | 192 | (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field) |
847b8219 | 193 | (define-key mh-pick-mode-map "\C-c\C-fr" 'mh-to-field) |
c26cf6c8 RS |
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) | |
60370d40 PJ |
196 | |
197 | ;;; mh-pick.el ends here |