X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-util.el;h=bfc84c34acea06bf390be82b37c7eec37f4f7f42;hb=54340051deb1c71b4618ea5b7e3d4fed9f8d259c;hp=572b29bc54a0aadea0412cb92461589a85fadde0;hpb=40337176666b09aef0b7c9b5b8ac0fe97ef94581;p=elisp%2Fwanderlust.git diff --git a/wl/wl-util.el b/wl/wl-util.el index 572b29b..bfc84c3 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -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)) @@ -207,7 +207,7 @@ even when invalid character is contained." (concat string paddings))))) (t (elmo-set-work-buf - (elmo-set-buffer-multibyte default-enable-multibyte-characters) + (set-buffer-multibyte default-enable-multibyte-characters) (insert string) (when (> (current-column) (abs width)) (when (> (move-to-column (abs width)) (abs width)) @@ -346,14 +346,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))) @@ -542,9 +534,13 @@ that `read' can handle, whenever this is possible." (defun wl-current-message-buffer () (when (buffer-live-p wl-current-summary-buffer) (with-current-buffer wl-current-summary-buffer - (car (wl-message-buffer-display wl-summary-buffer-elmo-folder - (wl-summary-message-number) - 'mime))))) + (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 @@ -582,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)) @@ -711,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 @@ -723,13 +757,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)))) @@ -737,14 +769,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. @@ -802,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)) @@ -840,7 +882,8 @@ This function is imported from Emacs 20.7." (while 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)))))) @@ -870,23 +913,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) - (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))))) + (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))) @@ -906,9 +952,14 @@ is enclosed by at least one regexp grouping construct." (defun wl-region-exists-p () "Return non-nil if a region exists on current buffer." (static-if (featurep 'xemacs) - (and zmacs-regions zmacs-region-active-p) + (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." @@ -992,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))