(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
(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)
;;(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)
+(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."
+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)))
(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 ?\ ))))
(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))
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)))
(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)))))))
+ (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))
(defalias 'wl-string 'elmo-string)
(make-obsolete 'wl-string 'elmo-string)
-;; 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.
(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)))
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-buffer)))
+(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)
+ (car (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
(defun wl-collect-draft ()
(let ((draft-regexp (concat
- "^" (regexp-quote
- (elmo-localdir-folder-directory-internal
- (wl-folder-get-elmo-folder wl-draft-folder)))))
+ "^" (regexp-quote wl-draft-folder)))
result buf)
(mapcar
(function (lambda (x)
- (if (and
- (setq buf (with-current-buffer x
- wl-draft-buffer-file-name))
- (string-match draft-regexp buf))
+ (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))
+(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 msg)))
+
(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)
(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 ()
(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
(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))))
(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.
(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))
(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))))))
(defun wl-biff-check-folder (folder)
(if (eq (elmo-folder-type-internal folder) 'pop3)
- (unless (elmo-pop3-get-session folder 'if-exists)
+ (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)
(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)))
(concat open-paren (mapconcat 'regexp-quote strings "\\|")
close-paren))))
-(defun wl-expand-newtext (newtext original)
- (let ((len (length newtext))
- (pos 0)
- c expanded beg N did-expand)
- (while (< pos len)
- (setq beg pos)
- (while (and (< pos len)
- (not (= (aref newtext pos) ?\\)))
- (setq pos (1+ pos)))
- (unless (= beg pos)
- (push (substring newtext beg pos) expanded))
- (when (< pos len)
- ;; We hit a \; expand it.
- (setq did-expand t
- pos (1+ pos)
- c (aref newtext pos))
- (if (not (or (= c ?\&)
- (and (>= c ?1)
- (<= c ?9))))
- ;; \ followed by some character we don't expand.
- (push (char-to-string c) expanded)
- ;; \& or \N
- (if (= c ?\&)
- (setq N 0)
- (setq N (- c ?0)))
- (when (match-beginning N)
- (push (substring original (match-beginning N) (match-end N))
- expanded))))
- (setq pos (1+ pos)))
- (if did-expand
- (apply (function concat) (nreverse expanded))
- newtext)))
+(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)
(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))))))
+
(require 'product)
(product-provide (provide 'wl-util) (require 'wl-version))