* 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.
+2000-09-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * etc/icons/letter.xpm, etc/icons/no-letter.xpm: New files.
+
2000-09-15 TAKAHASHI Kaoru <kaoru@kaisei.org>
* utils/ptexinfmt.el (texinfo-multitable-widths): Add
--- /dev/null
+/* 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"};
--- /dev/null
+/* 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 ",
+" "};
+2000-09-18 A. SAGATA <sagata@nttvdt.hil.ntt.co.jp>
+ Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <okazaki@be.to>
* 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'.
(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
: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"))
(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))
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'elmo-vars)
(require 'elmo-util)
(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)))
(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)))
(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)))))
(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))
(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)
(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)
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))
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)))
elmo-default-nntp-port
nil nil "nntp" add))
(wl-plugged-init-icons)
+ (wl-biff-init-icons)
;; user setting
(run-hooks 'wl-make-plugged-hook)))
(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)
'("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))
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(defun wl-message-overload-functions ()
(local-set-key "l" 'wl-message-toggle-disp-summary))
(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))))
(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)
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'elmo2)
(require 'elmo-multi)
(require 'easymenu))
(error))
(require 'elmo-date)
-
+
(condition-case nil
(require 'ps-print)
(error))
(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)
(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)
(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)
(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))
(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)
(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))))))
;; 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."
(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))
(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)
(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
(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))))
(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")
(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
"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")
(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")
(if (null result)
(message "No message was picked.")
(wl-summary-target-mark-msgs result))))))
-
+
(defun wl-summary-unvirtual ()
"Exit from current virtual folder."
(interactive)
(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
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)
;;
;; Goto unread or important
-;;
+;;
(defun wl-summary-cursor-up (&optional hereto)
(interactive "P")
(if (and (not wl-summary-buffer-target-mark-list)
(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
(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))
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\" <y/n/s(elect)>?"
elmo-default-nntp-server)
(setq schar (read-char))
(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)
(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))
(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."
(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)
"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
(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)
(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))
(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))
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(provide 'wl-util)
(eval-when-compile
(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.
(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)))
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))))
(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)
(defun wl-local-load-profile ()
(message "Initializing ...")
(load wl-init-file 'noerror 'nomessage))
-
+
(defun wl-load-profile ()
(funcall wl-load-profile-func))
(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
"*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
: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
(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.
(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.
"*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.
(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
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)))
(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))
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'elmo2)
;; from x-face.el
'(("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)
(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]
(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)
(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)
(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))
(unwind-protect
(wl-init arg)
(wl-folder arg))
+ (wl-biff-start)
(run-hooks 'wl-hook))
;; Define some autoload functions WL might use.
;; for backward compatibility
(defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
-
+
(provide 'wl)
;;; wl.el ends here
projects / elisp / wanderlust.git / commitdiff