X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-util.el;h=1613ea1c11eed11a17e3925ce39a36b580d232cb;hb=c77b16ddb7317932d0bbb9b62286ead51e772d5f;hp=b8771dbeeec91f32eb836d329963ce2bb72745a8;hpb=58eed29a09573026d2997a6facd9bb5049d4e301;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-util.el b/wl/wl-util.el
index b8771db..1613ea1 100644
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -33,8 +33,12 @@
 ;;; Code:
 ;;
 (require 'bytecomp)
-(eval-when-compile
-  (require 'elmo-util))
+(require 'elmo-util)
+(require 'elmo-flag)
+(require 'wl-vars)
+(eval-when-compile (require 'elmo-pop3))
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
 
 (condition-case nil (require 'pp) (error nil))
 
@@ -92,49 +96,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
@@ -156,7 +118,7 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
 		    (string-to-char (format "%s" (this-command-keys))))))
     (message "%s" mes-string)
     (setq key (car (setq keve (wl-read-event-char))))
-    (if (or (equal key ?\ )
+    (if (or (equal key (string-to-char " "))
 	    (and cmd
 		 (equal key cmd)))
 	(progn
@@ -169,14 +131,14 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses,
   (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)
+;;;(defalias 'wl-make-hash 'elmo-make-hash)
+;;;(make-obsolete 'wl-make-hash 'elmo-make-hash)
 
-;;(defalias 'wl-get-hash-val 'elmo-get-hash-val)
-;;(make-obsolete 'wl-get-hash-val 'elmo-get-hash-val)
+;;;(defalias 'wl-get-hash-val 'elmo-get-hash-val)
+;;;(make-obsolete 'wl-get-hash-val 'elmo-get-hash-val)
 
-;;(defalias 'wl-set-hash-val 'elmo-set-hash-val)
-;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
+;;;(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 &optional padding ignore-invalid)
   "Make a new string which have specified WIDTH and content of STRING.
@@ -201,7 +163,7 @@ even when invalid character is contained."
 					(abs width))))
       (let ((paddings (make-string
 		       (max 0 (- (abs width) (string-width string)))
-		       (or padding ?\ ))))
+		       (or padding (string-to-char " ")))))
 	(if (< width 0)
 	    (concat paddings string)
 	  (concat string paddings)))))
@@ -218,7 +180,7 @@ even when invalid character is contained."
      (if (= (current-column) (abs width))
 	 string
        (let ((paddings (make-string (- (abs width) (current-column))
-				    (or padding ?\ ))))
+				    (or padding (string-to-char " ")))))
 	 (if (< width 0)
 	     (concat paddings string)
 	   (concat string paddings))))))))
@@ -279,14 +241,14 @@ even when invalid character is contained."
 	(setq alist (cdr alist)))
       value)))
 
-(defmacro wl-match-string (pos string)
+(defun wl-match-string (pos string)
   "Substring POSth matched STRING."
-  (` (substring (, string) (match-beginning (, pos)) (match-end (, pos)))))
+  (substring string (match-beginning pos) (match-end pos)))
 
-(defmacro wl-match-buffer (pos)
+(defun wl-match-buffer (pos)
   "Substring POSth matched from the current buffer."
-  (` (buffer-substring-no-properties
-      (match-beginning (, pos)) (match-end (, pos)))))
+  (buffer-substring-no-properties
+   (match-beginning pos) (match-end pos)))
 
 (put 'wl-as-coding-system 'lisp-indent-function 1)
 (put 'wl-as-mime-charset 'lisp-indent-function 1)
@@ -295,21 +257,21 @@ even when invalid character is contained."
   (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)))))
