[Mew-dist 1359] pack and sort in bg ... revised
UMEMURA Akihiro
akihiro at example.com
1997年 7月 29日 (火) 20:59:36 JST
先日送った pack と sort を background で行うやつ[mew-dist 1312]
ですが、仕様がいいかげんだったりバグがあったり新しいバージョンに
対応してなかったりしたので、いくらか手直ししました。
再送いたします。
こんどはいろいろなファイルをいじったので、
directory の diff をとりました。
im-48 と mew-1.87 に対応するものです。
以下、若干の説明です。
(1) im-48 の方は、いいかげんな --diff に代わる仕様として、
--verbose をつけると --noharm と同様の出力を出すようにしました。
(2) mew-1.87 の方は、差分の大部分を mew-bg.el というファイ
ルに収めました。
(3) mew-1.87 の Makefile のちょっとした間違いと 00diff の
バグ(？)も直してあります。
mew-sort の region 指定は、これでやっと報われるようになると
思います。
*****************************************************************
ＮＴＴ基礎研究所情報科学研究部 0462-40-3663 (厚木市森の里若宮)
梅村晃広 akihiro at example.com
-------------- next part --------------
diff -rcN im-48.orig/IM.in/File.pm.in im-48/IM.in/File.pm.in
*** im-48.orig/IM.in/File.pm.in Wed Jul 16 11:43:42 1997
--- im-48/IM.in/File.pm.in Tue Jul 29 16:17:21 1997
***************
*** 41,50 ****
my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm);
! if ($main::opt_noharm) {
print "mv $p1 $p2\n";
$ret = 1;
! } else {
if (!($ret = rename($p1, $p2))){
$ret = copy($p1, $p2) && unlink($p1);
}
--- 41,51 ----
my ($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm);
! if ($main::opt_verbose) {
print "mv $p1 $p2\n";
$ret = 1;
! }
! if (! $main::opt_noharm) {
if (!($ret = rename($p1, $p2))){
$ret = copy($p1, $p2) && unlink($p1);
}
diff -rcN im-48.orig/immv.in im-48/immv.in
*** im-48.orig/immv.in Mon Jul 14 13:47:40 1997
--- im-48/immv.in Tue Jul 29 16:26:27 1997
***************
*** 45,50 ****
--- 45,51 ----
'noharm;b;;' => "Display the commands but do not actually execute them.",
'src;f;;' => "Set source folder.",
'dst;F@;;' => "Set destination folders.",
+ 'verbose;b;;' => "Display the commands.",
'help;b;;' => "Show this message.",
);
***************
*** 87,92 ****
--- 88,95 ----
chk_msg_existance($src, @{$msgs}); # not return in case false.
@msg_paths = impath($src, @{$msgs});
+
+ $opt_verbose= $opt_verbose | $opt_hoharm;
foreach (@msg_paths){
refile_one($_, $dsts);
diff -rcN im-48.orig/impack.in im-48/impack.in
*** im-48.orig/impack.in Mon Jul 14 13:47:41 1997
--- im-48/impack.in Tue Jul 29 15:55:26 1997
***************
*** 43,48 ****
--- 43,49 ----
@OptConfig =(
'src;F;;' => "Set source folder.",
'noharm;b;;' => "No packing. Show what will happen.",
+ 'verbose;b;;'=> "Show what is happening.",
'help;b;;' => "Show this message.",
);
***************
*** 77,84 ****
@paths = impath($folder, 'all');
! print "packing messages in $opt_src ... " unless $opt_noharm;
! flush(STDOUT) unless $opt_noharm;
foreach (@paths) {
$dst = $_;
--- 78,86 ----
@paths = impath($folder, 'all');
! $opt_verbose = $opt_verbose |$opt_noharm;
! print "packing messages in $opt_src ... " unless $opt_verbose;
! flush(STDOUT) unless $opt_verbose;
foreach (@paths) {
$dst = $_;
***************
*** 88,94 ****
}
}
! print "done\n" unless $opt_noharm;
touch_folder($folder) unless $opt_noharm;
}
--- 90,96 ----
}
}
! print "done\n" unless $opt_verbose;
touch_folder($folder) unless $opt_noharm;
}
diff -rcN im-48.orig/imsort.in im-48/imsort.in
*** im-48.orig/imsort.in Mon Jul 14 13:47:41 1997
--- im-48/imsort.in Tue Jul 29 16:26:42 1997
***************
*** 44,49 ****
--- 44,50 ----
'mode;s;date;' => "Set sort mode to date, num or text.",
'noharm;b;;' => "Display the commands but do not actually execute them.",
'src;F;;' => "Set source folder.",
+ 'verbose;b;;' => "Display the commands.",
'help;b;;' => "Show this message.",
);
***************
*** 122,127 ****
--- 123,130 ----
}
$tmp = $#msg_paths + 1;
+
+ $opt_verbose=$opt_verbose|$opt_noharm;
for $i (0 .. $#msg_paths) {
next if $i == $sorted_index[$i] or $sorted_index[$i] < 0;
-------------- next part --------------
diff -rcN mew-1.87.orig/00diff mew-1.87/00diff
*** mew-1.87.orig/00diff Tue Jul 1 12:54:35 1997
--- mew-1.87/00diff Tue Jul 29 11:42:05 1997
***************
*** 61,66 ****
<Things to do>
- * Pick macro again.
-
* Header encoding/decoding. Perfect support of RFC2047.
--- 61,64 ----
diff -rcN mew-1.87.orig/Makefile mew-1.87/Makefile
*** mew-1.87.orig/Makefile Sat Jul 26 21:44:51 1997
--- mew-1.87/Makefile Tue Jul 29 20:02:14 1997
***************
*** 41,47 ****
mew-scan.elc mew-summary.elc mew-syntax.elc \
mew-ext.elc mew-virtual.elc mew-mark.elc \
mew-mime.elc mew-cache.elc mew-func.elc \
! mew-minibuf.elc mew-complete.elc mew-sort.elc
SRCS = mew.el \
mew-attach.el mew-env.el mew-decode.el \
mew-demo.el mew-draft.el mew-encode.el \
--- 41,47 ----
mew-scan.elc mew-summary.elc mew-syntax.elc \
mew-ext.elc mew-virtual.elc mew-mark.elc \
mew-mime.elc mew-cache.elc mew-func.elc \
! mew-minibuf.elc mew-complete.elc mew-sort.elc mew-bg.elc
SRCS = mew.el \
mew-attach.el mew-env.el mew-decode.el \
mew-demo.el mew-draft.el mew-encode.el \
***************
*** 50,56 ****
mew-scan.el mew-summary.el mew-syntax.el \
mew-ext.el mew-virtual.el mew-mark.el \
mew-mime.el mew-cache.el mew-func.el \
! mew-minibuf.el mew-complete.el mew-sort.elc \
mew-mule0.el mew-mule2.el mew-mule3.el mew-xemacs.el
LDPATH = lp.el
--- 50,56 ----
mew-scan.el mew-summary.el mew-syntax.el \
mew-ext.el mew-virtual.el mew-mark.el \
mew-mime.el mew-cache.el mew-func.el \
! mew-minibuf.el mew-complete.el mew-sort.el mew-bg.el \
mew-mule0.el mew-mule2.el mew-mule3.el mew-xemacs.el
LDPATH = lp.el
diff -rcN mew-1.87.orig/mew-bg.el mew-1.87/mew-bg.el
*** mew-1.87.orig/mew-bg.el Thu Jan 1 09:00:00 1970
--- mew-1.87/mew-bg.el Tue Jul 29 20:35:24 1997
***************
*** 0 ****
--- 1,118 ----
+ ;;; mew-bg.el: Run im-processes in background
+ ;;;
+ (require 'mew)
+
+ (defun mew-bg-modify-summary (prog pname mode folder read &rest args)
+ ;; PROG is the string that specifies the path of program of
+ ;; background process.
+ ;; PNAME is the string that is used to display the name of running
+ ;; process.
+ ;; MODE is a symbol.
+ ;; FOLDER is a string.
+ ;; READ is a coding-system.
+ ;; ARGS is the list of strings that are passed to PROG. PORG get them
+ ;; as arguments in addition to "--src=FOLDER" and "--verbose".
+ (save-excursion
+ (set-buffer (get-buffer-create folder))
+ (buffer-disable-undo (current-buffer))
+ (if (not (equal major-mode mode)) (funcall mode))
+ (mew-window-configure (current-buffer) 'summary)
+ (mew-current-set 'message nil)
+ (mew-current-set 'part nil)
+ (mew-current-set 'cache nil)
+ (setq mew-summary-buffer-direction 'down)
+ (mew-decode-syntax-delete)
+ (if (not (mew-summary-exclusive-p))
+ ()
+ (condition-case nil
+ (let ((process-connection-type mew-connection-type1))
+ (message "%s in background ..." pname)
+ (setq mew-summary-buffer-start-point (point))
+ (setq mew-summary-buffer-string "") ; Sorry, I use this
+ ; variable to keep
+ ; non-string value.
+ (setq mew-summary-buffer-process
+ (apply (function start-process)
+ pname;; name
+ (current-buffer)
+ prog;; program
+ (cons (concat "--src=" folder)
+ (cons "--verbose" args))
+ ))
+ (mew-set-process-cs mew-summary-buffer-process read mew-cs-noconv)
+ (set-process-filter mew-summary-buffer-process
+ 'mew-bg-modify-summary-filter)
+ (set-process-sentinel mew-summary-buffer-process
+ 'mew-bg-modify-summary-sentinel)
+ (process-kill-without-query mew-summary-buffer-process)
+ )
+ (quit
+ (set-process-sentinel mew-summary-buffer-process nil)
+ (setq mew-summary-buffer-start-point nil)
+ (setq mew-summary-buffer-process nil)
+ (setq mew-summary-buffer-string nil)
+ ))
+ )))
+
+ (defun mew-bg-modify-summary-filter (process string)
+ (save-excursion
+ (set-buffer (process-buffer process)) ;; just in case
+ (if (stringp mew-summary-buffer-string)
+ (progn
+ (setq mew-summary-buffer-string
+ (concat mew-summary-buffer-string string)) ;; nil can concat
+ (if (string-match "^mv \\([^ ]*\\) \\([^ ]*\\)\n"
+ mew-summary-buffer-string)
+ (let* ((pre (file-name-nondirectory
+ (mew-match 1 mew-summary-buffer-string)))
+ (now (file-name-nondirectory
+ (mew-match 2 mew-summary-buffer-string)))
+ (pre-num (string-to-int pre))
+ (now-num (string-to-int now)))
+ (setq mew-summary-buffer-string (min pre-num now-num))
+ ))))))
+
+ (defun mew-bg-modify-summary-sentinel (process event)
+ (save-excursion
+ (set-buffer (process-buffer process)) ;; just in case
+ ;; xxx if killed, we can't clear sentinel
+ ;;(set-process-sentinel mew-summary-buffer-process nil)
+ (setq mew-summary-buffer-start-point nil)
+ (setq mew-summary-buffer-process nil)
+ ;;
+ (let* ((pname (process-name process))
+ (folder (buffer-name))
+ (msg (format "%s in background ... done" pname)))
+ (if (not (string= event "finished\n"))
+ (message "Error occured during %s" pname)
+ (if (numberp mew-summary-buffer-string)
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ ;; (keep-lines (concat mew-summary-message-regex))
+ (while (< (string-to-int (mew-summary-message-number))
+ mew-summary-buffer-string)
+ (forward-line 1))
+ (beginning-of-line)
+ (delete-region (point) (point-max))
+ ;; ;; save cache only when success
+ ;; (if mew-summary-cache-use (mew-summary-folder-cache-save))
+ (if msg (message msg))
+ ;; summary buffer
+ (set-buffer-modified-p nil)
+ (setq mew-summary-buffer-string nil)
+ (mew-summary-scan-body mew-prog-imls
+ 'mew-summary-mode
+ folder
+ mew-cs-scan
+ (mew-input-range
+ folder
+ (format "Range of %s "
+ folder
+ ))
+ ))
+ (message "Folder %s is not changed." folder)
+ (setq mew-summary-buffer-string nil)
+ )))))
+
+ ;;;
+ (provide 'mew-bg)
diff -rcN mew-1.87.orig/mew-minibuf.el mew-1.87/mew-minibuf.el
*** mew-1.87.orig/mew-minibuf.el Sat Jul 26 18:25:38 1997
--- mew-1.87/mew-minibuf.el Tue Jul 29 17:11:26 1997
***************
*** 90,96 ****
(mew-header-syntax folders) ?,))
))
! (defun mew-input-range (folder)
"Return (range erase-update)."
(mew-decode-syntax-delete)
;; for the case when parts are expanded in the bottom of the folder
--- 90,96 ----
(mew-header-syntax folders) ?,))
))
! (defun mew-input-range (folder &optional prompt)
"Return (range erase-update)."
(mew-decode-syntax-delete)
;; for the case when parts are expanded in the bottom of the folder
***************
*** 98,104 ****
(default (or (cdr pair) "update")) ;; just in case
(range ""))
(if mew-ask-range
! (setq range (read-string (format "Range (%s): " default) "")))
(if (string= range "")
(setq range default))
(if (not (string-match "^[0-9a-zA-Z]" range))
--- 98,108 ----
(default (or (cdr pair) "update")) ;; just in case
(range ""))
(if mew-ask-range
! (setq range (read-string
! (concat
! (if prompt prompt "Range ")
! (format "(%s): " default))
! "")))
(if (string= range "")
(setq range default))
(if (not (string-match "^[0-9a-zA-Z]" range))
diff -rcN mew-1.87.orig/mew-pick.el mew-1.87/mew-pick.el
*** mew-1.87.orig/mew-pick.el Mon Jul 28 11:52:56 1997
--- mew-1.87/mew-pick.el Tue Jul 29 19:33:32 1997
***************
*** 92,100 ****
(define-key map "\t" 'mew-pick-complete)
(setq mew-pick-minibuffer-map map)))
! (defun mew-read-pick-pattern ()
(mew-pick-macro-expand-string
! (read-from-minibuffer "pick pattern: " nil mew-pick-minibuffer-map)))
(defun mew-pick-complete ()
(interactive)
--- 92,101 ----
(define-key map "\t" 'mew-pick-complete)
(setq mew-pick-minibuffer-map map)))
! (defun mew-read-pick-pattern (&optional prompt)
(mew-pick-macro-expand-string
! (read-from-minibuffer (or prompt "pick pattern: ")
! nil mew-pick-minibuffer-map)))
(defun mew-pick-complete ()
(interactive)
***************
*** 126,132 ****
(defun mew-pick-define-macro (str1 str2)
(interactive (list
(read-string "pick pattern: ")
! (read-string "macro body: ")))
;; macro-pattern is a string including no #, or
;; a string in a form FIELD=#1 #2 #3...#n.
;; #1 can be replaced by #.
--- 127,133 ----
(defun mew-pick-define-macro (str1 str2)
(interactive (list
(read-string "pick pattern: ")
! (mew-read-pick-pattern "macro body: ")))
;; macro-pattern is a string including no #, or
;; a string in a form FIELD=#1 #2 #3...#n.
;; #1 can be replaced by #.
diff -rcN mew-1.87.orig/mew-sort.el mew-1.87/mew-sort.el
*** mew-1.87.orig/mew-sort.el Mon Jul 28 12:21:33 1997
--- mew-1.87/mew-sort.el Tue Jul 29 19:49:44 1997
***************
*** 22,27 ****
--- 22,64 ----
(defvar mew-summary-sort-last-field "date")
+ ;;(defun mew-summary-sort-subr (msgs &optional method)
+ ;; (let* ((folder (buffer-name))
+ ;; (msgs (if (listp msgs) msgs (list msgs)))
+ ;; (completion-ignore-case t)
+ ;; (field
+ ;; (completing-read
+ ;; (concat "Sort " method (if method " ") "by?"
+ ;; (if mew-summary-sort-last-field
+ ;; (concat " (default " mew-summary-sort-last-field "): ")
+ ;; ": ")) mew-summary-sort-fields)))
+ ;; (setq field
+ ;; (downcase
+ ;; (if (string-equal field "") mew-summary-sort-last-field field))
+ ;; mew-summary-sort-last-field field)
+ ;; (if (not (mew-summary-exclusive-p))
+ ;; (message "Try later")
+ ;; (mew-mark-clean-up)
+ ;; (setq mew-summary-buffer-process t)
+ ;; (message "Sorting %s by %s ... " folder field)
+ ;; (apply 'call-process mew-prog-imsort nil nil nil
+ ;; (append
+ ;; (list (concat "--src=" folder)
+ ;; (concat "--field=" field)
+ ;; (if (cdr (assoc field mew-summary-sort-fields))
+ ;; "--mode=date" "--mode=text"))
+ ;; msgs))
+ ;; (message "Sorting %s by %s ... done" folder field)
+ ;; (setq mew-summary-buffer-process nil)
+ ;; (let ((buffer-read-only nil)) (erase-buffer));; for update
+ ;; (mew-summary-scan-body mew-prog-imls
+ ;; 'mew-summary-mode
+ ;; folder
+ ;; mew-cs-scan
+ ;; (mew-input-range folder))
+ ;; )
+ ;; ))
+
(defun mew-summary-sort-subr (msgs &optional method)
(let* ((folder (buffer-name))
(msgs (if (listp msgs) msgs (list msgs)))
***************
*** 36,63 ****
(downcase
(if (string-equal field "") mew-summary-sort-last-field field))
mew-summary-sort-last-field field)
! (if (not (mew-summary-exclusive-p))
! (message "Try later")
! (mew-mark-clean-up)
! (setq mew-summary-buffer-process t)
! (message "Sorting %s by %s ... " folder field)
! (apply 'call-process mew-prog-imsort nil nil nil
! (append
! (list (concat "--src=" folder)
! (concat "--field=" field)
! (if (cdr (assoc field mew-summary-sort-fields))
! "--mode=date" "--mode=text"))
! msgs))
! (message "Sorting %s by %s ... done" folder field)
! (setq mew-summary-buffer-process nil)
! (let ((buffer-read-only nil)) (erase-buffer));; for update
! (mew-summary-scan-body mew-prog-imls
! 'mew-summary-mode
! folder
! mew-cs-scan
! (mew-input-range folder))
! )
! ))
(defun mew-summary-sort (&optional arg)
(interactive "P")
--- 73,88 ----
(downcase
(if (string-equal field "") mew-summary-sort-last-field field))
mew-summary-sort-last-field field)
! (apply 'mew-bg-modify-summary
! mew-prog-imsort
! (format "Sorting %s by %s" folder field)
! 'mew-summary-mode
! folder
! mew-cs-scan
! (concat "--field=" field)
! (if (cdr (assoc field mew-summary-sort-fields))
! "--mode=date" "--mode=text")
! msgs)))
(defun mew-summary-sort (&optional arg)
(interactive "P")
diff -rcN mew-1.87.orig/mew-summary.el mew-1.87/mew-summary.el
*** mew-1.87.orig/mew-summary.el Mon Jul 28 12:21:53 1997
--- mew-1.87/mew-summary.el Tue Jul 29 19:23:54 1997
***************
*** 1515,1541 ****
;;; Packing
;;;
(defun mew-summary-pack ()
(interactive)
(let ((folder (buffer-name)))
(if (not (mew-summary-exclusive-p))
! (message "Try later")
(mew-mark-clean-up)
(if (not (mew-y-or-n-p "Pack %s? " folder))
()
! (setq mew-summary-buffer-process t)
! (message "Packing %s ... " folder)
! (call-process mew-prog-impack nil nil nil (format "--src=%s" folder))
! (message "Packing %s ... done" folder)
! (setq mew-summary-buffer-process nil)
! (let ((buffer-read-only nil)) (erase-buffer)) ;; for update
! (mew-summary-scan-body mew-prog-imls
'mew-summary-mode
folder
! mew-cs-scan
! (mew-input-range folder))
! ))
! ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
--- 1515,1580 ----
;;; Packing
;;;
+ ;;(defun mew-summary-pack ()
+ ;; (interactive)
+ ;; (let ((folder (buffer-name)))
+ ;; (if (not (mew-summary-exclusive-p))
+ ;; (message "Try later")
+ ;; (mew-mark-clean-up)
+ ;; (if (not (mew-y-or-n-p "Pack %s? " folder))
+ ;; ()
+ ;; (setq mew-summary-buffer-process t)
+ ;; (message "Packing %s ... " folder)
+ ;; (call-process mew-prog-impack nil nil nil (format "--src=%s" folder))
+ ;; (message "Packing %s ... done" folder)
+ ;; (setq mew-summary-buffer-process nil)
+ ;; (let ((buffer-read-only nil)) (erase-buffer)) ;; for update
+ ;; (mew-summary-scan-body mew-prog-imls
+ ;; 'mew-summary-mode
+ ;; folder
+ ;; mew-cs-scan
+ ;; (mew-input-range folder))
+ ;; ))
+ ;; ))
+
(defun mew-summary-pack ()
(interactive)
(let ((folder (buffer-name)))
(if (not (mew-summary-exclusive-p))
! ()
(mew-mark-clean-up)
(if (not (mew-y-or-n-p "Pack %s? " folder))
()
! (mew-bg-modify-summary mew-prog-impack
! (format "Packing %s" folder)
'mew-summary-mode
folder
! mew-cs-scan)))))
!
! ;;;
! (defun mew-summary-region-to-range (&optional beg end)
! ;; Note:
! ;; Returning value of this function is just a string like "22-40".
! ;; Not compatible with the returning value of mew-input-range.
! (setq beg (or beg (region-beginning)))
! (setq end (or end (region-end)))
! (save-excursion
! (let (from to)
! (goto-char beg)
! (setq from
! (or (mew-summary-message-number)
! (progn
! (re-search-backward mew-summary-message-regex nil t nil)
! (mew-summary-message-number))))
! (goto-char end)
! (setq to
! (or (mew-summary-message-number)
! (progn
! (re-search-backward mew-summary-message-regex nil t nil)
! (mew-summary-message-number))))
! (if (< (string-to-int from) (string-to-int to))
! (concat from "-" to)
! (concat to "-" from)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
diff -rcN mew-1.87.orig/mew.el mew-1.87/mew.el
*** mew-1.87.orig/mew.el Mon Jul 28 12:22:45 1997
--- mew-1.87/mew.el Tue Jul 29 19:30:47 1997
***************
*** 951,956 ****
--- 951,957 ----
(require 'mew-ext)
(require 'mew-fib)
(require 'mew-sort)
+ (require 'mew-bg)
;;;
;;; End of Mew
;;;
Mew-dist メーリングリストの案内