[Mew-dist 13552] Re: 予定

[Masaki KONUMA]

From: Kazu Yamamoto (山本和彦) <kazu at example.com>
Subject: [Mew-dist 13531] 予定
Date: Fri, 7 Jul 2000 17:28:32 +0900

> 	- Pack (僕が +inbox で多用するので)

Elisp 版 Pack が手元にあるので添付します。

-- 小沼雅樹
-------------- next part --------------
--- mew-summary.el.orig	Wed Jul  5 18:24:29 2000
+++ mew-summary.el	Fri Jul  7 23:37:07 2000
@@ -1361,7 +1361,46 @@
 (defun mew-summary-pack ()
   "Pack messages and list them up again."
   (interactive)
-  (message "XXX not yet"))
+  (mew-summary-only
+   (let ((folder (buffer-name))
+	 lines)
+     (if (not (mew-summary-exclusive-p))
+	 ()
+       (mew-mark-clean)
+       (if (and mew-ask-pack (not (y-or-n-p (format "Pack %s? " folder))))
+	   ()
+	 (setq lines (mew-summary-mark-collect3 mew-mark-review))
+	 (let ((mew-summary-buffer-process t))
+	   (message "Packing %s ..." folder)
+	   (let* ((default-directory
+		    (file-name-as-directory (mew-expand-folder folder)))
+		  (msgs (sort
+			 (directory-files
+			  default-directory nil mew-regex-message-files t)
+			 (function
+			  (lambda (a b)
+			    (< (string-to-number a) (string-to-number b))))))
+		  (n 1) new)
+	     (while msgs
+	       (cond ((eq (string-to-number (car msgs)) n)
+		      (setq n (1+ n) msgs (cdr msgs)))
+		     ((file-directory-p (car msgs))
+		      (setq msgs (cdr msgs)))
+		     (t (setq new (number-to-string n))
+			(cond ((not (file-exists-p new))
+			       (rename-file (car msgs) new)
+			       (setq msgs (cdr msgs))))
+			(setq n (1+ n))))))
+	   (mew-touch-folder folder)
+	   (message "Packing %s ... done" folder))
+	 (mew-erase-buffer) ;; for update
+	 (mew-summary-scan-body 'mew-summary-mode
+				folder
+				mew-cs-scan
+				mew-range-all
+				nil
+				nil
+				lines))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;