* wl-util.el (wl-read-search-condition-internal): Protect
[elisp/wanderlust.git] / wl / wl-util.el
index 4da1a9b..bfc84c3 100644 (file)
@@ -33,8 +33,8 @@
 ;;; Code:
 ;;
 (require 'bytecomp)
-(eval-when-compile
-  (require 'elmo-util))
+(require 'elmo-util)
+(require 'elmo-flag)
 
 (condition-case nil (require 'pp) (error nil))
 
@@ -536,9 +536,11 @@ that `read' can handle, whenever this is possible."
     (with-current-buffer wl-current-summary-buffer
       (or wl-message-buffer
          (and (wl-summary-message-number)
-              (car (wl-message-buffer-display wl-summary-buffer-elmo-folder
-                                              (wl-summary-message-number)
-                                              'mime)))))))
+              (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
@@ -576,6 +578,16 @@ that `read' can handle, whenever this is possible."
      (buffer-list))
     result))
 
+(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 ""))))
+
 (static-if (fboundp 'read-directory-name)
     (defun wl-read-directory-name (prompt dir)
       (read-directory-name prompt dir dir))
@@ -705,6 +717,34 @@ that `read' can handle, whenever this is possible."
          (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
        max))))
 
+;; Draft auto-save
+(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)))))
+ (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)))))))
+
 ;; Biff
 (static-cond
  (wl-on-xemacs
@@ -721,9 +761,7 @@ that `read' can handle, whenever this is possible."
                    wl-biff-check-interval wl-biff-check-interval
                    wl-biff-use-idle-timer))))
 
- ((and (condition-case nil (require 'timer) (error nil));; FSFmacs 19+
-       (fboundp 'timer-activate))
-
+ (t
   (defun wl-biff-stop ()
     (when (get 'wl-biff 'timer)
       (cancel-timer (get 'wl-biff 'timer))))
@@ -809,10 +847,7 @@ 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))
@@ -879,7 +914,7 @@ This function is imported from Emacs 20.7."
 
 (defun wl-biff-check-folder-async (folder notify-minibuf)
   (if (and (elmo-folder-plugged-p folder)
-          (elmo-folder-exists-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)
@@ -1008,6 +1043,72 @@ is enclosed by at least one regexp grouping construct."
           (with-current-buffer src
             (symbol-value variable))))))
 
+;;; Search Condition
+(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)
+        (denial-fields (nconc (mapcar 'capitalize elmo-msgdb-extra-fields)
+                              '("Flag" "Since" "Before"
+                                "From" "Subject" "To" "Cc" "Body" "ToCc")))
+        (field (completing-read
+                (format "%s (%s): " prompt default)
+                (mapcar 'list
+                        (append '("AND" "OR" "Last" "First")
+                                denial-fields
+                                (mapcar (lambda (f) (concat "!" f))
+                                        denial-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
+                               elmo-global-flags
+                               '(unread answered forwarded digest any))
+                              #'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)))))
+
 (require 'product)
 (product-provide (provide 'wl-util) (require 'wl-version))