[Mew-dist 06790] Re: mew-refile-view.el (Re: mew-refile.el)
Takashi P.KATOH
p-katoh at example.com
1998年 10月 25日 (日) 14:05:10 JST
しばらく手をつけるつもりはなかったのですが、なぜだか code が
倍近くなっちゃいました ;-)
From: Hideyuki SHIRAI (白井秀行) <shirai at example.com>
Subject: [Mew-dist 06772] Re: mew-refile-view.el (Re: mew-refile.el)
>> To do:
...
>> - mew-summary-refile が呼ばれたら mew-refile-view-buffer を
>> update (したいなぁ)
これ、途中まで作ったのですが、`o', `!', `mo', auto-refile し
た後に反映されるようにした時点で、マークの変化に *確実に* 追
従するのはかなり困難なことに気付いたので、結局あきらめました。
*Mew refile view* buffer で `l' を押すと update されるので、
それで我慢して下さい。
> 行き先が不安だ、というのは特に mew-summary-auto-refile をしたと
> きですので、mew-summary-auto-refile が終ったら
> *Mew refile view* buffer が勝手に(?)でてくるというのも良いですね。
パッチをあてた後で、mew-refile-view-after-auto-refile を t
にすると、auto-refile したあとに mew-refile-view が呼ばれま
す。
まとめ:
1. .emacs に
(add-hook 'mew-init-hook
'(lambda ()
(require 'mew-refile-view)
(define-key mew-summary-mode-map "l" 'mew-refile-view)))
とか書いとくと良いでしょう。
2. auto-refile したあとに mew-refile-view を呼びたければ、パッ
チ (mew-refile.view-patch) をあてて、
mew-refile-view-after-auto-refile を t にします。
この機能を使わないならば、パッチをあてる必要はありません。
3. *Mew refile view* buffer で `l', `.', `q' とかを試してみま
しょう :-)
(Menu を見る、も可)
Known Problem:
"o" mark が無くなった後で mew-refile-view-again をしても、
以前の buffer が残って、ちょっとイヤ。
なお、もはや現実逃避する暇すらなくなってしまったので (;_;)、
次に手をつけるのはしばらく後になると思います。
--
かとぺ / 加藤 貴司
-------------- next part --------------
;;; mew-refile-view.el --- View refile alist
;; Author: Takashi P.KATOH <p-katoh at example.com>
;; Created: Oct 22, 1998
;; Revised: Oct 24, 1998
;;; Code:
(defconst mew-refile-view-version "mew-refile-view.el version 0.02")
(require 'mew)
(if mew-xemacs-p (require 'easymenu))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; User customize variables
;;;
(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)
(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]
"----"
["Show again" mew-refile-view-again t]
["Goto summary" mew-refile-view-goto-summary 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 "<" 'beginning-of-buffer)
(define-key mew-refile-view-mode-map ">" 'end-of-buffer)
(define-key mew-refile-view-mode-map "l" 'mew-refile-view-again)
(define-key mew-refile-view-mode-map "h" 'mew-refile-view-goto-summary)
(define-key mew-refile-view-mode-map "." 'mew-refile-view-goto-summary)
(define-key mew-refile-view-mode-map "q" 'mew-refile-view-quit)
(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
;;;
(defconst mew-refile-view-folder-regex "^[+=]")
;; -> mew-func.el ?
(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-refile-view-make-alist nil
;; mew-summary-buffer-refile -> '(("+foo" "1" "2") ("+bar" "4" "3"))
(let ((alist mew-summary-buffer-refile) 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
(if (null mew-summary-buffer-refile)
(message "No refile marks")
(save-restriction
(widen)
(let* ((folder (buffer-name))
(bufname (format "*Mew refile view* (%s)" folder))
(alist (mew-refile-view-make-alist))
view summary num numlist)
(setq view (pop-to-buffer bufname))
(setq buffer-read-only nil)
(erase-buffer)
;; xxx sort alist?
(while alist
(set-buffer view)
(insert (concat (car (car alist)) "\n"))
(setq numlist (sort (cdr (car alist)) 'string<))
(while numlist
(setq num (car numlist)
numlist (cdr numlist))
;;
(set-buffer (get-buffer folder))
(mew-summary-jump-message 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)))
(message "No Summary mode for %s" original-folder)
(mew-pop-to-buffer original-folder)
(if num (mew-summary-jump-message num)))))
(defun mew-refile-view-again ()
(interactive)
(if (not (and original-folder (get-buffer original-folder)))
(message "No Summary mode for %s" original-folder)
(set-buffer original-folder)
(mew-refile-view)))
(defun mew-refile-view-quit ()
"Exit from mew-refile-view-mode."
(interactive)
(delete-window)
;; and/or do `kill-buffer'?
;; (kill-buffer (current-buffer))
)
(defun mew-refile-view-mode (&optional folder)
"Major mode for display refile alist.
The keys that are defined for this mode are:
SPC Scroll up this message.
DEL Back-scroll this message.
h Get back to Summary mode.
l Reshow.
q Quit.
< Go to top.
> Go to bottom.
"
(interactive)
(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 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.el,orig Sun Oct 25 13:30:24 1998
+++ mew-refile.el Sun Oct 25 13:37:46 1998
@@ -661,7 +661,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 メーリングリストの案内