+      `(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)))))
+      `(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)))))))
+      `(progn ,@body)))))
 
 (defmacro wl-as-mime-charset (mime-charset &rest body)
-  (` (wl-as-coding-system (mime-charset-to-coding-system (, mime-charset))
-       (,@ body))))
+  `(wl-as-coding-system (mime-charset-to-coding-system ,mime-charset)
+     ,@body))
 
 (defalias 'wl-string 'elmo-string)
 (make-obsolete 'wl-string 'elmo-string)
@@ -378,6 +340,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,
@@ -395,8 +365,6 @@ The objects mapped (cdrs of elements of the ALIST) are shared."
       (setq keys (cdr keys)))
     result))
 
-(eval-when-compile
-  (require 'static))
 (static-unless (fboundp 'pp)
   (defvar pp-escape-newlines t)
   (defun pp (object &optional stream)
@@ -489,12 +457,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)
@@ -513,7 +475,7 @@ that `read' can handle, whenever this is possible."
 	      (setq fld-name nil))
 	  (if (eq (length (setq port
 				(elmo-match-string 2 url))) 0)
-	      (setq port (int-to-string elmo-nntp-default-port)))
+	      (setq port (number-to-string elmo-nntp-default-port)))
 	  (if (eq (length (setq server
 				(elmo-match-string 1 url))) 0)
 	      (setq server elmo-nntp-default-server))
@@ -529,7 +491,7 @@ that `read' can handle, whenever this is possible."
       (message "Not a nntp: url."))))
 
 (defmacro wl-concat-list (list separator)
-  (` (mapconcat 'identity (delete "" (delq nil (, list))) (, separator))))
+  `(mapconcat 'identity (delete "" (delq nil ,list)) ,separator))
 
 (defun wl-current-message-buffer ()
   (when (buffer-live-p wl-current-summary-buffer)
@@ -542,51 +504,57 @@ that `read' can handle, whenever this is possible."
 		wl-summary-buffer-display-mime-mode
 		nil nil))))))
 
