6365
|
1 ;;; mh-pick --- make a search pattern and search for a message in mh-e
|
|
2 ;; Time-stamp: <93/08/22 22:56:53 gildea>
|
|
3
|
|
4 ;; Copyright 1993 Free Software Foundation, Inc.
|
|
5
|
|
6 ;; This file is part of mh-e.
|
|
7
|
|
8 ;; mh-e 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)
|
|
11 ;; any later version.
|
|
12
|
|
13 ;; mh-e 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.
|
|
17
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
19 ;; along with mh-e; see the file COPYING. If not, write to
|
|
20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
21
|
|
22 ;;; Commentary:
|
|
23
|
|
24 ;; Internal support for mh-e package.
|
|
25
|
|
26 ;;; Code:
|
|
27
|
|
28 (provide 'mh-pick)
|
|
29 (require 'mh-e)
|
|
30
|
|
31 (defvar mh-pick-mode-map (make-sparse-keymap)
|
|
32 "Keymap for searching folder.")
|
|
33
|
|
34 (defvar mh-pick-mode-hook nil
|
|
35 "Invoked in `mh-pick-mode' on a new pattern.")
|
|
36
|
|
37 (defvar mh-searching-folder nil
|
|
38 "Folder this pick is searching.")
|
|
39
|
|
40 (defun mh-search-folder (folder)
|
|
41 "Search FOLDER for messages matching a pattern."
|
|
42 (interactive (list (mh-prompt-for-folder "Search"
|
|
43 mh-current-folder
|
|
44 t)))
|
|
45 (switch-to-buffer-other-window "pick-pattern")
|
|
46 (if (or (zerop (buffer-size))
|
|
47 (not (y-or-n-p "Reuse pattern? ")))
|
|
48 (mh-make-pick-template)
|
|
49 (message ""))
|
|
50 (setq mh-searching-folder folder))
|
|
51
|
|
52 (defun mh-make-pick-template ()
|
|
53 ;; Initialize the current buffer with a template for a pick pattern.
|
|
54 (erase-buffer)
|
|
55 (insert "From: \n"
|
|
56 "To: \n"
|
|
57 "Cc: \n"
|
|
58 "Date: \n"
|
|
59 "Subject: \n"
|
|
60 "---------\n")
|
|
61 (mh-pick-mode)
|
|
62 (goto-char (point-min))
|
|
63 (end-of-line))
|
|
64
|
|
65 (put 'mh-pick-mode 'mode-class 'special)
|
|
66
|
|
67 (defun mh-pick-mode ()
|
|
68 "Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
|
|
69 After each field name, enter the pattern to search for. To search
|
|
70 the entire message, supply the pattern in the \"body\" of the template.
|
|
71 When you have finished, type \\[mh-do-pick-search] to do the search.
|
|
72 \\{mh-pick-mode-map}
|
|
73 Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook
|
|
74 if that value is non-nil."
|
|
75 (interactive)
|
|
76 (kill-all-local-variables)
|
|
77 (make-local-variable 'mh-searching-folder)
|
|
78 (use-local-map mh-pick-mode-map)
|
|
79 (setq major-mode 'mh-pick-mode)
|
|
80 (mh-set-mode-name "MH-Pick")
|
|
81 (run-hooks 'mh-pick-mode-hook))
|
|
82
|
|
83
|
|
84 (defun mh-do-pick-search ()
|
|
85 "Find messages that match the qualifications in the current pattern buffer.
|
|
86 Messages are searched for in the folder named in mh-searching-folder.
|
|
87 Add messages found to the sequence named `search'."
|
|
88 (interactive)
|
|
89 (let ((pattern-buffer (buffer-name))
|
|
90 (searching-buffer mh-searching-folder)
|
|
91 range msgs
|
|
92 (pattern nil)
|
|
93 (new-buffer nil))
|
|
94 (save-excursion
|
|
95 (cond ((get-buffer searching-buffer)
|
|
96 (set-buffer searching-buffer)
|
|
97 (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num)))
|
|
98 (t
|
|
99 (mh-make-folder searching-buffer)
|
|
100 (setq range "all")
|
|
101 (setq new-buffer t))))
|
|
102 (message "Searching...")
|
|
103 (goto-char (point-min))
|
|
104 (while (setq pattern (mh-next-pick-field pattern-buffer))
|
|
105 (setq msgs (mh-seq-from-command searching-buffer
|
|
106 'search
|
|
107 (nconc (cons "pick" pattern)
|
|
108 (list searching-buffer
|
|
109 range
|
|
110 "-sequence" "search"
|
|
111 "-list"))))
|
|
112 (setq range "search"))
|
|
113 (message "Searching...done")
|
|
114 (if new-buffer
|
|
115 (mh-scan-folder searching-buffer msgs)
|
|
116 (switch-to-buffer searching-buffer))
|
|
117 (delete-other-windows)
|
|
118 (mh-notate-seq 'search ?% (1+ mh-cmd-note))))
|
|
119
|
|
120
|
|
121 (defun mh-seq-from-command (folder seq seq-command)
|
|
122 ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
|
|
123 ;; COMMAND is a list. The first element is a program name
|
|
124 ;; and the subsequent elements are its arguments, all strings.
|
|
125 (let ((msg)
|
|
126 (msgs ())
|
|
127 (case-fold-search t))
|
|
128 (save-excursion
|
|
129 (save-window-excursion
|
|
130 (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command))
|
|
131 (while (setq msg (car (mh-read-msg-list)))
|
|
132 (setq msgs (cons msg msgs))
|
|
133 (forward-line 1))))
|
|
134 (set-buffer folder)
|
|
135 (setq msgs (nreverse msgs)) ; Put in ascending order
|
|
136 (setq mh-seq-list (cons (mh-make-seq seq msgs) mh-seq-list))
|
|
137 msgs)))
|
|
138
|
|
139
|
|
140 (defun mh-next-pick-field (buffer)
|
|
141 ;; Return the next piece of a pick argument that can be extracted from the
|
|
142 ;; BUFFER. Returns nil if no pieces remain.
|
|
143 (set-buffer buffer)
|
|
144 (let ((case-fold-search t))
|
|
145 (cond ((eobp)
|
|
146 nil)
|
|
147 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
|
|
148 (let* ((component
|
|
149 (format "--%s"
|
|
150 (downcase (buffer-substring (match-beginning 1)
|
|
151 (match-end 1)))))
|
|
152 (pat (buffer-substring (match-beginning 2) (match-end 2))))
|
|
153 (forward-line 1)
|
|
154 (list component pat)))
|
|
155 ((re-search-forward "^-*$" nil t)
|
|
156 (forward-char 1)
|
|
157 (let ((body (buffer-substring (point) (point-max))))
|
|
158 (if (and (> (length body) 0) (not (equal body "\n")))
|
|
159 (list "-search" body)
|
|
160 nil)))
|
|
161 (t
|
|
162 nil))))
|
|
163
|
|
164 ;;; Build the pick-mode keymap:
|
|
165
|
|
166 (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
|
|
167 (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
|
|
168 (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
|
|
169 (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
|
|
170 (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
|
|
171 (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
|
|
172 (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
|
|
173 (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
|
|
174 (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
|
|
175 (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
|
|
176 (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)
|
|
177 (define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom)
|