cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-refile-view.el

   1 ;;; mew-refile-view.el --- View refile alist
   2
   3 ;; Author:  Takashi P.KATOH <p-katoh@shiratori.riec.tohoku.ac.jp>
   4 ;; Created: Oct 22, 1998
   5 ;; Revised: Oct 25, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-refile-view-version "mew-refile-view.el version 0.06")
  10
  11 (require 'mew)
  12 (if mew-xemacs-p (require 'easymenu))
  13
  14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15 ;;;
  16 ;;; User customize variables
  17 ;;;
  18
  19 ;; -> mew-vars.el ?
  20 (defvar mew-refile-view-exec-confirm t
  21   "*Non nil means `mew-refile-view-exec' prompts the user for
  22 confirmation before refiling.")
  23
  24 (defvar mew-refile-view-show-trash nil
  25   "*Non nil means trash folder (i.e. delete-marked messages)
  26 will be also shown.")
  27
  28 (defvar mew-refile-view-mode-hook nil)
  29 (defvar mew-refile-view-mode-map nil)
  30
  31 (defvar mew-refile-view-mode-menu-spec
  32   '("Mew/RefileView"
  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]
  39     "----"
  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]
  46     ))
  47
  48 (if mew-refile-view-mode-map
  49     ()
  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)
  65   (if mew-temacs-p
  66       (easy-menu-define
  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)
  71     )
  72   )
  73
  74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75 ;;;
  76 ;;; Refile view mode
  77 ;;;
  78
  79 ;; -> mew-vars ?
  80 (defconst mew-refile-view-folder-regex "^[+=]")
  81
  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)))
  85
  86 (defun mew-car-string< (a1 a2)
  87   (let ((k1 (car a1)) (k2 (car a2)))
  88     (string< k1 k2)))
  89
  90 (defun mew-refile-view-make-alist (msg)
  91   ;; mew-summary-buffer-refile -> '(("+foo" "1" "2") ("+bar" "4" "3"))
  92   (let ((alist
  93          (mapcar '(lambda (msg) (assoc msg mew-summary-buffer-refile)) msg))
  94         result)
  95     (while alist
  96       (let ((flist (cdr (car alist))))
  97         (while flist
  98           (setq result (mew-assoc-add (car flist) result (car (car alist)))
  99                 flist (cdr flist))))
 100       (setq alist (cdr alist)))
 101     result))
 102
 103 (defun mew-refile-view (&optional prefix)
 104   (interactive "P")
 105   (mew-summary-only
 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)))
 111           (trash
 112            (if mew-refile-view-show-trash
 113                (mew-summary-mark-collect mew-mark-delete
 114                                          (point-min) (point-max))
 115              nil)))
 116      (if (not (or refile trash))
 117          (progn
 118            (message "No refile marks")
 119            (if (buffer-live-p (get-buffer bufname))
 120                (progn
 121                  (set-buffer bufname)
 122                  (setq buffer-read-only nil)
 123                  (erase-buffer)
 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)
 130          (erase-buffer)
 131          (mew-buffers-setup bufname)
 132          ;;
 133          (setq alist (sort alist 'mew-car-string<))
 134          (if trash
 135              (setq alist (append alist (list (cons mew-trash-folder trash)))))
 136          (while alist
 137            (set-buffer view)
 138            (insert (concat (car (car alist)) "\n"))
 139            (setq numlist (sort (mapcar 'string-to-int (cdr (car alist))) '<))
 140            (while numlist
 141              (setq num (car numlist)
 142                    numlist (cdr numlist))
 143              ;;
 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))))
 149              ;;
 150              (set-buffer view)
 151              (insert summary)
 152              (let ((mew-highlight-mark-folder-list (list bufname)))
 153                (mew-mark-unmark))
 154              (insert "\n"))
 155            (insert "\n")
 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)
 160               folder nil)))
 161        ))))
 162
 163 (defun mew-refile-view-goto-summary ()
 164   "Get back to Summary mode."
 165   (interactive)
 166   (let (num)
 167     (save-excursion
 168       (beginning-of-line)
 169       (setq num (if (looking-at mew-summary-message-regex)
 170                     (mew-match 1))))
 171     (if (not (and original-folder (get-buffer original-folder)))
 172         (progn
 173           (message "No Summary buffer for %s" original-folder)
 174           nil)
 175       (mew-pop-to-buffer original-folder)
 176       (if num (mew-summary-jump-message num))
 177       t)))
 178
 179 (defun mew-refile-view-again ()
 180   (interactive)
 181   (if (not (and original-folder (get-buffer original-folder)))
 182       (message "No Summary buffer for %s" original-folder)
 183     (set-buffer original-folder)
 184     (mew-refile-view)))
 185
 186 (defun mew-refile-view-quit ()
 187   "Exit from mew-refile-view-mode."
 188   (interactive)
 189   (delete-windows-on (current-buffer)))
 190
 191 (defun mew-refile-view-next-msg ()
 192   "Move to next message in Mew refile view buffer."
 193   (interactive)
 194   (let ((orig (point)))
 195     (end-of-line)
 196     (if (re-search-forward mew-summary-message-regex nil t)
 197         (beginning-of-line)
 198       (goto-char orig))))
 199
 200 (defun mew-refile-view-prev-msg ()
 201   "Move to previous message in Mew refile view buffer."
 202   (interactive)
 203   (let ((orig (point)))
 204     (beginning-of-line)
 205     (if (re-search-backward mew-summary-message-regex nil t)
 206         (beginning-of-line)
 207       (goto-char orig))))
 208
 209 (defun mew-refile-view-exec ()
 210   (interactive)
 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)
 214             ;; or yes-or-no-p?
 215             (y-or-n-p "Execute refiling for these messages? "))
 216         (progn
 217           (mew-pop-to-buffer original-folder)
 218           (mew-summary-exec)
 219           (mew-refile-view)))))
 220
 221 (defun mew-refile-view-unmark ()
 222   "Unmark this message."
 223   (interactive)
 224   (mew-refile-view-msg 'undo))
 225
 226 (defun mew-refile-view-refile ()
 227   "Refile this message."
 228   (interactive)
 229   (mew-refile-view-msg 'refile))
 230
 231 (defun mew-refile-view-delete ()
 232   "Delete this message."
 233   (interactive)
 234   (mew-refile-view-msg 'delete))
 235
 236 (defun mew-refile-view-msg (op)
 237   (beginning-of-line)
 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)
 244           (mew-summary-only
 245            (cond
 246             ((eq op 'refile)
 247              (mew-summary-refile))
 248             ((eq op 'undo)
 249              (mew-summary-undo 1))
 250             ((eq op 'delete)
 251              (mew-summary-delete 1)))
 252            (mew-refile-view)))
 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))))
 259
 260 (defun mew-refile-view-mode (&optional folder)
 261   "Major mode for viewing refile alist.
 262 The keys defined for this mode are:
 263
 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.
 270 l       Reshow .
 271 u       Unmark.
 272 o       Refile again.
 273 d       Put delete mark on this message.
 274 x       Process marked messages.
 275 q       Quit.
 276 <       Go to top.
 277 >       Go to bottom.
 278 "
 279   (interactive)
 280   (if mew-xemacs-p
 281       (progn
 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))
 292
 293 (provide 'mew-refile-view)
 294
 295 ;;; Copyright Notice:
 296
 297 ;; Copyright (C) 1998, 1999 Mew developing team.
 298 ;; All rights reserved.
 299
 300 ;; Redistribution and use in source and binary forms, with or without
 301 ;; modification, are permitted provided that the following conditions
 302 ;; are met:
 303 ;;
 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.
 312 ;;
 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.
 324
 325 ;;; mew-refile-view.el ends here