1 ;;; mew-refile-view.el --- View refile alist
3 ;; Author: Takashi P.KATOH <p-katoh@shiratori.riec.tohoku.ac.jp>
4 ;; Created: Oct 22, 1998
5 ;; Revised: Oct 25, 1999
9 (defconst mew-refile-view-version "mew-refile-view.el version 0.06")
12 (if mew-xemacs-p (require 'easymenu))
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16 ;;; User customize variables
20 (defvar mew-refile-view-exec-confirm t
21 "*Non nil means `mew-refile-view-exec' prompts the user for
22 confirmation before refiling.")
24 (defvar mew-refile-view-show-trash nil
25 "*Non nil means trash folder (i.e. delete-marked messages)
28 (defvar mew-refile-view-mode-hook nil)
29 (defvar mew-refile-view-mode-map nil)
31 (defvar mew-refile-view-mode-menu-spec
33 ["Next page" scroll-up t]
34 ["Prev page" scroll-down t]
35 ["Top" beginning-of-buffer t]
36 ["Bottom" end-of-buffer t]
37 ["Prev message" mew-refile-view-prev-msg t]
38 ["Next message" mew-refile-view-next-msg t]
40 ["Show again" mew-refile-view-again t]
41 ["Goto summary" mew-refile-view-goto-summary t]
42 ["Unmark" mew-refile-view-unmark t]
43 ["Refile" mew-refile-view-refile t]
44 ["Delete" mew-refile-view-delete t]
45 ["Quit" mew-refile-view-quit t]
48 (if mew-refile-view-mode-map
50 (setq mew-refile-view-mode-map (make-sparse-keymap))
51 (define-key mew-refile-view-mode-map " " 'scroll-up)
52 (define-key mew-refile-view-mode-map "\177" 'scroll-down)
53 (define-key mew-refile-view-mode-map "." 'mew-refile-view-goto-summary)
54 (define-key mew-refile-view-mode-map "h" 'mew-refile-view-goto-summary)
55 (define-key mew-refile-view-mode-map "n" 'mew-refile-view-next-msg)
56 (define-key mew-refile-view-mode-map "p" 'mew-refile-view-prev-msg)
57 (define-key mew-refile-view-mode-map "l" 'mew-refile-view-again)
58 (define-key mew-refile-view-mode-map "u" 'mew-refile-view-unmark)
59 (define-key mew-refile-view-mode-map "o" 'mew-refile-view-refile)
60 (define-key mew-refile-view-mode-map "d" 'mew-refile-view-delete)
61 (define-key mew-refile-view-mode-map "x" 'mew-refile-view-exec)
62 (define-key mew-refile-view-mode-map "q" 'mew-refile-view-quit)
63 (define-key mew-refile-view-mode-map "<" 'beginning-of-buffer)
64 (define-key mew-refile-view-mode-map ">" 'end-of-buffer)
67 mew-refile-view-mode-menu
68 mew-refile-view-mode-map
69 "Menu used in Refile view mode."
70 mew-refile-view-mode-menu-spec)
74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80 (defconst mew-refile-view-folder-regex "^[+=]")
82 (defun mew-assoc-add (key alist mem)
83 (append (list (append (or (assoc key alist) (list key)) (list mem)))
84 (delete (assoc key alist) alist)))
86 (defun mew-car-string< (a1 a2)
87 (let ((k1 (car a1)) (k2 (car a2)))
90 (defun mew-refile-view-make-alist (msg)
91 ;; mew-summary-buffer-refile -> '(("+foo" "1" "2") ("+bar" "4" "3"))
93 (mapcar '(lambda (msg) (assoc msg mew-summary-buffer-refile)) msg))
96 (let ((flist (cdr (car alist))))
98 (setq result (mew-assoc-add (car flist) result (car (car alist)))
100 (setq alist (cdr alist)))
103 (defun mew-refile-view (&optional prefix)
106 (let* ((folder (buffer-name))
107 (bufname (format "*Mew refile view* (%s)" folder))
108 (mew-refile-view-show-trash (or prefix mew-refile-view-show-trash))
109 (refile (mew-summary-mark-collect mew-mark-refile
110 (point-min) (point-max)))
112 (if mew-refile-view-show-trash
113 (mew-summary-mark-collect mew-mark-delete
114 (point-min) (point-max))
116 (if (not (or refile trash))
118 (message "No refile marks")
119 (if (buffer-live-p (get-buffer bufname))
122 (setq buffer-read-only nil)
124 (insert "No refile marks\n")
125 (setq buffer-read-only t))))
126 (let ((alist (mew-refile-view-make-alist refile))
127 view summary num numlist)
128 (setq view (mew-pop-to-buffer bufname))
129 (setq buffer-read-only nil)
131 (mew-buffers-setup bufname)
133 (setq alist (sort alist 'mew-car-string<))
135 (setq alist (append alist (list (cons mew-trash-folder trash)))))
138 (insert (concat (car (car alist)) "\n"))
139 (setq numlist (sort (mapcar 'string-to-int (cdr (car alist))) '<))
141 (setq num (car numlist)
142 numlist (cdr numlist))
144 (set-buffer (get-buffer folder))
145 (let ((mew-summary-jump-message-then-display nil))
146 (mew-summary-jump-message (int-to-string num)))
147 (setq summary (buffer-substring
148 (point) (save-excursion (end-of-line) (point))))
152 (let ((mew-highlight-mark-folder-list (list bufname)))
156 (setq alist (cdr alist)))
157 (goto-char (point-min))
158 (mew-refile-view-mode
159 (if (string-match mew-refile-view-folder-regex folder)
163 (defun mew-refile-view-goto-summary ()
164 "Get back to Summary mode."
169 (setq num (if (looking-at mew-summary-message-regex)
171 (if (not (and original-folder (get-buffer original-folder)))
173 (message "No Summary buffer for %s" original-folder)
175 (mew-pop-to-buffer original-folder)
176 (if num (mew-summary-jump-message num))
179 (defun mew-refile-view-again ()
181 (if (not (and original-folder (get-buffer original-folder)))
182 (message "No Summary buffer for %s" original-folder)
183 (set-buffer original-folder)
186 (defun mew-refile-view-quit ()
187 "Exit from mew-refile-view-mode."
189 (delete-windows-on (current-buffer)))
191 (defun mew-refile-view-next-msg ()
192 "Move to next message in Mew refile view buffer."
194 (let ((orig (point)))
196 (if (re-search-forward mew-summary-message-regex nil t)
200 (defun mew-refile-view-prev-msg ()
201 "Move to previous message in Mew refile view buffer."
203 (let ((orig (point)))
205 (if (re-search-backward mew-summary-message-regex nil t)
209 (defun mew-refile-view-exec ()
211 (if (not (and original-folder (get-buffer original-folder)))
212 (message "No Summary buffer for %s" original-folder)
213 (if (or (not mew-refile-view-exec-confirm)
215 (y-or-n-p "Execute refiling for these messages? "))
217 (mew-pop-to-buffer original-folder)
219 (mew-refile-view)))))
221 (defun mew-refile-view-unmark ()
222 "Unmark this message."
224 (mew-refile-view-msg 'undo))
226 (defun mew-refile-view-refile ()
227 "Refile this message."
229 (mew-refile-view-msg 'refile))
231 (defun mew-refile-view-delete ()
232 "Delete this message."
234 (mew-refile-view-msg 'delete))
236 (defun mew-refile-view-msg (op)
238 (let ((orig-point (point))
239 (orig-buff (current-buffer)))
240 (if (not (looking-at mew-summary-message-regex))
241 (message "No message")
242 ;; in mew summary buffer
243 (if (mew-refile-view-goto-summary)
247 (mew-summary-refile))
249 (mew-summary-undo 1))
251 (mew-summary-delete 1)))
253 ;; we are out of mew summary buffer now
254 (mew-pop-to-buffer orig-buff)
255 (if (< orig-point (point-max))
256 (goto-char orig-point)
257 (goto-char (point-max)))
258 (beginning-of-line))))
260 (defun mew-refile-view-mode (&optional folder)
261 "Major mode for viewing refile alist.
262 The keys defined for this mode are:
264 SPC Scroll up this message.
265 DEL Back-scroll this message.
266 . Get back to Summary mode.
267 h Get back to Summary mode.
268 n Move to next message.
269 p Move to previous message.
273 d Put delete mark on this message.
274 x Process marked messages.
282 (set-buffer-menubar current-menubar)
283 (add-submenu nil mew-refile-view-mode-menu-spec)))
284 (setq major-mode 'mew-refile-view-mode)
285 (setq mode-name "Refile-View")
286 (setq mode-line-buffer-identification mew-mode-line-id)
287 (use-local-map mew-refile-view-mode-map)
288 (setq buffer-read-only t)
289 (make-local-variable 'original-folder)
290 (setq original-folder folder)
291 (run-hooks 'mew-refile-view-mode-hook))
293 (provide 'mew-refile-view)
295 ;;; Copyright Notice:
297 ;; Copyright (C) 1998, 1999 Mew developing team.
298 ;; All rights reserved.
300 ;; Redistribution and use in source and binary forms, with or without
301 ;; modification, are permitted provided that the following conditions
304 ;; 1. Redistributions of source code must retain the above copyright
305 ;; notice, this list of conditions and the following disclaimer.
306 ;; 2. Redistributions in binary form must reproduce the above copyright
307 ;; notice, this list of conditions and the following disclaimer in the
308 ;; documentation and/or other materials provided with the distribution.
309 ;; 3. Neither the name of the team nor the names of its contributors
310 ;; may be used to endorse or promote products derived from this software
311 ;; without specific prior written permission.
313 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
314 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
315 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
316 ;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
317 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
318 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
319 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
320 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
321 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
322 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
323 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
325 ;;; mew-refile-view.el ends here