;;; Code:
;;
(require 'bytecomp)
-(eval-when-compile
- (require 'elmo-util))
+(require 'elmo-util)
+(require 'elmo-flag)
(condition-case nil (require 'pp) (error nil))
(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
(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,
(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)
(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)
- nil nil)))))))
+ (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
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 ()
+ "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)
(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
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))))
(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))
(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)
(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"
+ "Larger" "Smaller")))
+ (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
+ '(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)))))
+
+
+;; 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))
projects / elisp / wanderlust.git / blobdiff