X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=inline;f=wl%2Fwl-util.el;h=eef7ee10aabb675c3a4698ac45b08d461f82d5d5;hb=4ac381c94e0dea68f64ceccfe34cb8cf41926db8;hp=cd24a3033188ccd51bd428bb0dc14df05f0c56d7;hpb=a865f1d21f41d6747d8800ec9ca940e98b4c41bd;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-util.el b/wl/wl-util.el
index cd24a30..eef7ee1 100644
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -1,4 +1,4 @@
-;;; wl-util.el -- Utility modules for Wanderlust.
+;;; wl-util.el --- Utility modules for Wanderlust.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 ;; Copyright (C) 2000 A. SAGATA <sagata@nttvdt.hil.ntt.co.jp>
@@ -32,11 +32,10 @@
 
 ;;; Code:
 ;;
+(require 'bytecomp)
+(require 'elmo-util)
+(require 'elmo-flag)
 
-(eval-when-compile
-  (require 'elmo-util))
-
-(condition-case nil (require 'tm-edit) (error nil))
 (condition-case nil (require 'pp) (error nil))
 
 (eval-when-compile
@@ -57,14 +56,8 @@
       (list 'nconc val func)
     (list 'setq val func)))
 
-(defun wl-parse (string regexp &optional matchn)
-  (or matchn (setq matchn 1))
-  (let (list)
-    (store-match-data nil)
-    (while (string-match regexp string (match-end 0))
-      (setq list (cons (substring string (match-beginning matchn)
-                                  (match-end matchn)) list)))
-    (nreverse list)))
+(defalias 'wl-parse 'elmo-parse)
+(make-obsolete 'wl-parse 'elmo-parse)
 
 (defun wl-delete-duplicates (list &optional all hack-addresses)
   "Delete duplicate equivalent strings from the LIST.
@@ -99,49 +92,7 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 (defalias 'wl-string-assoc 'elmo-string-assoc)
 (defalias 'wl-string-rassoc 'elmo-string-rassoc)
 
-(defun wl-parse-addresses (string)
-  (if (null string)
-      ()
-    (elmo-set-work-buf
-     ;;(unwind-protect
-     (let (list start s char)
-       (insert string)
-       (goto-char (point-min))
-       (skip-chars-forward "\t\f\n\r ")
-       (setq start (point))
-       (while (not (eobp))
-	 (skip-chars-forward "^\"\\,(")
-	 (setq char (following-char))
-	 (cond ((= char ?\\)
-		(forward-char 1)
-		(if (not (eobp))
-		    (forward-char 1)))
-	       ((= char ?,)
-		(setq s (buffer-substring start (point)))
-		(if (or (null (string-match "^[\t\f\n\r ]+$" s))
-			(not (string= s "")))
-		    (setq list (cons s list)))
-		(skip-chars-forward ",\t\f\n\r ")
-		(setq start (point)))
-	       ((= char ?\")
-		(re-search-forward "[^\\]\"" nil 0))
-	       ((= char ?\()
-		(let ((parens 1))
-		  (forward-char 1)
-		  (while (and (not (eobp)) (not (zerop parens)))
-		    (re-search-forward "[()]" nil 0)
-		    (cond ((or (eobp)
-			       (= (char-after (- (point) 2)) ?\\)))
-			  ((= (preceding-char) ?\()
-			   (setq parens (1+ parens)))
-			  (t
-			   (setq parens (1- parens)))))))))
-       (setq s (buffer-substring start (point)))
-       (if (and (null (string-match "^[\t\f\n\r ]+$" s))
-		(not (string= s "")))
-	   (setq list (cons s list)))
-       (nreverse list)) ; jwz: fixed order
-     )))
+(defalias 'wl-parse-addresses 'elmo-parse-addresses)
 
 (defun wl-append-element (list element)
   (if element
@@ -161,7 +112,7 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 	     (cmd (if (featurep 'xemacs)
 		      (event-to-character last-command-event)
 		    (string-to-char (format "%s" (this-command-keys))))))
-    (message mes-string)
+    (message "%s" mes-string)
     (setq key (car (setq keve (wl-read-event-char))))
     (if (or (equal key ?\ )
 	    (and cmd
@@ -171,6 +122,11 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 	  (funcall func))
       (wl-push (cdr keve) unread-command-events))))
 
+(defun wl-require-update-all-folder-p (name)
+  "Return non-nil if NAME is draft or queue folder."
+  (or (string= name wl-draft-folder)
+      (string= name wl-queue-folder)))
+
 ;(defalias 'wl-make-hash 'elmo-make-hash)
 ;;(make-obsolete 'wl-make-hash 'elmo-make-hash)
 
@@ -180,39 +136,50 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 ;;(defalias 'wl-set-hash-val 'elmo-set-hash-val)
 ;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
 
-(defsubst wl-set-string-width (width string)
-  (elmo-set-work-buf
-   (elmo-set-buffer-multibyte default-enable-multibyte-characters)
-   (insert string)
-   (if (> (current-column) width)
-       (if (> (move-to-column width) width)
-	   (progn
-	     (condition-case nil ; ignore error
-		 (backward-char 1)
-	       (error))
-	     (concat (buffer-substring (point-min) (point)) " "))
-	 (buffer-substring (point-min) (point)))
-     (if (= (current-column) width)
+(defsubst wl-set-string-width (width string &optional padding ignore-invalid)
+  "Make a new string which have specified WIDTH and content of STRING.
+`wl-invalid-character-message' is used when invalid character is contained.
+If WIDTH is negative number, padding chars are added to the head and
+otherwise, padding chars are added to the tail of the string.
+The optional 3rd arg PADDING, if non-nil, specifies a padding character
+to add the result instead of white space.
+If optional 4th argument is non-nil, don't use `wl-invalid-character-message'
+even when invalid character is contained."
+  (static-cond
+   ((and (fboundp 'string-width) (fboundp 'truncate-string-to-width)
+	 (not (featurep 'xemacs)))
+    (if (> (string-width string) (abs width))
+	(setq string (truncate-string-to-width string (abs width))))
+    (if (= (string-width string) (abs width))
+	string
+      (when (and (not ignore-invalid)
+		 (< (abs width) (string-width string)))
+	(setq string
+	      (truncate-string-to-width wl-invalid-character-message
+					(abs width))))
+      (let ((paddings (make-string
+		       (max 0 (- (abs width) (string-width string)))
+		       (or padding ?\ ))))
+	(if (< width 0)
+	    (concat paddings string)
+	  (concat string paddings)))))
+   (t
+    (elmo-set-work-buf
+     (set-buffer-multibyte default-enable-multibyte-characters)
+     (insert string)
+     (when (> (current-column) (abs width))
+       (when (> (move-to-column (abs width)) (abs width))
+	 (condition-case nil ; ignore error
+	     (backward-char 1)
+	   (error)))
+       (setq string (buffer-substring (point-min) (point))))
+     (if (= (current-column) (abs width))
 	 string
-       (concat string
-	       (format (format "%%%ds"
-			       (- width (current-column)))
-		       " "))))))
-
-(defun wl-display-bytes (num)
-  (let (result remain)
-    (cond
-     ((> (setq result (/ num 1000000)) 0)
-      (setq remain (% num 1000000))
-      (if (> remain 400000)
-	  (setq result (+ 1 result)))
-      (format "%dM" result))
-     ((> (setq result (/ num 1000)) 0)
-      (setq remain (% num 1000))
-      (if (> remain 400)
-	  (setq result (+ 1 result)))
-      (format "%dK" result))
-     (t (format "%dB" result)))))
+       (let ((paddings (make-string (- (abs width) (current-column))
+				    (or padding ?\ ))))
+	 (if (< width 0)
+	     (concat paddings string)
+	   (concat string paddings))))))))
 
 (defun wl-mode-line-buffer-identification (&optional id)
   (let ((priorities '(biff plug title)))
@@ -256,13 +223,17 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 	  value pair)
       (while alist
 	(setq pair (car alist))
-	(if (string-match (car pair) folder)
-	    (cond ((eq match 'all)
-		   (setq value (append value (list (cdr pair)))))
-		  ((eq match 'all-list)
-		   (setq value (append value (cdr pair))))
-		  ((not match)
-		   (throw 'found (cdr pair)))))
+	(if (and (eq match 'function)
+		 (functionp (car pair)))
+	    (when (funcall (car pair) folder)
+	      (throw 'found (cdr pair)))
+	  (if (string-match (car pair) folder)
+	      (cond ((eq match 'all)
+		     (setq value (append value (list (cdr pair)))))
+		    ((eq match 'all-list)
+		     (setq value (append value (cdr pair))))
+		    ((or (not match) (eq match 'function))
+		     (throw 'found (cdr pair))))))
 	(setq alist (cdr alist)))
       value)))
 
@@ -279,22 +250,20 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 (put 'wl-as-mime-charset 'lisp-indent-function 1)
 
 (eval-and-compile
-  (if wl-on-mule3
-      (defmacro wl-as-coding-system (coding-system &rest body)
-	(` (let ((coding-system-for-read (, coding-system))
-		 (coding-system-for-write (, coding-system)))
-	     (,@ body))))
-    (if wl-on-mule
-	(defmacro wl-as-coding-system (coding-system &rest body)
-	  (` (let ((file-coding-system-for-read (, coding-system))
-		   (file-coding-system (, coding-system)))
-	       (,@ body))))
-      (if wl-on-nemacs
-	  (defmacro wl-as-coding-system (coding-system &rest body)
-	    (` (let ((default-kanji-fileio-code (, coding-system))
-		     (kanji-fileio-code (, coding-system))
-		     kanji-expected-code)
-		 (,@ body))))))))
+  (cond
+   (wl-on-mule3
+    (defmacro wl-as-coding-system (coding-system &rest body)
+      (` (let ((coding-system-for-read (, coding-system))
+	       (coding-system-for-write (, coding-system)))
+	   (,@ body)))))
+   (wl-on-mule
+    (defmacro wl-as-coding-system (coding-system &rest body)
+      (` (let ((file-coding-system-for-read (, coding-system))
+	       (file-coding-system (, coding-system)))
+	   (,@ body)))))
+   (t
+    (defmacro wl-as-coding-system (coding-system &rest body)
+      (` (progn (,@ body)))))))
 
 (defmacro wl-as-mime-charset (mime-charset &rest body)
   (` (wl-as-coding-system (mime-charset-to-coding-system (, mime-charset))
@@ -303,25 +272,6 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 (defalias 'wl-string 'elmo-string)
 (make-obsolete 'wl-string 'elmo-string)
 
-(defun wl-parse-newsgroups (string &optional subscribe-only)
-  (let* ((nglist (wl-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
-	 ret-val)
-    (if (not subscribe-only)
-	nglist
-      (while nglist
-	(if (intern-soft (car nglist) wl-folder-newsgroups-hashtb)
-	    (wl-append ret-val (list (car nglist))))
-	(setq nglist (cdr nglist)))
-      ret-val)))
-
-;; Check if active region exists or not.
-(if (boundp 'mark-active)
-    (defmacro wl-region-exists-p ()
-      'mark-active)
-  (if (fboundp 'region-exists-p)
-      (defmacro wl-region-exists-p ()
-	(list 'region-exists-p))))
-
 (if (not (fboundp 'overlays-in))
     (defun overlays-in (beg end)
       "Return a list of the overlays that overlap the region BEG ... END.
@@ -354,14 +304,6 @@ or between BEG and END."
       (setq loop (- loop 1)))
     ret-val))
 
-(defun wl-list-diff (list1 list2)
-  "Return a list of elements of LIST1 that do not appear in LIST2."
-  (let ((list1 (copy-sequence list1)))
-    (while list2
-      (setq list1 (delq (car list2) list1))
-      (setq list2 (cdr list2)))
-    list1))
-
 (defun wl-append-assoc-list (item value alist)
   "make assoc list '((item1 value1-1 value1-2 ...)) (item2 value2-1 ...)))"
   (let ((entry (assoc item alist)))
@@ -394,6 +336,14 @@ changing the value of `foo'."
     (setq keys (cdr keys)))
   alist)
 
+(defun wl-filter-associations (keys alist)
+  (let (entry result)
+    (while keys
+      (when (setq entry (assq (car keys) alist))
+	(setq result (cons entry result)))
+      (setq keys (cdr keys)))
+    result))
+
 (defun wl-inverse-alist (keys alist)
   "Inverse ALIST, copying.
 Return an association list represents the inverse mapping of ALIST,
@@ -505,12 +455,6 @@ that `read' can handle, whenever this is possible."
       (wl-get-date-iso8601 date)
     (error "")))
 
-(defun wl-day-number (date)
-  (let ((dat (mapcar '(lambda (s) (and s (string-to-int s)) )
-		     (timezone-parse-date date))))
-    (timezone-absolute-from-gregorian
-     (nth 1 dat) (nth 2 dat) (car dat))))
-
 (defun wl-url-news (url &rest args)
   (interactive "sURL: ")
   (if (string-match "^news:\\(.*\\)$" url)
@@ -525,14 +469,14 @@ that `read' can handle, whenever this is possible."
 	 "^nntp://\\([^:/]*\\):?\\([0-9]*\\)/\\([^/]*\\)/\\([0-9]*\\).*$" url)
 	(progn
 	  (if (eq (length (setq fld-name
-                                (elmo-match-string 3 url))) 0)
-              (setq fld-name nil))
+				(elmo-match-string 3 url))) 0)
+	      (setq fld-name nil))
 	  (if (eq (length (setq port
 				(elmo-match-string 2 url))) 0)
-              (setq port (int-to-string elmo-default-nntp-port)))
+	      (setq port (int-to-string elmo-nntp-default-port)))
 	  (if (eq (length (setq server
-                                (elmo-match-string 1 url))) 0)
-              (setq server elmo-default-nntp-server))
+				(elmo-match-string 1 url))) 0)
+	      (setq server elmo-nntp-default-server))
 	  (setq folder (concat "-" fld-name "@" server ":" port))
 	  (if (eq (length (setq msg
 				(elmo-match-string 4 url))) 0)
@@ -540,19 +484,23 @@ that `read' can handle, whenever this is possible."
 	       folder nil nil nil t)
 	    (wl-summary-goto-folder-subr
 	     folder 'update nil nil t)
-	    (goto-char (point-min))
-	    (re-search-forward (concat "^ *" msg) nil t)
+	    (wl-summary-jump-to-msg (string-to-number msg))
 	    (wl-summary-redisplay)))
       (message "Not a nntp: url."))))
 
 (defmacro wl-concat-list (list separator)
   (` (mapconcat 'identity (delete "" (delq nil (, list))) (, separator))))
 
-(defmacro wl-current-message-buffer ()
-  (` (save-excursion
-       (if (buffer-live-p wl-current-summary-buffer)
-           (set-buffer wl-current-summary-buffer))
-       wl-message-buf-name)))
+(defun wl-current-message-buffer ()
+  (when (buffer-live-p wl-current-summary-buffer)
+    (with-current-buffer wl-current-summary-buffer
+      (or wl-message-buffer
+	  (and (wl-summary-message-number)
+	       (wl-message-buffer-display
+		wl-summary-buffer-elmo-folder
+		(wl-summary-message-number)
+		wl-summary-buffer-display-mime-mode
+		nil nil))))))
 
 (defmacro wl-kill-buffers (regexp)
   (` (mapcar (function
@@ -563,17 +511,6 @@ that `read' can handle, whenever this is possible."
 			 (kill-buffer x)))))
 	     (buffer-list))))
 
-(defun wl-sendlog-time ()
-  (static-if (fboundp 'format-time-string)
-      (format-time-string "%Y/%m/%d %T")
-    (let ((date (current-time-string)))
-      (format "%s/%02d/%02d %s"
-	      (substring date -4)
-	      (cdr (assoc (upcase (substring date 4 7))
-			  timezone-months-assoc))
-	      (string-to-int (substring date 8 10))
-	      (substring date 11 19)))))
-
 (defun wl-collect-summary ()
   (let (result)
     (mapcar
@@ -587,8 +524,40 @@ that `read' can handle, whenever this is possible."
      (buffer-list))
     result))
 
+(defun wl-collect-draft ()
+  (let ((draft-regexp (concat "^" (regexp-quote wl-draft-folder)))
+	result)
+    (dolist (buffer (buffer-list))
+      (when (with-current-buffer buffer
+	      (and (eq major-mode 'wl-draft-mode)
+		   (buffer-name)
+		   (string-match draft-regexp (buffer-name))))
+	(setq result (cons buffer result))))
+    (nreverse result)))
+
+(defvar wl-inhibit-save-drafts nil)
+(defvar wl-disable-auto-save nil)
+(make-variable-buffer-local 'wl-disable-auto-save)
+
+(defun wl-save-drafts ()
+  "Save all drafts. Return nil if there is no draft buffer."
+  (if wl-inhibit-save-drafts
+      'inhibited
+    (let ((wl-inhibit-save-drafts t)
+	  (msg (current-message))
+	  (buffers (wl-collect-draft)))
+      (save-excursion
+	(dolist (buffer buffers)
+	  (set-buffer buffer)
+	  (when (and (not wl-disable-auto-save)
+		     (buffer-modified-p))
+	    (wl-draft-save))))
+      (message "%s" (or msg ""))
+      buffers)))
+
 (static-if (fboundp 'read-directory-name)
-    (defalias 'wl-read-directory-name 'read-directory-name)
+    (defun wl-read-directory-name (prompt dir)
+      (read-directory-name prompt dir dir))
   (defun wl-read-directory-name (prompt dir)
     (let ((dir (read-file-name prompt dir)))
       (unless (file-directory-p dir)
@@ -650,27 +619,36 @@ that `read' can handle, whenever this is possible."
      ;; Append the name of the message interface, because while the
      ;; generated ID is unique to this newsreader, other newsreaders
      ;; might otherwise generate the same ID via another algorithm.
-     ".wl")))
+     wl-unique-id-suffix)))
 
+(defvar wl-message-id-function 'wl-draft-make-message-id-string)
 (defun wl-draft-make-message-id-string ()
   "Return Message-ID field value."
-  (concat "<" (wl-unique-id) "@"
-	  (or wl-message-id-domain
-	      (if wl-local-domain
-		  (concat (system-name) "." wl-local-domain)
-		(system-name)))
-	  ">"))
+  (concat "<" (wl-unique-id)
+	  (let (from user domain)
+	    (if (and wl-message-id-use-wl-from
+		     (progn
+		       (setq from (wl-address-header-extract-address wl-from))
+		       (and (string-match "^\\(.*\\)@\\(.*\\)$" from)
+			    (setq user   (match-string 1 from))
+			    (setq domain (match-string 2 from)))))
+		(format "%%%s@%s>" user domain)
+	      (format "@%s>"
+		      (or wl-message-id-domain
+			  (if wl-local-domain
+			      (concat (system-name) "." wl-local-domain)
+			    (system-name))))))))
 
 ;;; Profile loading.
-(defvar wl-load-profile-func 'wl-local-load-profile)
+(defvar wl-load-profile-function 'wl-local-load-profile)
 (defun wl-local-load-profile ()
   "Load `wl-init-file'."
-  (message "Initializing ...")
+  (message "Initializing...")
   (load wl-init-file 'noerror 'nomessage))
 
 (defun wl-load-profile ()
-  "Call `wl-load-profile-func' function."
-  (funcall wl-load-profile-func))
+  "Call `wl-load-profile-function' function."
+  (funcall wl-load-profile-function))
 
 ;;;
 
@@ -706,6 +684,56 @@ that `read' can handle, whenever this is possible."
 	  (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
 	max))))
 
+;; Draft auto-save
+(defun wl-auto-save-drafts ()
+  (unless (wl-save-drafts)
+    (wl-stop-save-drafts)))
+
+(static-cond
+ (wl-on-xemacs
+  (defvar wl-save-drafts-timer-name "wl-save-drafts")
+
+  (defun wl-start-save-drafts ()
+    (when (numberp wl-auto-save-drafts-interval)
+      (unless (get-itimer wl-save-drafts-timer-name)
+	(start-itimer wl-save-drafts-timer-name
+		      'wl-auto-save-drafts
+		      wl-auto-save-drafts-interval
+		      wl-auto-save-drafts-interval
+		      t))))
+
+  (defun wl-stop-save-drafts ()
+    (when (get-itimer wl-save-drafts-timer-name)
+      (delete-itimer wl-save-drafts-timer-name))))
+ (t
+  (defun wl-start-save-drafts ()
+    (when (numberp wl-auto-save-drafts-interval)
+      (require 'timer)
+      (if (get 'wl-save-drafts 'timer)
+	  (progn
+	    (timer-set-idle-time (get 'wl-save-drafts 'timer)
+				 wl-auto-save-drafts-interval t)
+	    (timer-activate-when-idle (get 'wl-save-drafts 'timer)))
+	(put 'wl-save-drafts 'timer
+	     (run-with-idle-timer
+	      wl-auto-save-drafts-interval t 'wl-auto-save-drafts)))))
+
+  (defun wl-stop-save-drafts ()
+    (when (get 'wl-save-drafts 'timer)
+      (cancel-timer (get 'wl-save-drafts 'timer))))))
+
+(defun wl-set-auto-save-draft (&optional arg)
+  (interactive "P")
+  (unless (setq wl-disable-auto-save
+		(cond
+		 ((null arg) (not wl-disable-auto-save))
+		 ((< (prefix-numeric-value arg) 0) t)
+		 (t nil)))
+    (wl-start-save-drafts))
+  (when (interactive-p)
+    (message "Auto save is %s (in this buffer)"
+	     (if wl-disable-auto-save "disabled" "enabled"))))
+
 ;; Biff
 (static-cond
  (wl-on-xemacs
@@ -718,13 +746,11 @@ that `read' can handle, whenever this is possible."
   (defun wl-biff-start ()
     (wl-biff-stop)
     (when wl-biff-check-folder-list
-      (wl-biff-check-folders)
       (start-itimer wl-biff-timer-name 'wl-biff-check-folders
-		    wl-biff-check-interval wl-biff-check-interval))))
-
- ((and (condition-case nil (require 'timer) (error nil));; FSFmacs 19+
-       (fboundp 'timer-activate))
+		    wl-biff-check-interval wl-biff-check-interval
+		    wl-biff-use-idle-timer))))
 
+ (t
   (defun wl-biff-stop ()
     (when (get 'wl-biff 'timer)
       (cancel-timer (get 'wl-biff 'timer))))
@@ -732,14 +758,27 @@ that `read' can handle, whenever this is possible."
   (defun wl-biff-start ()
     (require 'timer)
     (when wl-biff-check-folder-list
-      (wl-biff-check-folders)
-      (if (get 'wl-biff 'timer)
-	  (timer-activate (get 'wl-biff 'timer))
-	(put 'wl-biff 'timer (run-at-time
+      (if wl-biff-use-idle-timer
+	  (if (get 'wl-biff 'timer)
+	      (progn (timer-set-idle-time (get 'wl-biff 'timer)
+					  wl-biff-check-interval t)
+		     (timer-activate-when-idle (get 'wl-biff 'timer)))
+	    (put 'wl-biff 'timer
+		 (run-with-idle-timer
+		  wl-biff-check-interval t 'wl-biff-event-handler)))
+	(if (get 'wl-biff 'timer)
+	    (progn
+	      (timer-set-time (get 'wl-biff 'timer)
 			      (timer-next-integral-multiple-of-time
 			       (current-time) wl-biff-check-interval)
-			      wl-biff-check-interval
-			      'wl-biff-event-handler)))))
+			      wl-biff-check-interval)
+	      (timer-activate (get 'wl-biff 'timer)))
+	  (put 'wl-biff 'timer
+	       (run-at-time
+		(timer-next-integral-multiple-of-time
+		 (current-time) wl-biff-check-interval)
+		wl-biff-check-interval
+		'wl-biff-event-handler))))))
 
   (defun-maybe timer-next-integral-multiple-of-time (time secs)
     "Yield the next value after TIME that is an integral multiple of SECS.
@@ -797,14 +836,13 @@ This function is imported from Emacs 20.7."
 	    (timer-set-time timer (timer-next-integral-multiple-of-time
 				   current wl-biff-check-interval)
 			    wl-biff-check-interval)
-	    (timer-activate timer))))))
- (t
-  (fset 'wl-biff-stop 'ignore)
-  (fset 'wl-biff-start 'ignore)))
+	    (timer-activate timer)))))))
 
 (defsubst wl-biff-notify (new-mails notify-minibuf)
   (when (and (not wl-modeline-biff-status) (> new-mails 0))
     (run-hooks 'wl-biff-notify-hook))
+  (when (and wl-modeline-biff-status (eq new-mails 0))
+    (run-hooks 'wl-biff-unnotify-hook))
   (setq wl-modeline-biff-status (> new-mails 0))
   (force-mode-line-update t)
   (when notify-minibuf
@@ -827,12 +865,14 @@ This function is imported from Emacs 20.7."
 	  (flist (or wl-biff-check-folder-list (list wl-default-folder)))
 	  folder)
       (if (eq (length flist) 1)
-	  (wl-biff-check-folder-async (car flist) (interactive-p))
+	  (wl-biff-check-folder-async (wl-folder-get-elmo-folder
+				       (car flist) 'biff) (interactive-p))
 	(unwind-protect
 	    (while flist
-	      (setq folder (car flist)
+	      (setq folder (wl-folder-get-elmo-folder (car flist))
 		    flist (cdr flist))
-	      (when (elmo-folder-plugged-p folder)
+	      (when (and (elmo-folder-plugged-p folder)
+			 (elmo-folder-exists-p folder))
 		(setq new-mails
 		      (+ new-mails
 			 (nth 0 (wl-biff-check-folder folder))))))
@@ -840,20 +880,21 @@ This function is imported from Emacs 20.7."
 	  (wl-biff-notify new-mails (interactive-p)))))))
 
 (defun wl-biff-check-folder (folder)
-  (if (eq (elmo-folder-get-type folder) 'pop3)
-      ;; pop3 biff should share the session.
-      (prog2
-	  (elmo-commit folder) ; Close session.
-	  (wl-folder-check-one-entity folder)
-	(elmo-commit folder))
-    (let ((elmo-network-session-name-prefix "BIFF-"))
-      (wl-folder-check-one-entity folder))))
+  (if (eq (elmo-folder-type-internal folder) 'pop3)
+      (unless (elmo-pop3-get-session folder 'any-exists)
+	(wl-folder-check-one-entity (elmo-folder-name-internal folder)
+				    'biff))
+    (wl-folder-check-one-entity (elmo-folder-name-internal folder)
+				'biff)))
 
 (defun wl-biff-check-folder-async-callback (diff data)
   (if (nth 1 data)
       (with-current-buffer (nth 1 data)
-	(wl-folder-entity-hashtb-set wl-folder-entity-hashtb (nth 0 data)
-				     (list (car diff) 0 (cdr diff))
+	(wl-folder-entity-hashtb-set wl-folder-entity-hashtb
+				     (nth 0 data)
+				     (list (nth 0 diff)
+					   (- (nth 1 diff) (nth 0 diff))
+					   (nth 2 diff))
 				     (current-buffer))))
   (setq wl-folder-info-alist-modified t)
   (setq wl-biff-check-folders-running nil)
@@ -861,22 +902,26 @@ This function is imported from Emacs 20.7."
   (wl-biff-notify (car diff) (nth 2 data)))
 
 (defun wl-biff-check-folder-async (folder notify-minibuf)
-  (when (elmo-folder-plugged-p folder)
-    (let ((type (elmo-folder-get-type folder)))
-      (if (and (eq type 'imap4)
-	       (wl-folder-use-server-diff-p folder))
-	  ;; Check asynchronously only when IMAP4 and use server diff.
-	  (progn
-	    (setq elmo-folder-diff-async-callback
-		  'wl-biff-check-folder-async-callback)
-	    (setq elmo-folder-diff-async-callback-data
-		  (list folder (get-buffer wl-folder-buffer-name)
-			notify-minibuf))
-	    (let ((elmo-network-session-name-prefix "BIFF-"))
-	      (elmo-folder-diff-async folder)))
-	(wl-biff-notify (car (wl-biff-check-folder folder))
-			notify-minibuf)
-	(setq wl-biff-check-folders-running nil)))))
+  (if (and (elmo-folder-plugged-p folder)
+	   (wl-folder-entity-exists-p (elmo-folder-name-internal folder)))
+      (progn
+	(elmo-folder-set-biff-internal folder t)
+	(if (and (eq (elmo-folder-type-internal folder) 'imap4)
+		 (elmo-folder-use-flag-p folder))
+	    ;; Check asynchronously only when IMAP4 and use server diff.
+	    (progn
+	      (setq elmo-folder-diff-async-callback
+		    'wl-biff-check-folder-async-callback)
+	      (setq elmo-folder-diff-async-callback-data
+		    (list (elmo-folder-name-internal folder)
+			  (get-buffer wl-folder-buffer-name)
+			  notify-minibuf))
+	      (elmo-folder-diff-async folder))
+	  (unwind-protect
+	      (wl-biff-notify (car (wl-biff-check-folder folder))
+			      notify-minibuf)
+	    (setq wl-biff-check-folders-running nil))))
+    (setq wl-biff-check-folders-running nil)))
 
 (if (and (fboundp 'regexp-opt)
 	 (not (featurep 'xemacs)))
@@ -890,6 +935,254 @@ is enclosed by at least one regexp grouping construct."
       (concat open-paren (mapconcat 'regexp-quote strings "\\|")
 	      close-paren))))
 
+(defalias 'wl-expand-newtext 'elmo-expand-newtext)
+(defalias 'wl-regexp-opt 'elmo-regexp-opt)
+
+(defun wl-region-exists-p ()
+  "Return non-nil if a region exists on current buffer."
+  (static-if (featurep 'xemacs)
+      (region-active-p)
+    (and transient-mark-mode mark-active)))
+
+(defun wl-deactivate-region ()
+  "Deactivate region on current buffer"
+  (static-if (not (featurep 'xemacs))
+      (setq mark-active nil)))
+
+(defvar wl-line-string)
+(defun wl-line-parse-format (format spec-alist)
+  "Make a formatter from FORMAT and SPEC-ALIST."
+  (let (f spec specs stack)
+    (setq f
+	  (with-temp-buffer
+	    (insert format)
+	    (goto-char (point-min))
+	    (while (search-forward "%" nil t)
+	      (cond
+	       ((looking-at "%")
+		(goto-char (match-end 0)))
+	       ((looking-at "\\(-?\\(0?\\)[0-9]*\\)\\([^0-9]\\)")
+		(cond
+		 ((string= (match-string 3) "(")
+		  (if (zerop (length (match-string 1)))
+		      (error "No number specification for %%( line format"))
+		  (push (list
+			 (match-beginning 0) ; start
+			 (match-end 0)       ; start-content
+			 (string-to-number
+			  (match-string 1))  ; width
+			 specs) ; specs
+			stack)
+		  (setq specs nil))
+		 ((string= (match-string 3) ")")
+		  (let ((entry (pop stack))
+			form)
+		    (unless entry
+		      (error
+		       "No matching %%( parenthesis in summary line format"))
+		    (goto-char (car entry)) ; start
+		    (setq form (buffer-substring (nth 1 entry) ; start-content
+						 (- (match-beginning 0) 1)))
+		    (delete-region (car entry) (match-end 0))
+		    (insert "s")
+		    (setq specs
+			  (append
+			   (nth 3 entry)
+			   (list (list 'wl-set-string-width (nth 2 entry)
+				       (append
+					(list 'format form)
+					specs)))))))
+		 (t
+		  (setq spec
+			(if (setq spec (assq (string-to-char (match-string 3))
+					     spec-alist))
+			    (nth 1 spec)
+			  (match-string 3)))
+		  (unless (string= "" (match-string 1))
+		    (setq spec (list 'wl-set-string-width
+				     (string-to-number (match-string 1))
+				     spec
+				     (unless (string= "" (match-string 2))
+				       (string-to-char (match-string 2))))))
+		  (replace-match "s" 'fixed)
+		  (setq specs (append specs
+				      (list
+				       (list
+					'setq 'wl-line-string
+					spec)))))))))
+	    (buffer-string)))
+    (append (list 'format f) specs)))
+
+(defmacro wl-line-formatter-setup (formatter format alist)
+  (` (let (byte-compile-warnings)
+       (setq (, formatter)
+	     (byte-compile
+	      (list 'lambda ()
+		    (wl-line-parse-format (, format) (, alist)))))
+       (when (get-buffer "*Compile-Log*")
+	 (bury-buffer "*Compile-Log*"))
+       (when (get-buffer "*Compile-Log-Show*")
+	 (bury-buffer "*Compile-Log-Show*")))))
+
+(defsubst wl-copy-local-variables (src dst local-variables)
+  "Copy value of LOCAL-VARIABLES from SRC buffer to DST buffer."
+  (with-current-buffer dst
+    (dolist (variable local-variables)
+      (set (make-local-variable variable)
+	   (with-current-buffer src
+	     (symbol-value variable))))))
+
+;;; Search Condition
+(defun wl-search-condition-fields ()
+  (let ((denial-fields
+	 (nconc (mapcar 'capitalize elmo-msgdb-extra-fields)
+		(mapcar 'capitalize wl-additional-search-condition-fields)
+		'("Flag" "Since" "Before"
+		  "From" "Subject" "To" "Cc" "Body" "ToCc"
+		  "Larger" "Smaller"))))
+    (append '("Last" "First")
+	    denial-fields
+	    (mapcar (lambda (f) (concat "!" f))
+		    denial-fields))))
+
+(defun wl-read-search-condition (default)
+  "Read search condition string interactively."
+  (wl-read-search-condition-internal "Search by" default))
+
+(defun wl-read-search-condition-internal (prompt default &optional paren)
+  (let* ((completion-ignore-case t)
+	 (field (completing-read
+		 (format "%s (%s): " prompt default)
+		 (mapcar #'list
+			 (append '("AND" "OR") (wl-search-condition-fields)))))
+	 value)
+    (setq field (if (string= field "")
+		    (setq field default)
+		  field))
+    (cond
+     ((or (string= field "AND") (string= field "OR"))
+      (concat (if paren "(" "")
+	      (wl-read-search-condition-internal
+	       (concat field "(1) Search by") default 'paren)
+	      (if (string= field "AND") "&" "|")
+	      (wl-read-search-condition-internal
+	       (concat field "(2) Search by") default 'paren)
+	      (if paren ")" "")))
+     ((string-match "Since\\|Before" field)
+      (let ((default (format-time-string "%Y-%m-%d")))
+	(setq value (completing-read
+		     (format "Value for '%s' [%s]: " field default)
+		     (mapcar (function
+			      (lambda (x)
+				(list (format "%s" (car x)))))
+			     elmo-date-descriptions)))
+	(concat (downcase field) ":"
+		(if (equal value "") default value))))
+     ((string-match "!?Flag" field)
+      (while (null value)
+	(setq value (downcase
+		     (completing-read
+		      (format "Value for '%s': " field)
+		      (mapcar (lambda (f) (list (capitalize (symbol-name f))))
+			      (elmo-uniq-list
+			       (append
+				'(unread answered forwarded digest any)
+				(copy-sequence elmo-global-flags))
+			       #'delq)))))
+	(unless (elmo-flag-valid-p value)
+	  (message "Invalid char in `%s'" value)
+	  (setq value nil)
+	  (sit-for 1)))
+      (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
+			    value)
+	(setq value (prin1-to-string value)))
+      (concat (downcase field) ":" value))
+     (t
+      (setq value (read-from-minibuffer (format "Value for '%s': " field)))
+      (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
+			    value)
+	(setq value (prin1-to-string value)))
+      (concat (downcase field) ":" value)))))
+
+(defun wl-y-or-n-p-with-scroll (prompt &optional scroll-by-SPC)
+  (let ((prompt (concat prompt (if scroll-by-SPC
+				   "<y/n/SPC(down)/BS(up)> "
+				 "<y/n/j(down)/k(up)> "))))
+    (catch 'done
+      (while t
+	(discard-input)
+	(case (let ((cursor-in-echo-area t))
+		(cdr (wl-read-event-char prompt)))
+	  ((?y ?Y)
+	   (throw 'done t))
+	  (?\ 
+	   (if scroll-by-SPC
+	       (ignore-errors (scroll-up))
+	     (throw 'done t)))
+	  ((?v ?j ?J next)
+	   (ignore-errors (scroll-up)))
+	  ((?^ ?k ?K prior backspace)
+	   (ignore-errors (scroll-down)))
+	  (t
+	   (throw 'done nil)))))))
+
+(defun wl-find-region (beg-regexp end-regexp)
+  (if (or (re-search-forward end-regexp nil t)
+	  (re-search-backward end-regexp nil t))
+      (let ((end (match-end 0))
+	    (beg (re-search-backward beg-regexp nil t)))
+	(if beg
+	    (cons beg end)))))
+
+;; read multiple strings with completion
+(defun wl-completing-read-multiple-1 (prompt
+				      table
+				      &optional predicate
+				      require-match initial-input
+				      hist def inherit-input-method)
+    "Read multiple strings in the minibuffer"
+    (split-string
+     (completing-read prompt table predicate nil
+		      initial-input hist def inherit-input-method)
+     ","))
+
+(static-when (fboundp 'completing-read-multiple)
+  (eval-when-compile
+    (require 'crm))
+  (defun wl-completing-read-multiple-2 (prompt
+					table
+					&optional predicate
+					require-match initial-input
+					hist def inherit-input-method)
+    "Read multiple strings in the minibuffer"
+    (let ((ret (completing-read-multiple prompt table predicate
+					 require-match initial-input
+					 hist def inherit-input-method)))
+      (if (and def (equal ret '("")))
+	  (split-string def crm-separator)
+	ret))))
+
+(static-cond
+ ((not (fboundp 'completing-read-multiple))
+  (defalias 'wl-completing-read-multiple 'wl-completing-read-multiple-1))
+ ((< emacs-major-version 22)
+  (defun wl-completing-read-multiple (prompt
+				      table
+				      &optional predicate
+				      require-match initial-input
+				      hist def inherit-input-method)
+    "Read multiple strings in the minibuffer"
+    (if require-match
+	(wl-completing-read-multiple-1 prompt table predicate
+				       nil initial-input
+				       hist def inherit-input-method)
+      (wl-completing-read-multiple-2 prompt table predicate
+				     nil initial-input
+				     hist def inherit-input-method))))
+ (t
+  (defalias 'wl-completing-read-multiple 'wl-completing-read-multiple-2)))
+
+
 (require 'product)
 (product-provide (provide 'wl-util) (require 'wl-version))