-(defmacro wl-kill-buffers (regexp)
-  (` (mapcar (function
-	      (lambda (x)
-		(if (and (buffer-name x)
-			 (string-match (, regexp) (buffer-name x)))
-		    (and (get-buffer x)
-			 (kill-buffer x)))))
-	     (buffer-list))))
+(defun wl-kill-buffers (regexp)
+  (mapc
+   (lambda (x)
+     (if (and (buffer-name x)
+	      (string-match regexp (buffer-name x)))
+	 (and (get-buffer x)
+	      (kill-buffer x))))
+   (buffer-list)))
 
 (defun wl-collect-summary ()
   (let (result)
-    (mapcar
-     (function (lambda (x)
-		 (if (and (string-match "^Summary"
-					(buffer-name x))
-			  (save-excursion
-			    (set-buffer x)
-			    (equal major-mode 'wl-summary-mode)))
-		     (setq result (nconc result (list x))))))
+    (mapc
+     (lambda (x)
+       (if (and (string-match "^Summary"
+			      (buffer-name x))
+		(with-current-buffer x
+		  (eq major-mode 'wl-summary-mode)))
+	   (setq result (nconc result (list x)))))
      (buffer-list))
     result))
 
 (defun wl-collect-draft ()
-  (let ((draft-regexp (concat
-		       "^" (regexp-quote wl-draft-folder)))
-	result buf)
-    (mapcar
-     (function (lambda (x)
-		 (if (with-current-buffer x
-		       (and (eq major-mode 'wl-draft-mode)
-			    (buffer-name)
-			    (string-match draft-regexp (buffer-name))))
-		     (setq result (nconc result (list x))))))
-     (buffer-list))
-    result))
+  (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 ()
-  (let ((msg (current-message))
-	(buffers (wl-collect-draft)))
-    (save-excursion
-      (while buffers
-	(set-buffer (car buffers))
-	(if (buffer-modified-p) (wl-draft-save))
-	(setq buffers (cdr buffers))))
-    (message "%s" (or msg ""))))
+  "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)
     (defun wl-read-directory-name (prompt dir)
@@ -601,8 +569,8 @@ that `read' can handle, whenever this is possible."
 (static-if (fboundp 'local-variable-p)
     (defalias 'wl-local-variable-p 'local-variable-p)
   (defmacro wl-local-variable-p (symbol &optional buffer)
-    (` (if (assq (, symbol) (buffer-local-variables (, buffer)))
-	   t))))
+    `(if (assq ,symbol (buffer-local-variables ,buffer))
+	 t)))
 
 (defun wl-number-base36 (num len)
   (if (if (< len 0)
@@ -633,11 +601,11 @@ that `read' can handle, whenever this is possible."
 				      ("Jul" . "07") ("Aug" . "08")
 				      ("Sep" . "09") ("Oct" . "10")
 				      ("Nov" . "11") ("Dec" . "12"))))))
-		(list (string-to-int (concat (nth 6 cts) m
-					     (substring (nth 2 cts) 0 1)))
-		      (string-to-int (concat (substring (nth 2 cts) 1)
-					     (nth 4 cts) (nth 5 cts)
-					     (nth 6 cts))))))))
+		(list (string-to-number (concat (nth 6 cts) m
+						(substring (nth 2 cts) 0 1)))
+		      (string-to-number (concat (substring (nth 2 cts) 1)
+						(nth 4 cts) (nth 5 cts)
+						(nth 6 cts))))))))
     (concat
      (if (memq system-type '(ms-dos emx vax-vms))
 	 (let ((user (downcase (user-login-name))))
@@ -685,10 +653,8 @@ that `read' can handle, whenever this is possible."
 
 ;;;
 
-(defmacro wl-count-lines ()
-  (` (save-excursion
-       (beginning-of-line)
-       (count-lines 1 (point)))))
+(defsubst wl-count-lines ()
+  (count-lines 1 (point-at-bol)))
 
 (defun wl-horizontal-recenter ()
   "Recenter the current buffer horizontally."
@@ -718,32 +684,54 @@ that `read' can handle, whenever this is possible."
 	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-set-save-drafts ()
-    (if (numberp wl-auto-save-drafts-interval)
-	(unless (get-itimer wl-save-drafts-timer-name)
-	  (start-itimer wl-save-drafts-timer-name 'wl-save-drafts
-			wl-auto-save-drafts-interval wl-auto-save-drafts-interval
-			t))
-      (when (get-itimer wl-save-drafts-timer-name)
-	(delete-itimer wl-save-drafts-timer-name)))))
+  (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-set-save-drafts ()
-    (if (numberp wl-auto-save-drafts-interval)
-	(progn
-	  (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-save-drafts))))
-      (when (get 'wl-save-drafts 'timer)
-	(cancel-timer (get 'wl-save-drafts 'timer)))))))
+  (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
@@ -882,6 +870,7 @@ This function is imported from Emacs 20.7."
 	    (while flist
 	      (setq folder (wl-folder-get-elmo-folder (car flist))
 		    flist (cdr flist))
+	      (elmo-folder-set-biff-internal folder t)
 	      (when (and (elmo-folder-plugged-p folder)
 			 (elmo-folder-exists-p folder))
 		(setq new-mails
@@ -1025,15 +1014,15 @@ is enclosed by at least one regexp grouping construct."
     (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*")))))
+  `(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."
@@ -1043,6 +1032,196 @@ is enclosed by at least one regexp grouping construct."
 	   (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
+		      (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))
+	  ((string-to-char " ")
+	   (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)))))
+
+(defun wl-simple-display-progress (label action current total)
+  (message "%s... %d%%"
+	   action
+	   (if (> total 0) (floor (* (/ current (float total)) 100)) 0)))
+
+(when (fboundp 'progress-feedback-with-label)
+  (defun wl-display-progress-with-gauge (label action current total)
+    (progress-feedback-with-label
+     label
+     "%s..."
+     (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
+     action)))
+
+(defun wl-progress-callback-function (label action current total)
+  (case current
+    (query
+     (let ((threshold (if (consp wl-display-progress-threshold)
+			  (cdr (or (assq label wl-display-progress-threshold)
+				   (assq t wl-display-progress-threshold)))
+			wl-display-progress-threshold)))
+       (and threshold
+	    (>= total threshold))))
+    (start
+     (message "%s..." action))
+    (done
+     (message "%s...done" action))
+    (t
+     (when wl-display-progress-function
+       (funcall wl-display-progress-function label action current total)))))
+
+;; 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 'completing-read-multiple)))
+
+
+(cond
+ ((fboundp 'shell-command-read-minibuffer)
+  (defun wl-read-shell-command (prompt &optional
+				       initial-contents keymap read hist)
+    (shell-command-read-minibuffer prompt default-directory
+				   initial-contents keymap read hist)))
+ (t
+  (defalias 'wl-read-shell-command 'read-from-minibuffer)))
+
 (require 'product)
 (product-provide (provide 'wl-util) (require 'wl-version))