From 611e65df06434b52b0472948501a37489c61f694 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 18 Sep 2000 13:24:44 +0000 Subject: [PATCH] Biff support. * wl/wl.el (wl): Call `wl-biff-start'. (wl-exit): Call `wl-biff-stop'. (wl-plugged-mode): Show biff in modeline. (wl-unplugged-glyph, wl-unplugged-glyph): Removed. * wl/wl-xmas.el (wl-draft-overload-functions): Show biff in modeline. (wl-biff-init-icons): New function. (wl-plugged-init-icons): Don't make too much keymaps. (wl-biff-nomail-glyph, wl-biff-mail-glyph): New variables. * wl/wl-vars.el (wl-biff-nomail-icon, wl-biff-mail-icon, wl-biff-state-indicator-off, wl-biff-state-indicator-on): New variables. (wl-biff-check-interval, wl-biff-check-folder-list): New user options. * wl/wl-util.el (wl-biff-check-folders, wl-biff-event-handler, wl-biff-start, wl-biff-stop): New functions. (timer-next-integral-multiple-of-time): Defined with `defun-meybe'. (wl-biff-timer-name): New variable. * wl/wl-summary.el (wl-summary-mode): Show biff in modeline. * wl/wl-nemacs.el (wl-draft-overload-functions): Show biff in modeline. (wl-plugged-init-icons, wl-folder-init-icons): Removed. * wl/wl-mule.el (wl-draft-overload-functions): Show biff in modeline. (wl-plugged-init-icons, wl-folder-init-icons): Removed. * wl/wl-folder.el (wl-make-plugged-alist): Call `wl-biff-init-icons'. (TopLevel): Bind `wl-biff-init-icons', `wl-plugged-init-icons' and `wl-folder-init-icons' to `ignore' if they are not available. (wl-folder-mode): Show biff in modeline. * wl/wl-e21.el (wl-draft-overload-functions): Show biff in modeline. (wl-biff-init-icons): New function. (wl-plugged-init-icons): Don't make too much keymaps. (wl-biff-nomail-image, wl-biff-mail-image): New variables. * etc/icons/letter.xpm, etc/icons/no-letter.xpm: New files. --- ChangeLog | 4 + etc/icons/letter.xpm | 20 +++++ etc/icons/no-letter.xpm | 20 +++++ wl/ChangeLog | 44 ++++++++++- wl/wl-e21.el | 85 ++++++++++++++------- wl/wl-folder.el | 188 ++++++++++++++++++++++++--------------------- wl/wl-mule.el | 17 +++-- wl/wl-nemacs.el | 21 ++--- wl/wl-summary.el | 195 ++++++++++++++++++++++++----------------------- wl/wl-util.el | 141 ++++++++++++++++++++++++++++++---- wl/wl-vars.el | 31 ++++++-- wl/wl-xmas.el | 76 +++++++++++------- wl/wl.el | 31 ++++---- 13 files changed, 582 insertions(+), 291 deletions(-) create mode 100644 etc/icons/letter.xpm create mode 100644 etc/icons/no-letter.xpm diff --git a/ChangeLog b/ChangeLog index 62cd3a7..6b2f47e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2000-09-18 Katsumi Yamaoka + + * etc/icons/letter.xpm, etc/icons/no-letter.xpm: New files. + 2000-09-15 TAKAHASHI Kaoru * utils/ptexinfmt.el (texinfo-multitable-widths): Add diff --git a/etc/icons/letter.xpm b/etc/icons/letter.xpm new file mode 100644 index 0000000..ee6b5fc --- /dev/null +++ b/etc/icons/letter.xpm @@ -0,0 +1,20 @@ +/* XPM */ +static char * jmail_xpm[] = { +"18 13 4 1", +" s None c None", +". c gray85", +"X c yellow", +"o c black", +" ", +" ", +" .XXXXXXXXXXX. ", +" XoXXXXXXXXXoXoo", +" XXoXXXXXXXoXXoo", +" XXXoXXXXXoXXXoo", +" XXX.oXXXo.XXXoo", +" XXXo.oXo.oXXXoo", +" XXoXXXoXXXoXXoo", +" XoXXXXXXXXXoXoo", +" .XXXXXXXXXXX.oo", +" ooooooooooooo", +" ooooooooooooo"}; diff --git a/etc/icons/no-letter.xpm b/etc/icons/no-letter.xpm new file mode 100644 index 0000000..72e8880 --- /dev/null +++ b/etc/icons/no-letter.xpm @@ -0,0 +1,20 @@ +/* XPM */ +static char * jmail_xpm[] = { +"18 13 4 1", +" s None c None", +". c gray55", +"o c black", +"x c gray95", +" ", +" ", +" ooooooooooooox ", +" o.xxxxxxxxx.ox ", +" oxox oxox ", +" ox ox ox ox ", +" ox ox ox ox ", +" ox oxoxoxox ox ", +" oxox ox oxox ", +" o.x .ox ", +" ooooooooooooox ", +" xxxxxxxxxxxxxx ", +" "}; diff --git a/wl/ChangeLog b/wl/ChangeLog index 35becf3..bc4ea63 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,8 +1,50 @@ +2000-09-18 A. SAGATA + Katsumi Yamaoka + + * wl.el (wl): Call `wl-biff-start'. + (wl-exit): Call `wl-biff-stop'. + (wl-plugged-mode): Show biff in modeline. + (wl-unplugged-glyph, wl-unplugged-glyph): Removed. + + * wl-xmas.el (wl-draft-overload-functions): Show biff in modeline. + (wl-biff-init-icons): New function. + (wl-plugged-init-icons): Don't make too much keymaps. + (wl-biff-nomail-glyph, wl-biff-mail-glyph): New variables. + + * wl-vars.el (wl-biff-nomail-icon, wl-biff-mail-icon, + wl-biff-state-indicator-off, wl-biff-state-indicator-on): New + variables. + (wl-biff-check-interval, wl-biff-check-folder-list): New user + options. + + * wl-util.el (wl-biff-check-folders, wl-biff-event-handler, + wl-biff-start, wl-biff-stop): New functions. + (timer-next-integral-multiple-of-time): Defined with `defun-meybe'. + (wl-biff-timer-name): New variable. + + * wl-summary.el (wl-summary-mode): Show biff in modeline. + + * wl-nemacs.el (wl-draft-overload-functions): Show biff in modeline. + (wl-plugged-init-icons, wl-folder-init-icons): Removed. + + * wl-mule.el (wl-draft-overload-functions): Show biff in modeline. + (wl-plugged-init-icons, wl-folder-init-icons): Removed. + + * wl-folder.el (wl-make-plugged-alist): Call `wl-biff-init-icons'. + (TopLevel): Bind `wl-biff-init-icons', `wl-plugged-init-icons' and + `wl-folder-init-icons' to `ignore' if they are not available. + (wl-folder-mode): Show biff in modeline. + + * wl-e21.el (wl-draft-overload-functions): Show biff in modeline. + (wl-biff-init-icons): New function. + (wl-plugged-init-icons): Don't make too much keymaps. + (wl-biff-nomail-image, wl-biff-mail-image): New variables. + 2000-09-15 OKAZAKI Tetsurou * wl-vars.el (wl-strict-diff-folders): Customization Type and doc fix. Define as a list of regular expressions for - folders or nil. + folders or nil. * wl-folder.el (wl-folder-check-one-entity): Use `wl-string-match-member' instead of `wl-string-member' for `wl-strict-diff-folders'. diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 1aea9e5..ed0945f 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -42,6 +42,8 @@ (image-type-available-p 'xpm))) (defvar wl-plugged-image nil) (defvar wl-unplugged-image nil) +(defvar wl-biff-mail-image nil) +(defvar wl-biff-nomail-image nil) (defvar wl-folder-toolbar '([wl-folder-jump-to-current-entity @@ -428,27 +430,54 @@ :file ,name :ascent center)))))))))) (defun wl-plugged-init-icons () - (unless wl-plugged-image - (setq wl-plug-state-indicator-on (concat "[" wl-plugged-plug-on "]") - wl-plugged-image (wl-e21-make-icon-image - wl-plug-state-indicator-on - wl-plugged-icon))) - (unless wl-unplugged-image - (setq wl-plug-state-indicator-off (concat "[" wl-plugged-plug-off "]") - wl-unplugged-image (wl-e21-make-icon-image - wl-plug-state-indicator-off - wl-unplugged-icon))) - (let ((props (list 'local-map (purecopy (make-mode-line-mouse2-map - #'wl-toggle-plugged)) - 'help-echo "mouse-2 toggles plugged status"))) - (add-text-properties 0 (length wl-plug-state-indicator-on) - (nconc props (unless (stringp wl-plugged-image) - (list 'display wl-plugged-image))) - wl-plug-state-indicator-on) - (add-text-properties 0 (length wl-plug-state-indicator-off) - (nconc props (unless (stringp wl-unplugged-image) - (list 'display wl-unplugged-image))) - wl-plug-state-indicator-off))) + (let ((props (unless (or wl-plugged-image wl-unplugged-image) + (list 'local-map (purecopy (make-mode-line-mouse2-map + #'wl-toggle-plugged)) + 'help-echo "mouse-2 toggles plugged status")))) + (unless wl-plugged-image + (setq wl-plug-state-indicator-on (concat "[" wl-plugged-plug-on "]") + wl-plugged-image (wl-e21-make-icon-image + wl-plug-state-indicator-on + wl-plugged-icon)) + (add-text-properties 0 (length wl-plug-state-indicator-on) + (nconc props (unless (stringp wl-plugged-image) + (list 'display wl-plugged-image))) + wl-plug-state-indicator-on)) + (unless wl-unplugged-image + (setq wl-plug-state-indicator-off (concat "[" wl-plugged-plug-off "]") + wl-unplugged-image (wl-e21-make-icon-image + wl-plug-state-indicator-off + wl-unplugged-icon)) + (add-text-properties 0 (length wl-plug-state-indicator-off) + (nconc props (unless (stringp wl-unplugged-image) + (list 'display wl-unplugged-image))) + wl-plug-state-indicator-off)))) + +(defun wl-biff-init-icons () + (let ((props (unless (or wl-biff-mail-image wl-biff-nomail-image) + (list 'local-map (purecopy + (make-mode-line-mouse2-map + (lambda nil + (call-interactively + 'wl-biff-check-folders)))) + 'help-echo "mouse-2 checks new mails")))) + (unless wl-biff-mail-image + (setq wl-biff-mail-image (wl-e21-make-icon-image + wl-biff-state-indicator-on + wl-biff-mail-icon)) + (add-text-properties 0 (length wl-biff-state-indicator-on) + (nconc props (unless (stringp wl-biff-mail-image) + (list 'display wl-biff-mail-image))) + wl-biff-state-indicator-on)) + (unless wl-biff-nomail-image + (setq wl-biff-nomail-image (wl-e21-make-icon-image + wl-biff-state-indicator-off + wl-biff-nomail-icon)) + (add-text-properties 0 (length wl-biff-state-indicator-off) + (nconc props (unless (stringp wl-biff-nomail-image) + (list 'display + wl-biff-nomail-image))) + wl-biff-state-indicator-off)))) (defun wl-make-date-string () (format-time-string "%a, %d %b %Y %T %z")) @@ -542,11 +571,15 @@ Special commands: (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)) (defun wl-draft-overload-functions () - (setq mode-line-buffer-identification - (wl-mode-line-buffer-identification - (if wl-show-plug-status-on-modeline - '("" wl-plug-state-indicator "Wanderlust: %12b") - '("Wanderlust: %12b")))) + (let ((id '("Wanderlust: %12b"))) + (when wl-show-plug-status-on-modeline + (wl-push 'wl-plug-state-indicator id)) + (when wl-biff-check-folder-list + (wl-push 'wl-biff-state-indicator id)) + (when (cdr id) + (wl-push "" id)) + (setq mode-line-buffer-identification + (wl-mode-line-buffer-identification id))) (local-set-key "\C-c\C-s" 'wl-draft-send);; override (wl-e21-setup-draft-toolbar) (wl-draft-overload-menubar)) diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 2c5d969..0f3f198 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'elmo-vars) (require 'elmo-util) @@ -388,9 +388,9 @@ (setq entity (wl-pop entities)) (cond ((consp entity) -;; (if (and (string= name (car entity)) -;; (eq id (wl-folder-get-entity-id (car entity)))) -;; (throw 'done last-entity)) +;; (if (and (string= name (car entity)) +;; (eq id (wl-folder-get-entity-id (car entity)))) +;; (throw 'done last-entity)) (and entities (wl-push entities entity-stack)) (setq entities (nth 2 entity))) @@ -418,9 +418,9 @@ (setq entity (wl-pop entities)) (cond ((consp entity) -;; (if (and (string= name (car entity)) -;; (eq id (wl-folder-get-entity-id (car entity)))) -;; (setq found t)) +;; (if (and (string= name (car entity)) +;; (eq id (wl-folder-get-entity-id (car entity)))) +;; (setq found t)) (and entities (wl-push entities entity-stack)) (setq entities (nth 2 entity))) @@ -670,50 +670,50 @@ Optional argument ARG is repeart count." (cond ((string= (wl-match-buffer 2) "+") (save-excursion - (if entity () - (setq entity - (wl-folder-search-group-entity-by-name - (wl-folder-get-realname (wl-match-buffer 3)) - wl-folder-entity))) - (let ((inhibit-read-only t) - (entities (list entity)) - entity-stack err indent) - (while (and entities (not err)) - (setq entity (wl-pop entities)) - (cond - ((consp entity) - (wl-folder-close-entity entity) - (setcdr (assoc (car entity) wl-folder-group-alist) t) - (unless (wl-folder-buffer-search-group - (wl-folder-get-petname (car entity))) - (error "%s: not found group" (car entity))) - (setq indent (wl-match-buffer 1)) - (if (eq 'access (cadr entity)) - (wl-folder-maybe-load-folder-list entity)) - (beginning-of-line) - (setq err nil) - (save-excursion - (condition-case errobj - (wl-folder-update-newest indent entity) - (quit - (setq err t) - (setcdr (assoc (car entity) wl-folder-group-alist) nil)) - (error - (elmo-display-error errobj t) - (ding) - (setq err t) - (setcdr (assoc (car entity) wl-folder-group-alist) nil))) - (if (not err) - (delete-region (save-excursion (beginning-of-line) - (point)) - (save-excursion (end-of-line) - (+ 1 (point)))))) - ;; - (and entities - (wl-push entities entity-stack)) - (setq entities (nth 2 entity)))) - (unless entities - (setq entities (wl-pop entity-stack))))) + (if entity () + (setq entity + (wl-folder-search-group-entity-by-name + (wl-folder-get-realname (wl-match-buffer 3)) + wl-folder-entity))) + (let ((inhibit-read-only t) + (entities (list entity)) + entity-stack err indent) + (while (and entities (not err)) + (setq entity (wl-pop entities)) + (cond + ((consp entity) + (wl-folder-close-entity entity) + (setcdr (assoc (car entity) wl-folder-group-alist) t) + (unless (wl-folder-buffer-search-group + (wl-folder-get-petname (car entity))) + (error "%s: not found group" (car entity))) + (setq indent (wl-match-buffer 1)) + (if (eq 'access (cadr entity)) + (wl-folder-maybe-load-folder-list entity)) + (beginning-of-line) + (setq err nil) + (save-excursion + (condition-case errobj + (wl-folder-update-newest indent entity) + (quit + (setq err t) + (setcdr (assoc (car entity) wl-folder-group-alist) nil)) + (error + (elmo-display-error errobj t) + (ding) + (setq err t) + (setcdr (assoc (car entity) wl-folder-group-alist) nil))) + (if (not err) + (delete-region (save-excursion (beginning-of-line) + (point)) + (save-excursion (end-of-line) + (+ 1 (point)))))) + ;; + (and entities + (wl-push entities entity-stack)) + (setq entities (nth 2 entity)))) + (unless entities + (setq entities (wl-pop entity-stack))))) (set-buffer-modified-p nil))) (t (wl-folder-jump-to-current-entity))))) @@ -1409,11 +1409,15 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (setq wl-folder-buffer-cur-entity-id nil wl-folder-buffer-cur-path nil wl-folder-buffer-cur-point nil) - (setq mode-line-buffer-identification - (wl-mode-line-buffer-identification - (if wl-show-plug-status-on-modeline - '("" wl-plug-state-indicator "Wanderlust: %12b") - '("Wanderlust: %12b")))) + (let ((id '("Wanderlust: %12b"))) + (when wl-show-plug-status-on-modeline + (wl-push 'wl-plug-state-indicator id)) + (when wl-biff-check-folder-list + (wl-push 'wl-biff-state-indicator id)) + (when (cdr id) + (wl-push "" id)) + (setq mode-line-buffer-identification + (wl-mode-line-buffer-identification id))) (easy-menu-add wl-folder-mode-menu) (cond (wl-on-xemacs (wl-xmas-setup-folder)) @@ -1432,6 +1436,10 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (wl-append wl-folder-petname-alist (list (cons realname petname))))) +(eval-and-compile + (unless (or wl-on-xemacs wl-on-emacs21) + (defalias 'wl-folder-init-icons 'ignore))) + (defun wl-folder (&optional arg) (interactive "P") (let (initialize) @@ -1480,11 +1488,11 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (if (setq buf (get-buffer wl-folder-buffer-name)) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb name value buf)) -;; (elmo-folder-set-info-hashtb (elmo-string name) -;; nil -;; (nth 2 value) -;; (nth 0 value) -;; (nth 1 value)) +;; (elmo-folder-set-info-hashtb (elmo-string name) +;; nil +;; (nth 2 value) +;; (nth 0 value) +;; (nth 1 value)) (setq wl-folder-info-alist-modified t)))) (defun wl-folder-calc-finfo (entity) @@ -1795,31 +1803,31 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." hashtb)) ;; Unsync number is reserved. -;; (defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name) -;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id))) -;; (entities (list entity)) -;; entity-stack) -;; (while entities -;; (setq entity (wl-pop entities)) -;; (cond -;; ((consp entity) -;; (if id-name -;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity)) -;; (car entity))) -;; (and entities -;; (wl-push entities entity-stack)) -;; (setq entities (nth 2 entity)) -;; ) -;; ((stringp entity) -;; (wl-folder-set-entity-info entity -;; (wl-folder-get-entity-info entity) -;; hashtb) -;; (if id-name -;; (wl-folder-set-id-name (wl-folder-get-entity-id entity) -;; entity)))) -;; (unless entities -;; (setq entities (wl-pop entity-stack)))) -;; hashtb)) +;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name) +;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id))) +;; (entities (list entity)) +;; entity-stack) +;; (while entities +;; (setq entity (wl-pop entities)) +;; (cond +;; ((consp entity) +;; (if id-name +;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity)) +;; (car entity))) +;; (and entities +;; (wl-push entities entity-stack)) +;; (setq entities (nth 2 entity)) +;; ) +;; ((stringp entity) +;; (wl-folder-set-entity-info entity +;; (wl-folder-get-entity-info entity) +;; hashtb) +;; (if id-name +;; (wl-folder-set-id-name (wl-folder-get-entity-id entity) +;; entity)))) +;; (unless entities +;; (setq entities (wl-pop entity-stack)))) +;; hashtb)) (defun wl-folder-create-newsgroups-from-nntp-access2 (entity) (let ((flist (nth 2 entity)) @@ -1943,6 +1951,11 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." wl-score-cache nil )) +(eval-and-compile + (unless (or wl-on-xemacs wl-on-emacs21) + (defalias 'wl-plugged-init-icons 'ignore) + (defalias 'wl-biff-init-icons 'ignore))) + (defun wl-make-plugged-alist () (let ((entity-list (wl-folder-get-entity-list wl-folder-entity)) (add (not wl-reset-plugged-alist))) @@ -1964,6 +1977,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." elmo-default-nntp-port nil nil "nntp" add)) (wl-plugged-init-icons) + (wl-biff-init-icons) ;; user setting (run-hooks 'wl-make-plugged-hook))) diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 7f11536..f121cc3 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -97,9 +97,6 @@ Special commands: (defun wl-plugged-set-folder-icon (folder string) string) -(defun wl-folder-init-icons ()) ; dummy. -(defun wl-plugged-init-icons ()) ; dummy. - (defun wl-message-overload-functions () (local-set-key "l" 'wl-message-toggle-disp-summary) (local-set-key [mouse-2] 'wl-message-refer-article-or-url) @@ -174,11 +171,15 @@ Special commands: '("FCC" . wl-draft-fcc))) (defun wl-draft-overload-functions () - (setq mode-line-buffer-identification - (wl-mode-line-buffer-identification - (if wl-show-plug-status-on-modeline - '("" wl-plug-state-indicator "Wanderlust: %12b") - '("Wanderlust: %12b")))) + (let ((id '("Wanderlust: %12b"))) + (when wl-show-plug-status-on-modeline + (wl-push 'wl-plug-state-indicator id)) + (when wl-biff-check-folder-list + (wl-push 'wl-biff-state-indicator id)) + (when (cdr id) + (wl-push "" id)) + (setq mode-line-buffer-identification + (wl-mode-line-buffer-identification id))) (local-set-key "\C-c\C-s" 'wl-draft-send) ; override (wl-draft-overload-menubar)) diff --git a/wl/wl-nemacs.el b/wl/wl-nemacs.el index e68d62d..cf7ef76 100644 --- a/wl/wl-nemacs.el +++ b/wl/wl-nemacs.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (defun wl-message-overload-functions () (local-set-key "l" 'wl-message-toggle-disp-summary)) @@ -50,9 +50,6 @@ (defun wl-plugged-set-folder-icon (folder string) string) -(defun wl-folder-init-icons ()) ; dummy. -(defun wl-plugged-init-icons ()) ; dummy. - (defmacro wl-defface (face spec doc &rest args) (` (defvar (, face) (, spec) (, doc)))) @@ -69,11 +66,15 @@ (list (cons t (mime-charset-to-coding-system default-mime-charset)))) (defun wl-draft-overload-functions () - (setq mode-line-buffer-identification - (wl-mode-line-buffer-identification - (if wl-show-plug-status-on-modeline - '("" wl-plug-state-indicator "Wanderlust: %12b") - '("Wanderlust: %12b")))) + (let ((id '("Wanderlust: %12b"))) + (if wl-show-plug-status-on-modeline + (wl-push 'wl-plug-state-indicator id)) + (if wl-biff-check-folder-list + (wl-push 'wl-biff-state-indicator id)) + (if (cdr id) + (wl-push "" id)) + (setq mode-line-buffer-identification + (wl-mode-line-buffer-identification id))) (local-set-key "\C-c\C-y" 'wl-draft-yank-original) (local-set-key "\C-c\C-s" 'wl-draft-send) (local-set-key "\C-c\C-a" 'wl-draft-insert-x-face-field) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 6e5f057..95089fd 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'elmo2) (require 'elmo-multi) @@ -42,7 +42,7 @@ (require 'easymenu)) (error)) (require 'elmo-date) - + (condition-case nil (require 'ps-print) (error)) @@ -378,7 +378,7 @@ (define-key wl-summary-mode-map "g" 'wl-summary-goto-folder) (define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all) (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync) - + (define-key wl-summary-mode-map "a" 'wl-summary-reply) (define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation) (define-key wl-summary-mode-map "C" 'wl-summary-cancel-message) @@ -407,14 +407,14 @@ (define-key wl-summary-mode-map "|" 'wl-summary-pipe-message) (define-key wl-summary-mode-map "q" 'wl-summary-exit) (define-key wl-summary-mode-map "Q" 'wl-summary-force-exit) - + (define-key wl-summary-mode-map "j" 'wl-summary-jump-to-current-message) (define-key wl-summary-mode-map "J" 'wl-thread-jump-to-msg) (define-key wl-summary-mode-map "I" 'wl-summary-incorporate) (define-key wl-summary-mode-map "\M-j" 'wl-summary-jump-to-msg-by-message-id) (define-key wl-summary-mode-map "^" 'wl-summary-jump-to-parent-message) (define-key wl-summary-mode-map "!" 'wl-summary-mark-as-unread) - + (define-key wl-summary-mode-map "s" 'wl-summary-sync) (define-key wl-summary-mode-map "S" 'wl-summary-sort) (define-key wl-summary-mode-map "\M-s" 'wl-summary-stick) @@ -478,7 +478,7 @@ (define-key wl-summary-mode-map "mA" 'wl-summary-target-mark-reply-with-citation) (define-key wl-summary-mode-map "mf" 'wl-summary-target-mark-forward) (define-key wl-summary-mode-map "m?" 'wl-summary-target-mark-pick) - + ;; region commands (define-key wl-summary-mode-map "r" (make-sparse-keymap)) (define-key wl-summary-mode-map "rR" 'wl-summary-mark-as-read-region) @@ -826,14 +826,17 @@ q Goto folder mode. (wl-xmas-setup-summary)) (wl-on-emacs21 (wl-e21-setup-summary))) - (setq mode-line-buffer-identification - (wl-mode-line-buffer-identification - (append - (if wl-show-plug-status-on-modeline - '("" wl-plug-state-indicator)) - '("Wanderlust: " - wl-summary-buffer-folder-indicator - wl-summary-buffer-unread-status)))) + (let ((id '("Wanderlust: " + wl-summary-buffer-folder-indicator + wl-summary-buffer-unread-status))) + (when wl-show-plug-status-on-modeline + (wl-push 'wl-plug-state-indicator id)) + (when wl-biff-check-folder-list + (wl-push 'wl-biff-state-indicator id)) + (when (or wl-show-plug-status-on-modeline wl-biff-check-folder-list) + (wl-push "" id)) + (setq mode-line-buffer-identification + (wl-mode-line-buffer-identification id))) (easy-menu-add wl-summary-mode-menu) (run-hooks 'wl-summary-mode-hook)) @@ -963,7 +966,7 @@ q Goto folder mode. (goto-char (point-max)) (forward-line -1) (set-buffer-modified-p nil))) - + (defun wl-summary-next-folder-or-exit (&optional next-entity upward) (if (and next-entity wl-auto-select-next) @@ -1046,11 +1049,11 @@ q Goto folder mode. (elmo-msgdb-mark-save path (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) -;; (elmo-folder-set-info-hashtb -;; (elmo-string wl-summary-buffer-folder-name) -;; nil nil -;; 0 -;; (+ wl-summary-buffer-new-count wl-summary-buffer-unread-count)) +;; (elmo-folder-set-info-hashtb +;; (elmo-string wl-summary-buffer-folder-name) +;; nil nil +;; 0 +;; (+ wl-summary-buffer-new-count wl-summary-buffer-unread-count)) ;; (setq wl-folder-info-alist-modified t) (setq wl-summary-buffer-mark-modified nil) (run-hooks 'wl-summary-buffer-mark-saved-hook)))))) @@ -1344,7 +1347,7 @@ Optional argument ADDR-STR is used as a target address if specified." ;; i'd like to update summary-buffer, but... ;;(wl-summary-rescan) (run-hooks 'wl-summary-edit-addresses-hook))))) - + (defun wl-summary-incorporate (&optional arg) "Check and prefetch all uncached messages. If optional argument is non-nil, checking is omitted." @@ -1572,7 +1575,7 @@ If optional argument is non-nil, checking is omitted." (mapcar (function (lambda (x) (wl-summary-unmark (car x)))) wl-summary-buffer-copy-list)) - + (defun wl-summary-delete-all-delete-marks () (mapcar 'wl-summary-unmark wl-summary-buffer-delete-list)) @@ -1796,7 +1799,7 @@ If optional argument is non-nil, checking is omitted." (if wl-summary-highlight (wl-highlight-summary-current-line nil nil t)) (set-buffer-modified-p nil))))))) - + (defun wl-summary-resume-cache-status () "Resume the cache status of all messages in the current folder." (interactive) @@ -2031,7 +2034,7 @@ If optional argument is non-nil, checking is omitted." (setq delete-list (delete (car dlist) delete-list))) (setq dlist (cdr dlist))) delete-list)) - + (defun wl-summary-get-append-message-func () (if (eq wl-summary-buffer-view 'thread) 'wl-summary-insert-thread-entity @@ -2696,7 +2699,7 @@ If optional argument is non-nil, checking is omitted." (if (not disp) (setq wl-summary-buffer-disp-msg nil)) (when (and (not disp) - (setq mes-win (wl-message-buffer-window))) + (setq mes-win (wl-message-buffer-window))) (delete-window mes-win) (run-hooks 'wl-summary-toggle-disp-off-hook)))) @@ -3280,7 +3283,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end) (wl-summary-mark-collect "D" beg end) (wl-summary-mark-collect "O" beg end)))) - + (defun wl-summary-exec-subr (moves dels copies) (if (not (or moves dels copies)) (message "No marks") @@ -3519,14 +3522,14 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (format "for %s" copy-or-refile))))) ;; Cache folder hack by okada@opaopa.org (if (and (eq (car (elmo-folder-get-spec folder)) 'cache) - (not (string= folder + (not (string= folder (setq tmp-folder (concat "'cache/" (elmo-cache-get-path-subr (elmo-msgid-to-cache msgid))))))) - (progn - (setq folder tmp-folder) - (message "Force refile to %s." folder))) + (progn + (setq folder tmp-folder) + (message "Force refile to %s." folder))) (if (string= folder wl-summary-buffer-folder-name) (error "Same folder")) (if (and @@ -3723,7 +3726,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." "Put copy mark on messages in the region specified by BEG and END." (interactive "r") (wl-summary-refile-region-subr "refile" beg end)) - + (defun wl-summary-copy-region (beg end) "Put copy mark on messages in the region specified by BEG and END." (interactive "r") @@ -3735,36 +3738,36 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (goto-char beg) ;; guess by first msg (let* ((msgid (cdr (assq (wl-summary-message-number) - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)))) + (elmo-msgdb-get-number-alist + wl-summary-buffer-msgdb)))) (function (intern (format "wl-summary-%s" copy-or-refile))) (entity (assoc msgid (elmo-msgdb-get-overview wl-summary-buffer-msgdb))) folder) - (if entity - (setq folder (wl-summary-read-folder (wl-refile-guess entity) - (format "for %s" + (if entity + (setq folder (wl-summary-read-folder (wl-refile-guess entity) + (format "for %s" copy-or-refile)))) - (narrow-to-region beg end) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...refile line. - (funcall function folder number) - ;; closed + (narrow-to-region beg end) + (if (eq wl-summary-buffer-view 'thread) + (progn + (while (not (eobp)) + (let* ((number (wl-summary-message-number)) + (entity (wl-thread-get-entity number)) + children) + (if (wl-thread-entity-get-opened entity) + ;; opened...refile line. + (funcall function folder number) + ;; closed (mapcar (function (lambda (x) (funcall function folder x))) (wl-thread-get-children-msgs number))) - (forward-line 1)))) - (while (not (eobp)) - (funcall function folder (wl-summary-message-number)) - (forward-line 1))))))) + (forward-line 1)))) + (while (not (eobp)) + (funcall function folder (wl-summary-message-number)) + (forward-line 1))))))) (defun wl-summary-unmark-region (beg end) (interactive "r") @@ -3962,7 +3965,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (if (null result) (message "No message was picked.") (wl-summary-target-mark-msgs result)))))) - + (defun wl-summary-unvirtual () "Exit from current virtual folder." (interactive) @@ -4008,7 +4011,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (setq wl-summary-buffer-delete-list nil) (setq wl-summary-buffer-refile-list nil) (setq wl-summary-buffer-copy-list nil))) - + (defun wl-summary-delete-mark (number) "Delete temporary mark of the message specified by NUMBER." (cond @@ -4539,7 +4542,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." wl-summary-default-number-column)) (setq wl-summary-buffer-number-regexp (wl-repeat-string "." wl-summary-buffer-number-column))))) - + (defsubst wl-summary-proc-wday (wday-str year month mday) (save-match-data (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str) @@ -4597,7 +4600,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." ;; ;; Goto unread or important -;; +;; (defun wl-summary-cursor-up (&optional hereto) (interactive "P") (if (and (not wl-summary-buffer-target-mark-list) @@ -4811,7 +4814,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (select-window (get-buffer-window cur-buf)))) ))))) (run-hooks 'wl-summary-toggle-disp-folder-hook)) - + (defun wl-summary-toggle-disp-msg (&optional arg) (interactive) (let (fld-buf fld-win @@ -4879,7 +4882,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (defun wl-summary-prev-page () (interactive) (wl-message-prev-page)) - + (defsubst wl-summary-no-mime-p (folder) (wl-string-match-member folder wl-summary-no-mime-folder-list)) @@ -4993,17 +4996,17 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." t) ;; for XEmacs! (if (and elmo-use-database - (setq errmsg - (format + (setq errmsg + (format "No message with id \"%s\" in the database." msgid)) - (setq otherfld (elmo-database-msgid-get msgid))) + (setq otherfld (elmo-database-msgid-get msgid))) (if (cdr (wl-summary-jump-to-msg-internal (car otherfld) (nth 1 otherfld) 'no-sync)) t ; succeed. ;; Back to original. (wl-summary-jump-to-msg-internal wl-summary-buffer-folder-name original 'no-sync)) - (cond ((eq wl-summary-search-via-nntp 'confirm) + (cond ((eq wl-summary-search-via-nntp 'confirm) (message "Search message in nntp server \"%s\" ?" elmo-default-nntp-server) (setq schar (read-char)) @@ -5017,15 +5020,15 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (message errmsg) nil))) (wl-summary-search-via-nntp - (wl-summary-jump-to-msg-by-message-id-via-nntp msgid)) - (t - (message errmsg) - nil)))))) + (wl-summary-jump-to-msg-by-message-id-via-nntp msgid)) + (t + (message errmsg) + nil)))))) (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec) (interactive) (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: ")))) - newsgroups folder ret + newsgroups folder ret user server port type spec) (if server-spec (if (string-match "^-" server-spec) @@ -5062,19 +5065,19 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid) (let (wl-auto-select-first entity) (if (or (string= folder wl-summary-buffer-folder-name) - (y-or-n-p - (format - "Message was found in the folder \"%s\". Jump to it? " - folder))) - (progn - (unwind-protect - (wl-summary-goto-folder-subr - folder scan-type nil nil t) - (if msgid - (setq msg - (car (rassoc msgid - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))))) + (y-or-n-p + (format + "Message was found in the folder \"%s\". Jump to it? " + folder))) + (progn + (unwind-protect + (wl-summary-goto-folder-subr + folder scan-type nil nil t) + (if msgid + (setq msg + (car (rassoc msgid + (elmo-msgdb-get-number-alist + wl-summary-buffer-msgdb))))) (setq entity (wl-folder-search-entity-by-name folder wl-folder-entity 'folder)) @@ -5158,7 +5161,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (t ; failed. (message "Parent message was not found.") nil))))) - + (defun wl-summary-reply (&optional arg without-setup-hook) "Reply to current message. Default is \"wide\" reply. Reply to author if invoked with argument." @@ -5561,7 +5564,7 @@ Reply to author if invoked with argument." (wl-highlight-summary-displaying) (run-hooks 'wl-summary-redisplay-hook)) (message "No message to display.")))) - + (defun wl-summary-jump-to-current-message () (interactive) (let (message-buf message-win) @@ -5620,11 +5623,11 @@ Reply to author if invoked with argument." "Supersede current message." (interactive) (let ((summary-buf (current-buffer)) - (mmelmo-force-fetch-entire-message t) - message-buf from) + (mmelmo-force-fetch-entire-message t) + message-buf from) (wl-summary-set-message-buffer-or-redisplay) (if (setq message-buf (wl-message-get-original-buffer)) - (set-buffer message-buf)) + (set-buffer message-buf)) (unless (wl-message-news-p) (error "This is not a news article; supersedes is impossible")) (save-excursion @@ -5633,16 +5636,16 @@ Reply to author if invoked with argument." (unless (wl-address-user-mail-address-p (wl-address-header-extract-address (car (wl-parse-addresses from)))) - (error "This article is not yours")) + (error "This article is not yours")) (let* ((message-id (std11-field-body "message-id")) - (followup-to (std11-field-body "followup-to")) - (mail-default-headers - (concat mail-default-headers - "Supersedes: " message-id "\n" - (and followup-to - (concat "Followup-To: " followup-to "\n"))))) - (set-buffer (wl-message-get-original-buffer)) - (wl-draft-edit-string (buffer-substring (point-min) (point-max))))))) + (followup-to (std11-field-body "followup-to")) + (mail-default-headers + (concat mail-default-headers + "Supersedes: " message-id "\n" + (and followup-to + (concat "Followup-To: " followup-to "\n"))))) + (set-buffer (wl-message-get-original-buffer)) + (wl-draft-edit-string (buffer-substring (point-min) (point-max))))))) (defun wl-summary-save (&optional arg wl-save-dir) (interactive) @@ -5660,7 +5663,7 @@ Reply to author if invoked with argument." (null (file-exists-p filename)))) (setq filename (read-file-name "Save to file: " filename))) - + (wl-summary-set-message-buffer-or-redisplay) (set-buffer (wl-message-get-original-buffer)) (if (and (null arg) (file-exists-p filename)) @@ -5780,7 +5783,7 @@ Reply to author if invoked with argument." (funcall wl-ps-print-buffer-func filename)) (kill-buffer buffer))))) (message "")))) - + (if (featurep 'ps-print) ; ps-print is available. (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print)) diff --git a/wl/wl-util.el b/wl/wl-util.el index a68880f..1186e5e 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (provide 'wl-util) (eval-when-compile @@ -474,7 +474,7 @@ Insert User-Agent field instead of X-Mailer field." (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. @@ -638,11 +638,11 @@ that `read' can handle, whenever this is possible." (defsubst wl-get-date-iso8601 (date) (or (get-text-property 0 'wl-date date) (let* ((d1 (timezone-fix-time date nil nil)) - (time (format "%04d%02d%02dT%02d%02d%02d" - (aref d1 0) (aref d1 1) (aref d1 2) - (aref d1 3) (aref d1 4) (aref d1 5)))) - (put-text-property 0 1 'wl-date time date) - time))) + (time (format "%04d%02d%02dT%02d%02d%02d" + (aref d1 0) (aref d1 1) (aref d1 2) + (aref d1 3) (aref d1 4) (aref d1 5)))) + (put-text-property 0 1 'wl-date time date) + time))) (defun wl-make-date-string () (let ((s (current-time-string))) @@ -650,13 +650,13 @@ that `read' can handle, whenever this is possible." s) (concat (wl-match-string 1 s) ", " (timezone-make-date-arpa-standard s (current-time-zone))))) - + (defun wl-date-iso8601 (date) "Convert the DATE to YYMMDDTHHMMSS." (condition-case () (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)))) @@ -714,17 +714,17 @@ that `read' can handle, whenever this is possible." (and (get-buffer x) (kill-buffer x))))) (buffer-list)))) - + (defun wl-sendlog-time () (static-if (fboundp 'format-time-string) (format-time-string "%Y/%m/%d %T") (let ((date (current-time-string))) (format "%s/%02d/%02d %s" - (substring date -4) - (cdr (assoc (upcase (substring date 4 7)) + (substring date -4) + (cdr (assoc (upcase (substring date 4 7)) timezone-months-assoc)) - (string-to-int (substring date 8 10)) - (substring date 11 19))))) + (string-to-int (substring date 8 10)) + (substring date 11 19))))) (defun wl-collect-summary () (let (result) @@ -817,7 +817,7 @@ that `read' can handle, whenever this is possible." (defun wl-local-load-profile () (message "Initializing ...") (load wl-init-file 'noerror 'nomessage)) - + (defun wl-load-profile () (funcall wl-load-profile-func)) @@ -855,4 +855,113 @@ that `read' can handle, whenever this is possible." (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 + (start-itimer "wl-biff" 'wl-biff-check-folders + wl-biff-check-interval wl-biff-check-interval)))) + + ((condition-case nil (require 'timer) (error nil));; FSFmacs 19+ + (autoload 'run-at-time "timer") + + (defun wl-biff-stop () + (put 'wl-biff 'timer nil)) + + (defun wl-biff-start () + (when wl-biff-check-folder-list + (put 'wl-biff 'timer (run-at-time t 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))) + +(defun wl-biff-check-folders () + (interactive) + (when (interactive-p) + (message "Checking new mails...")) + (let ((new-mails 0) + (flist (or wl-biff-check-folder-list '("%inbox"))) + folder) + (while flist + (setq folder (car flist) + flist (cdr flist)) + (when (elmo-folder-plugged-p folder) + (setq new-mails (+ new-mails + (nth 0 (wl-folder-check-one-entity folder)))))) + (setq wl-biff-state-indicator (if (zerop new-mails) + 'wl-biff-state-indicator-off + 'wl-biff-state-indicator-on)) + (force-mode-line-update t) + (when (interactive-p) + (cond ((zerop new-mails) (message "No mail.")) + ((eq 1 new-mails) (message "You have a new mail.")) + (t (message "You have %d new mails." new-mails)))))) + ;;; wl-util.el ends here diff --git a/wl/wl-vars.el b/wl/wl-vars.el index c74b349..6861e3e 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -264,8 +264,8 @@ references field of the current draft." "*SMTP connection type. If nil, default smtp connection type is used." :type '(choice (const :tag "default" nil) - (const :tag "Use STARTTLS" starttls) - symbol) + (const :tag "Use STARTTLS" starttls) + symbol) :group 'wl) (defcustom wl-smtp-posting-user nil @@ -1317,6 +1317,17 @@ Each elements are regexp of folder name." :type '(repeat (regexp :tag "Folder Regexp")) :group 'wl-folder) +(defcustom wl-biff-check-folder-list nil + "All folders that match this list are automatically checked +every intervals specified by wl-biff-check-interval. " + :type '(repeat (regexp :tag "Folder Regexp")) + :group 'wl-folder) + +(defcustom wl-biff-check-interval 40 + "Number of seconds between updates of new mails in the mode line." + :type 'integer + :group 'wl-folder) + (defcustom wl-interactive-send nil "*If non-nil, require your confirmation when sending draft message." :type 'boolean @@ -1867,13 +1878,13 @@ the `wl-highlight-message-headers' face." (defcustom wl-highlight-citation-header-regexp (concat "In article.*$\\|In message.*$\\|In the message.*$\\|" - "^At[^\n]+\n[^\n]+wrote:\n\\|" - "^.*\\(writes\\|wrote\\|said\\):\n") + "^At[^\n]+\n[^\n]+wrote:\n\\|" + "^.*\\(writes\\|wrote\\|said\\):\n") "*The pattern to match the prolog of a cited block. Text in the body of a message which matches this will be displayed in the `wl-highlight-message-headers' face." - :type 'regexp - :group 'wl-highlight) + :type 'regexp + :group 'wl-highlight) (defcustom wl-highlight-max-message-size 10000 "*If the message body is larger than this many chars, don't highlight it. @@ -1966,6 +1977,10 @@ a symbol `xbm' to limit the image format to XBM even if XPM can be shown." (defvar wl-plug-state-indicator-off " [--] ") (defvar wl-plug-state-indicator 'wl-plug-state-indicator-on) +(defvar wl-biff-state-indicator-on "(M@il)") +(defvar wl-biff-state-indicator-off "(-)") +(defvar wl-biff-state-indicator wl-biff-state-indicator-off) + (defvar wl-show-plug-status-on-modeline t) ;; Advanced thread view. @@ -2024,6 +2039,10 @@ a symbol `xbm' to limit the image format to XBM even if XPM can be shown." "*Icon file for plugged state.") (defvar wl-unplugged-icon "unplugged.xpm" "*Icon file for unplugged state.") +(defvar wl-biff-mail-icon "letter.xpm" + "*Icon file for mail existed state.") +(defvar wl-biff-nomail-icon "no-letter.xpm" + "*Icon file for no mail existed state.") (defvar wl-prog-uudecode "uudecode" "*uudecode program name") (defvar wl-prog-uudecode-arg '("-p") ;; outout is stdout. diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 5a9af6a..1809d35 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -40,6 +40,8 @@ (defvar wl-use-toolbar (if (featurep 'toolbar) 'default-toolbar nil)) (defvar wl-plugged-glyph nil) (defvar wl-unplugged-glyph nil) +(defvar wl-biff-mail-glyph nil) +(defvar wl-biff-nomail-glyph nil) (defvar wl-folder-toolbar '([wl-folder-jump-to-current-entity @@ -370,28 +372,44 @@ wl-folder-internal-icon-list)) (defun wl-plugged-init-icons () - (unless wl-plugged-glyph - (setq wl-plugged-glyph (wl-xmas-make-icon-glyph - (concat "[" wl-plugged-plug-on "]") - wl-plugged-icon)) - (let ((extent (make-extent nil nil)) - (toggle-keymap (make-sparse-keymap))) - (define-key toggle-keymap 'button2 - (make-modeline-command-wrapper 'wl-toggle-plugged)) - (set-extent-keymap extent toggle-keymap) - (set-extent-property extent 'help-echo "button2 toggles plugged status") - (setq wl-plug-state-indicator-on (cons extent wl-plugged-glyph)))) - (unless wl-unplugged-glyph - (setq wl-unplugged-glyph (wl-xmas-make-icon-glyph - (concat "[" wl-plugged-plug-off "]") - wl-unplugged-icon)) - (let ((extent (make-extent nil nil)) - (toggle-keymap (make-sparse-keymap))) - (define-key toggle-keymap 'button2 - (make-modeline-command-wrapper 'wl-toggle-plugged)) - (set-extent-keymap extent toggle-keymap) - (set-extent-property extent 'help-echo "button2 toggles plugged status") - (setq wl-plug-state-indicator-off (cons extent wl-unplugged-glyph))))) + (let (extent) + (unless (or wl-plugged-glyph wl-unplugged-glyph) + (setq extent (make-extent nil nil)) + (let ((toggle-keymap (make-sparse-keymap))) + (define-key toggle-keymap 'button2 + (make-modeline-command-wrapper 'wl-toggle-plugged)) + (set-extent-keymap extent toggle-keymap)) + (set-extent-property extent 'help-echo "button2 toggles plugged status")) + (unless wl-plugged-glyph + (setq wl-plugged-glyph (wl-xmas-make-icon-glyph + (concat "[" wl-plugged-plug-on "]") + wl-plugged-icon) + wl-plug-state-indicator-on (cons extent wl-plugged-glyph))) + (unless wl-unplugged-glyph + (setq wl-unplugged-glyph (wl-xmas-make-icon-glyph + (concat "[" wl-plugged-plug-off "]") + wl-unplugged-icon) + wl-plug-state-indicator-off (cons extent wl-unplugged-glyph))))) + +(defun wl-biff-init-icons () + (let (extent) + (unless (or wl-biff-mail-glyph wl-biff-nomail-glyph) + (setq extent (make-extent nil nil)) + (let ((keymap (make-sparse-keymap))) + (define-key keymap 'button2 + (make-modeline-command-wrapper 'wl-biff-check-folders)) + (set-extent-keymap extent keymap)) + (set-extent-property extent 'help-echo "button2 checks new mails")) + (unless wl-biff-mail-glyph + (setq wl-biff-mail-glyph (wl-xmas-make-icon-glyph + wl-biff-state-indicator-on + wl-biff-mail-icon) + wl-biff-state-indicator-on (cons extent wl-biff-mail-glyph))) + (unless wl-biff-nomail-glyph + (setq wl-biff-nomail-glyph (wl-xmas-make-icon-glyph + wl-biff-state-indicator-off + wl-biff-nomail-icon) + wl-biff-state-indicator-off (cons extent wl-biff-nomail-glyph))))) (defun wl-make-date-string () (let ((s (current-time-string))) @@ -488,11 +506,15 @@ Special commands: (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)) (defun wl-draft-overload-functions () - (setq mode-line-buffer-identification - (wl-mode-line-buffer-identification - (if wl-show-plug-status-on-modeline - '("" wl-plug-state-indicator "Wanderlust: %12b") - '("Wanderlust: %12b")))) + (let ((id '("Wanderlust: %12b"))) + (when wl-show-plug-status-on-modeline + (wl-push 'wl-plug-state-indicator id)) + (when wl-biff-check-folder-list + (wl-push 'wl-biff-state-indicator id)) + (when (cdr id) + (wl-push "" id)) + (setq mode-line-buffer-identification + (wl-mode-line-buffer-identification id))) (local-set-key "\C-c\C-s" 'wl-draft-send);; override (wl-xmas-setup-draft-toolbar) (wl-draft-overload-menubar)) diff --git a/wl/wl.el b/wl/wl.el index b23fe16..e1606da 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'elmo2) ;; from x-face.el @@ -143,7 +143,7 @@ '(("Queuing" . wl-draft-enable-queuing) ("AutoFlushQueue" . wl-auto-flush-queue) ("DisconnectedOperation" . elmo-enable-disconnected-operation))) - + (defvar wl-plugged-buf-name "Plugged") (defvar wl-plugged-mode-map nil) (defvar wl-plugged-alist nil) @@ -153,9 +153,6 @@ (defvar wl-plugged-dop-queue-alist nil) (defvar wl-plugged-alist-modified nil) -(defvar wl-plugged-glyph nil) -(defvar wl-unplugged-glyph nil) - (defvar wl-plugged-mode-menu-spec '("Plugged" ["Toggle plugged" wl-plugged-toggle t] @@ -212,11 +209,15 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (setq major-mode 'wl-plugged-mode) (setq mode-name "Plugged") (easy-menu-add wl-plugged-mode-menu) - (setq mode-line-buffer-identification - (wl-mode-line-buffer-identification - (if wl-show-plug-status-on-modeline - '("" wl-plug-state-indicator "Wanderlust: %12b") - '("Wanderlust: %12b")))) + (let ((id '("Wanderlust: %12b"))) + (when wl-show-plug-status-on-modeline + (wl-push 'wl-plug-state-indicator id)) + (when wl-biff-check-folder-list + (wl-push 'wl-biff-state-indicator id)) + (when (cdr id) + (wl-push "" id)) + (setq mode-line-buffer-identification + (wl-mode-line-buffer-identification id))) (setq wl-plugged-switch wl-plugged) (setq wl-plugged-alist-modified nil) (setq buffer-read-only t) @@ -644,6 +645,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (when (or (not wl-interactive-exit) (y-or-n-p "Quit Wanderlust?")) (elmo-quit) + (wl-biff-stop) (run-hooks 'wl-exit-hook) (wl-save-status) (wl-folder-cleanup-variables) @@ -715,9 +717,9 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (error "Please set `wl-from'")) (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain (if wl-local-domain - (concat (system-name) + (concat (system-name) "." wl-local-domain) - (system-name)))) + (system-name)))) (error "Please set `wl-local-domain' to get valid FQDN")) (when (not no-check-folder) (if (not (eq (elmo-folder-get-type wl-draft-folder) 'localdir)) @@ -761,6 +763,7 @@ If prefix argument is specified, folder checkings are skipped." (unwind-protect (wl-init arg) (wl-folder arg)) + (wl-biff-start) (run-hooks 'wl-hook)) ;; Define some autoload functions WL might use. @@ -810,7 +813,7 @@ If prefix argument is specified, folder checkings are skipped." ;; for backward compatibility (defalias 'wl-summary-from-func-petname 'wl-summary-default-from) - + (provide 'wl) ;;; wl.el ends here -- 1.7.10.4