Mercurial > hg > xemacs-beta

comparison lisp/mh-e/mh-pick.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 131b0175ea99
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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>
3
4 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
5
6 ;; This file is part of mh-e, part of GNU Emacs.
7
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)
11 ;; any later version.
12
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.
17
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
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 ;;; Change Log:
27
28 ;; $Id: mh-pick.el,v 1.1.1.1 1996/12/18 03:34:38 steve Exp $
29
30 ;;; Code:
31
32 (provide 'mh-pick)
33 (require 'mh-e)
34
35 (defvar mh-pick-mode-hook nil
36 "Invoked in `mh-pick-mode' on a new pattern.")
37
38 ;;; Internal variables:
39
40 (defvar mh-pick-mode-map (make-sparse-keymap)
41 "Keymap for searching folder.")
42
43 (defvar mh-searching-folder nil) ;Folder this pick is searching.
44
45 (defun mh-search-folder (folder)
46 "Search FOLDER for messages matching a pattern.
47 Add the messages found to the sequence named `search'."
48 (interactive (list (mh-prompt-for-folder "Search"
49 mh-current-folder
50 t)))
51 (switch-to-buffer-other-window "pick-pattern")
52 (if (or (zerop (buffer-size))
53 (not (y-or-n-p "Reuse pattern? ")))
54 (mh-make-pick-template)
55 (message ""))
56 (setq mh-searching-folder folder))
57
58 (defun mh-make-pick-template ()
59 ;; Initialize the current buffer with a template for a pick pattern.
60 (erase-buffer)
61 (insert "From: \n"
62 "To: \n"
63 "Cc: \n"
64 "Date: \n"
65 "Subject: \n"
66 "---------\n")
67 (mh-pick-mode)
68 (goto-char (point-min))
69 (end-of-line))
70
71 (put 'mh-pick-mode 'mode-class 'special)
72
73 (defun mh-pick-mode ()
74 "Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
75 After each field name, enter the pattern to search for. If a field's
76 value does not matter for the search, leave it empty. To search the
77 entire message, supply the pattern in the \"body\" of the template.
78 Each non-empty field must be matched for a message to be selected.
79 To effect a logical \"or\", use \\[mh-search-folder] multiple times.
80 When you have finished, type \\[mh-do-pick-search] to do the search.
81 \\{mh-pick-mode-map}
82 Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook
83 if that value is non-nil."
84 (interactive)
85 (kill-all-local-variables)
86 (make-local-variable 'mh-searching-folder)
87 (use-local-map mh-pick-mode-map)
88 (setq major-mode 'mh-pick-mode)
89 (mh-set-mode-name "MH-Pick")
90 (run-hooks 'mh-pick-mode-hook))
91
92
93 (defun mh-do-pick-search ()
94 "Find messages that match the qualifications in the current pattern buffer.
95 Messages are searched for in the folder named in mh-searching-folder.
96 Add the messages found to the sequence named `search'."
97 (interactive)
98 (let ((pattern-buffer (buffer-name))
99 (searching-buffer mh-searching-folder)
100 range
101 msgs
102 (finding-messages t)
103 (pattern nil)
104 (new-buffer nil))
105 (save-excursion
106 (cond ((get-buffer searching-buffer)
107 (set-buffer searching-buffer)
108 (setq range (list (format "%d-%d"
109 mh-first-msg-num mh-last-msg-num))))
110 (t
111 (mh-make-folder searching-buffer)
112 (setq range '("all"))
113 (setq new-buffer t))))
114 (message "Searching...")
115 (goto-char (point-min))
116 (while (and range
117 (setq pattern (mh-next-pick-field pattern-buffer)))
118 (setq msgs (mh-seq-from-command searching-buffer
119 'search
120 (mh-list-to-string
121 (list "pick" pattern searching-buffer
122 "-list"
123 (mh-coalesce-msg-list range)))))
124 (setq range msgs)) ;restrict the pick range for next pass
125 (message "Searching...done")
126 (if new-buffer
127 (mh-scan-folder searching-buffer msgs)
128 (switch-to-buffer searching-buffer))
129 (mh-add-msgs-to-seq msgs 'search)
130 (delete-other-windows)))
131
132
133 (defun mh-seq-from-command (folder seq seq-command)
134 ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
135 ;; COMMAND is a list. The first element is a program name
136 ;; and the subsequent elements are its arguments, all strings.
137 (let ((msg)
138 (msgs ())
139 (case-fold-search t))
140 (save-excursion
141 (save-window-excursion
142 (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command))
143 ;; "pick" outputs one number per line
144 (while (setq msg (car (mh-read-msg-list)))
145 (setq msgs (cons msg msgs))
146 (forward-line 1))))
147 (set-buffer folder)
148 (setq msgs (nreverse msgs)) ;put in ascending order
149 msgs)))
150
151
152 (defun mh-next-pick-field (buffer)
153 ;; Return the next piece of a pick argument that can be extracted from the
154 ;; BUFFER.
155 ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat")
156 ;; or NIL if no pieces remain.
157 (set-buffer buffer)
158 (let ((case-fold-search t))
159 (cond ((eobp)
160 nil)
161 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
162 (let* ((component
163 (format "--%s"
164 (downcase (buffer-substring (match-beginning 1)
165 (match-end 1)))))
166 (pat (buffer-substring (match-beginning 2) (match-end 2))))
167 (forward-line 1)
168 (list component pat)))
169 ((re-search-forward "^-*$" nil t)
170 (forward-char 1)
171 (let ((body (buffer-substring (point) (point-max))))
172 (if (and (> (length body) 0) (not (equal body "\n")))
173 (list "-search" body)
174 nil)))
175 (t
176 nil))))
177
178 ;;; Build the pick-mode keymap:
179
180 (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
181 (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
182 (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
183 (define-key mh-pick-mode-map "\C-c\C-f\C-d" 'mh-to-field)
184 (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
185 (define-key mh-pick-mode-map "\C-c\C-f\C-r" 'mh-to-field)
186 (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
187 (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
188 (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
189 (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
190 (define-key mh-pick-mode-map "\C-c\C-fd" 'mh-to-field)
191 (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
192 (define-key mh-pick-mode-map "\C-c\C-fr" 'mh-to-field)
193 (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
194 (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)