+ "Call `wl-load-profile-function' function."
+ (funcall wl-load-profile-function))
+
+;;;
+
+(defmacro wl-count-lines ()
+ (` (save-excursion
+ (beginning-of-line)
+ (count-lines 1 (point)))))
+
+(defun wl-horizontal-recenter ()
+ "Recenter the current buffer horizontally."
+ (beginning-of-line)
+ (re-search-forward "[[<]" (point-at-eol) t)
+ (if (< (current-column) (/ (window-width) 2))
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
+ (let* ((orig (point))
+ (end (window-end (get-buffer-window (current-buffer) t)))
+ (max 0))
+ (when end
+ ;; Find the longest line currently displayed in the window.
+ (goto-char (window-start))
+ (while (and (not (eobp))
+ (< (point) end))
+ (end-of-line)
+ (setq max (max max (current-column)))
+ (forward-line 1))
+ (goto-char orig)
+ ;; Scroll horizontally to center (sort of) the point.
+ (if (> max (window-width))
+ (set-window-hscroll
+ (get-buffer-window (current-buffer) t)
+ (min (- (current-column) (/ (window-width) 3))
+ (+ 2 (- max (window-width)))))
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
+ max))))
+
+;; Biff
+(static-cond
+ (wl-on-xemacs
+ (defvar wl-biff-timer-name "wl-biff")
+
+ (defun wl-biff-stop ()
+ (when (get-itimer wl-biff-timer-name)
+ (delete-itimer wl-biff-timer-name)))
+
+ (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))
+
+ (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
+ (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.
+More precisely, the next value, after TIME, that is an integral multiple
+of SECS seconds since the epoch. SECS may be a fraction.
+This function is imported from Emacs 20.7."
+ (let ((time-base (ash 1 16)))
+ (if (fboundp 'atan)
+ ;; Use floating point, taking care to not lose precision.
+ (let* ((float-time-base (float time-base))
+ (million 1000000.0)
+ (time-usec (+ (* million
+ (+ (* float-time-base (nth 0 time))
+ (nth 1 time)))
+ (nth 2 time)))
+ (secs-usec (* million secs))
+ (mod-usec (mod time-usec secs-usec))
+ (next-usec (+ (- time-usec mod-usec) secs-usec))
+ (time-base-million (* float-time-base million)))
+ (list (floor next-usec time-base-million)
+ (floor (mod next-usec time-base-million) million)
+ (floor (mod next-usec million))))
+ ;; Floating point is not supported.
+ ;; Use integer arithmetic, avoiding overflow if possible.
+ (let* ((mod-sec (mod (+ (* (mod time-base secs)
+ (mod (nth 0 time) secs))
+ (nth 1 time))
+ secs))
+ (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
+ (list (+ (nth 0 time) (floor next-1-sec time-base))
+ (mod next-1-sec time-base)
+ 0)))))
+
+ (defun wl-biff-event-handler ()
+ ;; PAKURing from FSF:time.el
+ (wl-biff-check-folders)
+ ;; Do redisplay right now, if no input pending.
+ (sit-for 0)
+ (let* ((current (current-time))
+ (timer (get 'wl-biff 'timer))
+ ;; Compute the time when this timer will run again, next.
+ (next-time (timer-relative-time
+ (list (aref timer 1) (aref timer 2) (aref timer 3))
+ (* 5 (aref timer 4)) 0)))
+ ;; If the activation time is far in the past,
+ ;; skip executions until we reach a time in the future.
+ ;; This avoids a long pause if Emacs has been suspended for hours.
+ (or (> (nth 0 next-time) (nth 0 current))
+ (and (= (nth 0 next-time) (nth 0 current))
+ (> (nth 1 next-time) (nth 1 current)))
+ (and (= (nth 0 next-time) (nth 0 current))
+ (= (nth 1 next-time) (nth 1 current))
+ (> (nth 2 next-time) (nth 2 current)))
+ (progn
+ (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)))
+
+(defsubst wl-biff-notify (new-mails notify-minibuf)
+ (when (and (not wl-modeline-biff-status) (> new-mails 0))
+ (run-hooks 'wl-biff-notify-hook))
+ (when (and wl-modeline-biff-status (eq new-mails 0))
+ (run-hooks 'wl-biff-unnotify-hook))
+ (setq wl-modeline-biff-status (> new-mails 0))
+ (force-mode-line-update t)
+ (when notify-minibuf
+ (cond ((zerop new-mails) (message "No mail."))
+ ((= 1 new-mails) (message "You have a new mail."))
+ (t (message "You have %d new mails." new-mails)))))
+
+;; Internal variable.
+(defvar wl-biff-check-folders-running nil)
+
+(defun wl-biff-check-folders ()
+ (interactive)
+ (if wl-biff-check-folders-running
+ (when (interactive-p)
+ (message "Biff process is running."))
+ (setq wl-biff-check-folders-running t)
+ (when (interactive-p)
+ (message "Checking new mails..."))
+ (let ((new-mails 0)
+ (flist (or wl-biff-check-folder-list (list wl-default-folder)))
+ folder)
+ (if (eq (length flist) 1)
+ (wl-biff-check-folder-async (wl-folder-get-elmo-folder
+ (car flist) 'biff) (interactive-p))
+ (unwind-protect
+ (while flist
+ (setq folder (wl-folder-get-elmo-folder (car flist))
+ flist (cdr flist))
+ (when (elmo-folder-plugged-p folder)
+ (setq new-mails
+ (+ new-mails
+ (nth 0 (wl-biff-check-folder folder))))))
+ (setq wl-biff-check-folders-running nil)
+ (wl-biff-notify new-mails (interactive-p)))))))
+
+(defun wl-biff-check-folder (folder)
+ (if (eq (elmo-folder-type-internal folder) 'pop3)
+ (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)
+ 'biff)))
+
+(defun wl-biff-check-folder-async-callback (diff data)
+ (if (nth 1 data)
+ (with-current-buffer (nth 1 data)
+ (wl-folder-entity-hashtb-set wl-folder-entity-hashtb
+ (nth 0 data)
+ (list (nth 0 diff)
+ (- (nth 1 diff) (nth 0 diff))
+ (nth 2 diff))
+ (current-buffer))))
+ (setq wl-folder-info-alist-modified t)
+ (setq wl-biff-check-folders-running nil)
+ (sit-for 0)
+ (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 (fboundp 'regexp-opt)
+ (not (featurep 'xemacs)))
+ (defalias 'wl-regexp-opt 'regexp-opt)
+ (defun wl-regexp-opt (strings &optional paren)
+ "Return a regexp to match a string in STRINGS.
+Each string should be unique in STRINGS and should not contain any regexps,
+quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
+is enclosed by at least one regexp grouping construct."
+ (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" "")))
+ (concat open-paren (mapconcat 'regexp-quote strings "\\|")
+ close-paren))))
+
+(defalias 'wl-expand-newtext 'elmo-expand-newtext)
+
+(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)
+ (and transient-mark-mode mark-active)))
+
+(defvar wl-line-string)
+(defun wl-line-parse-format (format spec-alist)
+ "Make a formatter from FORMAT and SPEC-ALIST."
+ (let (f spec specs stack)
+ (setq f
+ (with-temp-buffer
+ (insert format)
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (cond
+ ((looking-at "%")
+ (goto-char (match-end 0)))
+ ((looking-at "\\(-?\\(0?\\)[0-9]*\\)\\([^0-9]\\)")
+ (cond
+ ((string= (match-string 3) "(")
+ (if (zerop (length (match-string 1)))
+ (error "No number specification for %%( line format"))
+ (push (list
+ (match-beginning 0) ; start
+ (match-end 0) ; start-content
+ (string-to-number
+ (match-string 1)) ; width
+ specs) ; specs
+ stack)
+ (setq specs nil))
+ ((string= (match-string 3) ")")
+ (let ((entry (pop stack))
+ form)
+ (unless entry
+ (error
+ "No matching %%( parenthesis in summary line format"))
+ (goto-char (car entry)) ; start
+ (setq form (buffer-substring (nth 1 entry) ; start-content
+ (- (match-beginning 0) 1)))
+ (delete-region (car entry) (match-end 0))
+ (insert "s")
+ (setq specs
+ (append
+ (nth 3 entry)
+ (list (list 'wl-set-string-width (nth 2 entry)
+ (append
+ (list 'format form)
+ specs)))))))
+ (t
+ (setq spec
+ (if (setq spec (assq (string-to-char (match-string 3))
+ spec-alist))
+ (nth 1 spec)
+ (match-string 3)))
+ (unless (string= "" (match-string 1))
+ (setq spec (list 'wl-set-string-width
+ (string-to-number (match-string 1))
+ spec
+ (unless (string= "" (match-string 2))
+ (string-to-char (match-string 2))))))
+ (replace-match "s" 'fixed)
+ (setq specs (append specs
+ (list
+ (list
+ 'setq 'wl-line-string
+ spec)))))))))
+ (buffer-string)))
+ (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*")))))
+
+(require 'product)
+(product-provide (provide 'wl-util) (require 'wl-version))