[Mew-dist 09536] Re: mew-refile-view.el (Re: mew-refile.el)
Takashi P.KATOH
p-katoh at example.com
1999年 7月 4日 (日) 15:08:47 JST
かとぺ です。
mew-refile-view.el 0.04 です。
やったこと:
- +trash の表示の有無を変数 (mew-refile-view-show-trash) で制御
(default は nil)
- widen しないようにした。
(それに伴ない FUNC: mew-refile-view-make-alist の仕様変更)
細かいところでは、
- delete-window -> delete-windows-on
(白井さんの mew-refile-view-quit のパッチに相当 (たぶん))
- Applied 鄭さん's patch ([Mew-dist 09518])
- `mew-alist<' の名前変更 (-> `mew-car-string<')
こんなところです。
基本的には大体完成したつもりでいます。
今後は、見つかった bug の fix と、気が向いたら一部関数の書き
直しをするかも、といった感じでしょうか (もちろん要望があれば、
機能等を追加することはあるかもしれません)。
mew ちっくな書きかたになってないところ (例えば鄭さんに指摘し
ていただいたようなもの) もあるかもしれませんが、本人は気付い
ていませんので、そういうところがありましたら是非指摘して下さ
い。
なお、今回添付したパッチは前回のものと同等ですが、
mew-refile-view.el のコメントを変更した関係で前回のものはそ
のままはあたらないと思います。
パッチを見て手であてるのが一番早いと思います (_o_)
--
かとぺ / 加藤 貴司
-------------- next part --------------
;;; mew-refile-view.el --- View refile alist
;; Author: Takashi P.KATOH <p-katoh at example.com>
;; Created: Oct 22, 1998
;; Revised: Jul 4, 1999
;;; Code:
(defconst mew-refile-view-version "mew-refile-view.el version 0.04")
(require 'mew)
(if mew-xemacs-p (require 'easymenu))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; User customize variables
;;;
;; -> mew-vars.el ?
(defvar mew-refile-view-exec-confirm t
"*Non nil means `mew-refile-view-exec' prompts the user for
confirmation before refiling.")
(defvar mew-refile-view-show-trash nil
"*Non nil means trash folder (i.e. delete-marked messages)
will be also shown.")
(defvar mew-refile-view-mode-hook nil)
(defvar mew-refile-view-mode-map nil)
(defvar mew-refile-view-mode-menu-spec
'("Mew/RefileView"
["Next page" scroll-up t]
["Prev page" scroll-down t]
["Top" beginning-of-buffer t]
["Bottom" end-of-buffer t]
["Prev message" mew-refile-view-prev-msg t]
["Next message" mew-refile-view-next-msg t]
"----"
["Show again" mew-refile-view-again t]
["Goto summary" mew-refile-view-goto-summary t]
["Unmark" mew-refile-view-unmark t]
["Refile" mew-refile-view-refile t]
["Delete" mew-refile-view-delete t]
["Quit" mew-refile-view-quit t]
))
(if mew-refile-view-mode-map
()
(setq mew-refile-view-mode-map (make-sparse-keymap))
(define-key mew-refile-view-mode-map " " 'scroll-up)
(define-key mew-refile-view-mode-map "\177" 'scroll-down)
(define-key mew-refile-view-mode-map "." 'mew-refile-view-goto-summary)
(define-key mew-refile-view-mode-map "h" 'mew-refile-view-goto-summary)
(define-key mew-refile-view-mode-map "n" 'mew-refile-view-next-msg)
(define-key mew-refile-view-mode-map "p" 'mew-refile-view-prev-msg)
(define-key mew-refile-view-mode-map "l" 'mew-refile-view-again)
(define-key mew-refile-view-mode-map "u" 'mew-refile-view-unmark)
(define-key mew-refile-view-mode-map "o" 'mew-refile-view-refile)
(define-key mew-refile-view-mode-map "d" 'mew-refile-view-delete)
(define-key mew-refile-view-mode-map "x" 'mew-refile-view-exec)
(define-key mew-refile-view-mode-map "q" 'mew-refile-view-quit)
(define-key mew-refile-view-mode-map "<" 'beginning-of-buffer)
(define-key mew-refile-view-mode-map ">" 'end-of-buffer)
(if mew-temacs-p
(easy-menu-define
mew-refile-view-mode-menu
mew-refile-view-mode-map
"Menu used in Refile view mode."
mew-refile-view-mode-menu-spec)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Refile view mode
;;;
;; -> mew-vars ?
(defconst mew-refile-view-folder-regex "^[+=]")
(defun mew-assoc-add (key alist mem)
(append (list (append (or (assoc key alist) (list key)) (list mem)))
(delete (assoc key alist) alist)))
(defun mew-car-string< (a1 a2)
(let ((k1 (car a1)) (k2 (car a2)))
(string< k1 k2)))
(defun mew-refile-view-make-alist (msg)
;; mew-summary-buffer-refile -> '(("+foo" "1" "2") ("+bar" "4" "3"))
(let ((alist
(mapcar '(lambda (msg) (assoc msg mew-summary-buffer-refile)) msg))
result)
(while alist
(let ((flist (cdr (car alist))))
(while flist
(setq result (mew-assoc-add (car flist) result (car (car alist)))
flist (cdr flist))))
(setq alist (cdr alist)))
result))
(defun mew-refile-view ()
(interactive)
(mew-summary-only
(let* ((folder (buffer-name))
(bufname (format "*Mew refile view* (%s)" folder))
(refile (mew-summary-mark-collect mew-mark-refile
(point-min) (point-max)))
(trash
(if mew-refile-view-show-trash
(mew-summary-mark-collect mew-mark-delete
(point-min) (point-max))
nil)))
(if (not (or refile trash))
(progn
(message "No refile marks")
(if (buffer-live-p (get-buffer bufname))
(progn
(set-buffer bufname)
(setq buffer-read-only nil)
(erase-buffer)
(insert "No refile marks\n")
(setq buffer-read-only t))))
(let ((alist (mew-refile-view-make-alist refile))
view summary num numlist)
(setq view (mew-pop-to-buffer bufname))
(setq buffer-read-only nil)
(erase-buffer)
(mew-buffers-setup bufname)
;;
(setq alist (sort alist 'mew-car-string<))
(if trash
(setq alist (append alist (list (cons mew-trash-folder trash)))))
(while alist
(set-buffer view)
(insert (concat (car (car alist)) "\n"))
(setq numlist (sort (mapcar 'string-to-int (cdr (car alist))) '<))
(while numlist
(setq num (car numlist)
numlist (cdr numlist))
;;
(set-buffer (get-buffer folder))
(mew-summary-jump-message (int-to-string num))
(setq summary (buffer-substring
(point) (save-excursion (end-of-line) (point))))
;;
(set-buffer view)
(insert summary)
(let ((mew-highlight-mark-folder-list (list bufname)))
(mew-mark-unmark))
(insert "\n"))
(insert "\n")
(setq alist (cdr alist)))
(goto-char (point-min))
(mew-refile-view-mode
(if (string-match mew-refile-view-folder-regex folder)
folder nil)))
))))
(defun mew-refile-view-goto-summary ()
"Get back to Summary mode."
(interactive)
(let (num)
(save-excursion
(beginning-of-line)
(setq num (if (looking-at mew-summary-message-regex)
(mew-match 1))))
(if (not (and original-folder (get-buffer original-folder)))
(progn
(message "No Summary buffer for %s" original-folder)
nil)
(mew-pop-to-buffer original-folder)
(if num (mew-summary-jump-message num))
t)))
(defun mew-refile-view-again ()
(interactive)
(if (not (and original-folder (get-buffer original-folder)))
(message "No Summary buffer for %s" original-folder)
(set-buffer original-folder)
(mew-refile-view)))
(defun mew-refile-view-quit ()
"Exit from mew-refile-view-mode."
(interactive)
(delete-windows-on (current-buffer)))
(defun mew-refile-view-next-msg ()
"Move to next message in Mew refile view buffer."
(interactive)
(let ((orig (point)))
(end-of-line)
(if (re-search-forward mew-summary-message-regex nil t)
(beginning-of-line)
(goto-char orig))))
(defun mew-refile-view-prev-msg ()
"Move to previous message in Mew refile view buffer."
(interactive)
(let ((orig (point)))
(beginning-of-line)
(if (re-search-backward mew-summary-message-regex nil t)
(beginning-of-line)
(goto-char orig))))
(defun mew-refile-view-exec ()
(interactive)
(if (not (and original-folder (get-buffer original-folder)))
(message "No Summary buffer for %s" original-folder)
(if (or (not mew-refile-view-exec-confirm)
;; or yes-or-no-p?
(y-or-n-p "Execute refiling for these messages? "))
(progn
(mew-pop-to-buffer original-folder)
(mew-summary-exec)
(mew-refile-view)))))
(defun mew-refile-view-unmark ()
"Unmark this message."
(interactive)
(mew-refile-view-msg 'undo))
(defun mew-refile-view-refile ()
"Refile this message."
(interactive)
(mew-refile-view-msg 'refile))
(defun mew-refile-view-delete ()
"Delete this message."
(interactive)
(mew-refile-view-msg 'delete))
(defun mew-refile-view-msg (op)
(beginning-of-line)
(let ((orig-point (point))
(orig-buff (current-buffer)))
(if (not (looking-at mew-summary-message-regex))
(message "No message")
;; in mew summary buffer
(if (mew-refile-view-goto-summary)
(mew-summary-only
(cond
((eq op 'refile)
(mew-summary-refile))
((eq op 'undo)
(mew-summary-undo 1))
((eq op 'delete)
(mew-summary-delete 1)))
(mew-refile-view)))
;; we are out of mew summary buffer now
(mew-pop-to-buffer orig-buff)
(if (< orig-point (point-max))
(goto-char orig-point)
(goto-char (point-max)))
(beginning-of-line))))
(defun mew-refile-view-mode (&optional folder)
"Major mode for viewing refile alist.
The keys defined for this mode are:
SPC Scroll up this message.
DEL Back-scroll this message.
. Get back to Summary mode.
h Get back to Summary mode.
n Move to next message.
p Move to previous message.
l Reshow .
u Unmark.
o Refile again.
d Put delete mark on this message.
x Process marked messages.
q Quit.
< Go to top.
> Go to bottom.
"
(interactive)
(if mew-xemacs-p
(progn
(set-buffer-menubar current-menubar)
(add-submenu nil mew-refile-view-mode-menu-spec)))
(setq major-mode 'mew-refile-view-mode)
(setq mode-name "Refile-View")
(setq mode-line-buffer-identification mew-mode-line-id)
(use-local-map mew-refile-view-mode-map)
(setq buffer-read-only t)
(make-local-variable 'original-folder)
(setq original-folder folder)
(run-hooks 'mew-refile-view-mode-hook))
(provide 'mew-refile-view)
;;; Copyright Notice:
;; Copyright (C) 1998, 1999 Mew developing team.
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; 3. Neither the name of the team nor the names of its contributors
;; may be used to endorse or promote products derived from this software
;; without specific prior written permission.
;;
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;; mew-refile-view.el ends here
-------------- next part --------------
--- mew-refile-view.el,0.04 Sun Jul 4 14:44:59 1999
+++ mew-refile-view.el Sun Jul 4 14:45:08 1999
@@ -25,6 +25,10 @@
"*Non nil means trash folder (i.e. delete-marked messages)
will be also shown.")
+(defvar mew-refile-view-after-auto-refile nil
+ "*Non nil means pop up mew-refile-view buffer after
+mew-summary-auto-refile.")
+
(defvar mew-refile-view-mode-hook nil)
(defvar mew-refile-view-mode-map nil)
--- mew-refile.el,orig Tue Jun 29 17:10:44 1999
+++ mew-refile.el Tue Jun 29 17:13:56 1999
@@ -629,7 +629,9 @@
(message "Auto refiling ... %s%%"
(/ (* 100 line) lines)))
(setq line (1+ line)))
- (message "Auto refiling ... done"))))))
+ (message "Auto refiling ... done"))
+ (if mew-refile-view-after-auto-refile
+ (mew-refile-view))))))
;;
;; "mx" extension
Mew-dist メーリングリストの案内