From: yamaoka Date: Thu, 14 Sep 2000 13:19:11 +0000 (+0000) Subject: New implementations of highlighting Folder. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=37705ba68e80e23081d66824b4d3ab6854668f94;p=elisp%2Fwanderlust.git New implementations of highlighting Folder. * wl/wl-xmas.el (wl-xmas-highlight-folder-group-line): New function. (wl-highlight-folder-current-line): Use it; new implementation. (wl-xmas-setup-draft-toolbar, wl-xmas-setup-message-toolbar, wl-xmas-setup-summary-toolbar, wl-xmas-setup-folder-toolbar): Use `defsubst' instead of `defun'. * wl/wl-vars.el (wl-highlight-folder-by-numbers): Renamed from `wl-highlight-group-folder-by-numbers'; made it can also be a number. See info for more details. * wl/wl-summary.el: Bind `wl-xmas-setup-summary' when XEmacs is not running. * wl/wl-nemacs.el (wl-xmas-setup-*, wl-delete-all-overlays): No need to bind them. * wl/wl-mule.el (wl-xmas-setup-*): No need to bind them. (wl-highlight-folder-current-line): New implementation. * wl/wl-highlight.el (wl-highlight-folder-group-line): New implementation. (wl-delete-all-overlays): Rewrite as a marco. (TopLevel): Require `wl-e21' when Emacs 21 is running. * wl/wl-folder.el: Bind `wl-xmas-setup-folder' when XEmacs is not running. (wl-folder-*-glyph): No need to bind them. * wl/wl-e21.el (wl-e21-highlight-folder-group-line): Renamed from `wl-e21-highlight-folder-group-icon'; rewrite. (wl-e21-setup-draft-toolbar, wl-e21-setup-message-toolbar): Use `defsubst' instead of `defun'. (wl-folder-mode-map): Bind it when compiling. * doc/{wl-ja.texi, wl.texi}: Replace `wl-highlight-group-folder-by-numbers' with `wl-highlight-folder-by-numbers'; add description about `wl-highlight-folder-by-numbers'; update for Emacs 21. * WL-ELS (WL-MODULES): Add `wl-e21'. --- diff --git a/ChangeLog b/ChangeLog index 8f9ab08..a55e700 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2000-09-14 Katsumi Yamaoka + + * doc/wl.texi, doc/wl-ja.texi: Replace + `wl-highlight-group-folder-by-numbers' with + `wl-highlight-folder-by-numbers'; + add description about `wl-highlight-folder-by-numbers'; + update for Emacs 21. + + * WL-ELS (WL-MODULES): Add `wl-e21'. + 2000-08-31 TAKAHASHI Kaoru * utils/ptexinfmt.el (texinfo-multitable-widths, diff --git a/WL-ELS b/WL-ELS index bd4ff72..5bca727 100644 --- a/WL-ELS +++ b/WL-ELS @@ -31,6 +31,8 @@ (setq ELMO-MODULES (append (list 'elmo-database) ELMO-MODULES))) ((fboundp 'nemacs-version) (setq WL-MODULES (append WL-MODULES (list 'wl-nemacs)))) + ((and (boundp 'emacs-major-version) (>= emacs-major-version 21)) + (setq WL-MODULES (append WL-MODULES (list 'wl-e21)))) ((featurep 'mule) (setq WL-MODULES (append WL-MODULES (list 'wl-mule))))) diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index 5494d50..82765b3 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -164,7 +164,7 @@ Wanderlust $B$NA[%U%)%k%@!#(B @@ -548,7 +548,7 @@ Wanderlust $B$NF0:n$r%+%9%?%^%$%:$G$-$^$9!#(B (autoload 'wl "wl" "Wanderlust" t) (autoload 'wl-draft "wl-draft" "Write draft with Wanderlust." t) -;; @r{$B%"%$%3%s$rCV$/%G%#%l%/%H%j(B (XEmacs $B$N$_(B)$B!#=i4|@_Dj$O(B @code{nil}$B!#(B} +;; @r{$B%"%$%3%s$rCV$/%G%#%l%/%H%j(B (XEmacs $B$H(B Emacs 21)$B!#=i4|@_Dj$O(B @code{nil}$B!#(B} ;; @r{(XEmacs $B$N(B package $B$H$7$F%$%s%9%H!<%k$5$l$F$$$k>l9g!"I,MW$"$j$^$;$s(B)} (setq wl-icon-dir "~/work/wl/etc") @@ -1833,6 +1833,13 @@ Non-nil $B$J$i%5%^%j$K0\F0$7$?$H$-$K%U%)%k%@%P%C%U%!$N1&$K%5%^%j$N%P%C%U%!$,8=$ $B=i4|@_Dj$O(B 70$B!#(B $BL$F14|?t$,$?$/$5$s$+$I$&$+$NogCM!#$3$NCM$r1[$($k$H?'$,JQ$o$j$^$9!#(B +@item wl-highlight-folder-by-numbers +@vindex wl-highlight-folder-by-numbers +$B%U%)%k%@%P%C%U%!$K$*$1$k3F9T$N%O%$%i%$%H$N7A<0$r;XDj$7$^$9!#=i4|CM$O(B +@code{t} $B$G!"9TA4BN$K%a%C%;!<%8?t$K1~$8$??'$rIU$1$^$9!#(B@code{nil} $B$G$O%U%)(B +$B%k%@$N>uBV$K1~$8$??'$rIU$1$^$9!#$^$?!"?t;z(B ($BNc$($P(B @code{1}) $B$K$7$F$*$/(B +$B$H!"%a%C%;!<%8?t$H%U%)%k%@$N>uBV$NN>J}$K1~$8$?%O%$%i%$%H$,9T$J$o$l$^$9!#(B + @item wl-folder-desktop-name @vindex wl-folder-desktop-name $B=i4|@_Dj$O(B @samp{Desktop}$B!#(B @@ -4368,7 +4375,7 @@ Queuing:[ON] AutoFlushQueue:[--] DisconnectedOperation:[ON] $B$^$?!"(B2$B9TL\0J9_$G$O%5!<%P$H%]!<%H$N%*%s%i%$%s$H%*%U%i%$%s>uBV$rI=<($7!"(B @samp{[ON]} $B$O$=$N%5!<%P$d%]!<%H$,%*%s%i%$%s$G$"$k$3$H$r!"(B @samp{[--]} $B$O%*%U%i%$%s$G$"$k$3$H$r<($7$F$$$^$9(B -(XEmacs $B$G$O%"%$%3%s$GI=<($5$l$^$9(B)$B!#(B +(XEmacs $B$H(B Emacs 21 $B$G$O%"%$%3%s$GI=<($5$l$^$9(B)$B!#(B $B$=$7$F$=$l$>$l$N9T$G(B @kbd{@key{SPC}} $B$d(B @kbd{@key{RET}} $B$r2!$9$3$H$G(B $B>uBV$r@Z$jBX$($k$3$H$,$G$-$^$9!#(B @@ -5927,11 +5934,13 @@ face $B$N@_Dj$O(B @file{.emacs} $B$K=q$/$3$H$O$G$-$J$$$N$G(B @file{~/.wl} $ @item wl-highlight-folder-opened-face $B%U%)%k%@%b!<%I$G!"3+$$$?%0%k!<%W$K$D$/(B face $B$G$9!#(B -$BJQ?t(B @code{wl-highlight-group-folder-by-numbers} $B$,(B nil $B$N$H$-M-8z$G$9!#(B +$BJQ?t(B @code{wl-highlight-folder-by-numbers} $B$,(B @code{nil} $B$+(B @dfn{$B?t(B} $B$N(B +$B$H$-M-8z$G$9!#(B @item wl-highlight-folder-closed-face $B%U%)%k%@%b!<%I$G!"JD$8$?%0%k!<%W$K$D$/(B face $B$G$9!#(B -$BJQ?t(B @code{wl-highlight-group-folder-by-numbers} $B$,(B nil $B$N$H$-M-8z$G$9!#(B +$BJQ?t(B @code{wl-highlight-folder-by-numbers} $B$,(B @code{nil} $B$+(B @dfn{$B?t(B} $B$N(B +$B$H$-M-8z$G$9!#(B @item wl-highlight-folder-path-face $B%U%)%k%@%b!<%I$G!"8=:_A*BrCf$N%U%)%k%@$^$G$N%Q%9$K$D$/(B face $B$G$9!#(B @@ -6130,8 +6139,8 @@ MIME $B$G$O$J$$%a%C%;!<%8$N>l9g(B (@samp{Content-Type:} $B$,$J$$%a!<%k$J$I(B @item wl-highlight-folder-with-icon @vindex wl-highlight-folder-with-icon -XEmacs $B$N$_M-8z$G$9!#=i4|@_Dj$O(B XEmacs $B$K0MB8$7$^$9(B($B%"%$%3%s$r;HMQ$G$-$k(B -XEmacs $B$G$O(B t $B$K$J$j$^$9(B)$B!#(B +XEmacs $B$^$?$O(B Emacs 21 $B$GM-8z$G$9!#=i4|@_Dj$O$=$N(B (X)Emacs $B$K0MB8$7$^$9(B +($B%"%$%3%s$r;HMQ$G$-$k(B (X)Emacs $B$G$O(B t $B$K$J$j$^$9(B)$B!#(B @item wl-strict-diff-folders @vindex wl-strict-diff-folders diff --git a/doc/wl.texi b/doc/wl.texi index 37ee54d..61ffd55 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -141,7 +141,7 @@ The main features of Wanderlust: @item MH-like FCC. (FCC: %Backup and FCC: $Backup is allowed). @item MIME compliant (by SEMI or tm). @item Transmission of news and mail are unified by Message transmitting draft. -@item Graphical list of folders (XEmacs). +@item Graphical list of folders (XEmacs and Emacs 21). @item View a part of message without retrieving the whole message (IMAP4). @item Server-side message look up (IMAP4). Multi-byte characters are allowed. @item Virtual Folders. @@ -517,7 +517,8 @@ The minimal requirement for settings is as the following. (autoload 'wl "wl" "Wanderlust" t) (autoload 'wl-draft "wl-draft" "Write draft with Wanderlust." t) -;; @r{Directory where icons are placed (XEmacs Only). Default value is @code{nil}.} +;; @r{Directory where icons are placed (XEmacs or Emacs 21). Default value +;; is @code{nil}.} ;; @r{(This is not required if Wanderlust is installed as XEmacs package)} (setq wl-icon-dir "~/work/wl/etc") @@ -1805,6 +1806,15 @@ The initial setting is 70. If the number of unread messages is more than this value, folder color is changed. +@item wl-highlight-folder-by-numbers +@vindex wl-highlight-folder-by-numbers +This option controls how to highlight each line in the folder buffer. +The default value is @code{t}, highlighting with various colors based on +the message numbers. If it is @code{nil}, highlighting with various +colors based on the folder status. In addition, if it is a number +(e.g. @code{1}), highlighting will be done based on both the message +numbers and the folder status. + @item wl-folder-desktop-name @vindex wl-folder-desktop-name The initial setting is @samp{Desktop}. @@ -4395,7 +4405,7 @@ where @samp{[ON]} means its value is t, and @samp{[--]} means nil. The second and after lines indicate on-line/off-line states of servers and ports, where @samp{[ON]} stands for on-line and @samp{[--]} for -off-line (in XEmacs, they are shown with icons). Pressing +off-line (in XEmacs or Emacs 21, they are shown with icons). Pressing @kbd{@key{SPC}} or @kbd{@key{RET}} in each line switches its state. "sending queue" means messages accumulated in the folder @samp{+queue} @@ -5989,11 +5999,13 @@ folder mode. @item wl-highlight-folder-opened-face The face for open groups in the folder mode. -It is meaningful when @code{wl-highlight-group-folder-by-numbers} is nil. +It is meaningful when @code{wl-highlight-group-folder-by-numbers} is nil +or a number. @item wl-highlight-folder-closed-face The face for close groups in the folder mode. -It is meaningful when @code{wl-highlight-group-folder-by-numbers} is nil. +It is meaningful when @code{wl-highlight-group-folder-by-numbers} is nil +or a number. @item wl-highlight-folder-path-face The face for the path to the currently selected folder in the folder @@ -6188,8 +6200,8 @@ This is used as a MIME charset for searching. @item wl-highlight-folder-with-icon @vindex wl-highlight-folder-with-icon -This is meaningful for XEmacs only. The initial setting depends on -XEmacs (t for XEmacs with icons). +This is meaningful for XEmacs or Emacs 21.. The initial setting depends +on (X)Emacs (t for XEmacs or Emacs 21 with icons). @item wl-strict-diff-folders @vindex wl-strict-diff-folders diff --git a/wl/ChangeLog b/wl/ChangeLog index 8f403fd..26098f3 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,39 @@ +2000-09-14 Katsumi Yamaoka + + * wl-xmas.el (wl-xmas-highlight-folder-group-line): New function. + (wl-highlight-folder-current-line): Use it; new implementation. + (wl-xmas-setup-draft-toolbar, wl-xmas-setup-message-toolbar, + wl-xmas-setup-summary-toolbar, wl-xmas-setup-folder-toolbar): Use + `defsubst' instead of `defun'. + + * wl-vars.el (wl-highlight-folder-by-numbers): Renamed from + `wl-highlight-group-folder-by-numbers'; made it can also be a + number. See info for more details. + + * wl-summary.el: Bind `wl-xmas-setup-summary' when XEmacs is not + running. + + * wl-nemacs.el (wl-xmas-setup-*, wl-delete-all-overlays): No need + to bind them. + + * wl-mule.el (wl-xmas-setup-*): No need to bind them. + (wl-highlight-folder-current-line): New implementation. + + * wl-highlight.el (wl-highlight-folder-group-line): New + implementation. + (wl-delete-all-overlays): Rewrite as a marco. + (TopLevel): Require `wl-e21' when Emacs 21 is running. + + * wl-folder.el: Bind `wl-xmas-setup-folder' when XEmacs is not + running. + (wl-folder-*-glyph): No need to bind them. + + * wl-e21.el (wl-e21-highlight-folder-group-line): Renamed from + `wl-e21-highlight-folder-group-icon'; rewrite. + (wl-e21-setup-draft-toolbar, wl-e21-setup-message-toolbar): Use + `defsubst' instead of `defun'. + (wl-folder-mode-map): Bind it when compiling. + 2000-09-13 Yuuichi Teranishi * wl.el (wl): Initialize plug-related settings before `wl-init'. diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 46539f1..1aea9e5 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -35,6 +35,7 @@ (require 'wl-draft) (require 'wl-message) (require 'wl-highlight) + (defvar-maybe wl-folder-mode-map (make-sparse-keymap)) (defvar-maybe wl-draft-mode-map (make-sparse-keymap))) (defvar wl-use-toolbar (and (display-graphic-p) @@ -152,6 +153,26 @@ success nil)))) success)) +(defun wl-e21-make-icon-image (icon-text icon-file) + (if wl-highlight-folder-with-icon + (let ((load-path (cons wl-icon-dir load-path))) + (cond ((let (case-fold-search) + ;; It may be a default value. + (string-match "\\.xpm$" icon-file)) + (find-image + `((:type xpm :file ,icon-file :ascent center) + (:type xbm + :file ,(concat + (substring icon-file 0 (match-beginning 0)) + ".xbm") + :ascent center)))) + ((let ((case-fold-search t)) + (string-match "\\.\\(x[bp]m\\|png\\|gif\\)$" icon-file)) + (find-image + `((:type ,(intern (downcase (match-string 1 icon-file))) + :file ,icon-file :ascent center)))))) + icon-text)) + (defvar wl-e21-toolbar-configurations '((auto-resize-tool-bar . t) (auto-raise-tool-bar-buttons . t) @@ -184,88 +205,92 @@ (wl-e21-setup-toolbar wl-summary-toolbar) (wl-e21-make-toolbar-buttons wl-summary-mode-map wl-summary-toolbar))) -(defun wl-e21-setup-message-toolbar () - (and wl-use-toolbar - (wl-e21-setup-toolbar wl-message-toolbar) - (wl-e21-make-toolbar-buttons (current-local-map) wl-message-toolbar))) - -(defun wl-e21-setup-draft-toolbar () - (and wl-use-toolbar - (wl-e21-setup-toolbar wl-draft-toolbar) - (wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar))) - -(defun wl-e21-insert-image (image &optional string) - (unless string - (setq string " ")) +(eval-when-compile + (defsubst wl-e21-setup-message-toolbar () + (and wl-use-toolbar + (wl-e21-setup-toolbar wl-message-toolbar) + (wl-e21-make-toolbar-buttons (current-local-map) wl-message-toolbar))) + + (defsubst wl-e21-setup-draft-toolbar () + (and wl-use-toolbar + (wl-e21-setup-toolbar wl-draft-toolbar) + (wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar)))) + +(defun wl-e21-insert-image (image &optional text) + (unless text + (setq text " ")) (let* ((start (point)) - (end (+ start (length string)))) + (end (+ start (length text)))) (if (stringp image) (progn - (insert string) + (insert text) (let ((ovl (make-overlay start end))) (overlay-put ovl 'before-string image) (overlay-put ovl 'evaporate t) (add-text-properties start end '(invisible t intangible t rear-nonsticky t)))) - (insert-image image string)) + (insert-image image text)) (put-text-property start end 'wl-e21-icon t))) -(defun wl-e21-make-icon-image (icon-string icon-file) - (if wl-highlight-folder-with-icon - (let ((load-path (cons wl-icon-dir load-path))) - (cond ((let (case-fold-search) - ;; It may be a default value. - (string-match "\\.xpm$" icon-file)) - (find-image - `((:type xpm :file ,icon-file :ascent center) - (:type xbm - :file ,(concat - (substring icon-file 0 (match-beginning 0)) - ".xbm") - :ascent center)))) - ((let ((case-fold-search t)) - (string-match "\\.\\(x[bp]m\\|png\\|gif\\)$" icon-file)) - (find-image - `((:type ,(intern (downcase (match-string 1 icon-file))) - :file ,icon-file :ascent center)))))) - icon-string)) +(defvar wl-folder-toggle-icon-list + '((wl-folder-opened-image . wl-opened-group-folder-icon) + (wl-folder-closed-image . wl-closed-group-folder-icon))) (eval-when-compile - (defsubst wl-e21-highlight-folder-group-icon (image &optional string-face) - (let ((string (match-string-no-properties 1)) - (start (goto-char (match-beginning 1))) + (defsubst wl-e21-highlight-folder-group-line (image text-face numbers) + (let ((start (goto-char (match-beginning 1))) (inhibit-read-only t)) - (delete-region start (match-end 1)) - (unless (get image 'image) - (put image 'image (wl-e21-make-icon-image - string - (symbol-value - (cdr (assq image wl-folder-toggle-icon-list)))))) - (setq image (get image 'image)) - (wl-e21-insert-image image string) - (when (stringp image) - (put-text-property (line-beginning-position) (line-end-position) - 'face string-face)) + (let ((text (match-string-no-properties 1))) + (delete-region start (match-end 1)) + (wl-e21-insert-image + (or (get image 'image) + (put image 'image + (wl-e21-make-icon-image + text (symbol-value + (cdr (assq image wl-folder-toggle-icon-list)))))) + text)) (when wl-use-highlight-mouse-line - (put-text-property start (line-end-position) - 'mouse-face 'highlight))))) + (put-text-property start (line-end-position) 'mouse-face 'highlight)) + (setq start (point)) + (if (and wl-highlight-folder-by-numbers + numbers (nth 0 numbers) (nth 1 numbers) + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" (line-end-position) + t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond ((and unsync (zerop unsync)) + (if (and unread (zerop unread)) + 'wl-highlight-folder-zero-face + 'wl-highlight-folder-unread-face)) + ((and unsync + (>= unsync wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property start (match-beginning 0) 'face text-face) + (put-text-property (match-beginning 0) (point) 'face face)) + (put-text-property start (point) 'face face))) + (put-text-property start (line-end-position) 'face text-face))))) (defun wl-highlight-folder-current-line (&optional numbers) (interactive) (save-excursion (beginning-of-line) - ;; put an icon (let (fld-name) (cond (;; opened folder group (looking-at wl-highlight-folder-opened-regexp) - (wl-e21-highlight-folder-group-icon 'wl-folder-opened-image - 'wl-highlight-folder-opened-face)) + (wl-e21-highlight-folder-group-line 'wl-folder-opened-image + 'wl-highlight-folder-opened-face + numbers)) (;; closed folder group (looking-at wl-highlight-folder-closed-regexp) - (wl-e21-highlight-folder-group-icon 'wl-folder-closed-image - 'wl-highlight-folder-closed-face)) + (wl-e21-highlight-folder-group-line 'wl-folder-closed-image + 'wl-highlight-folder-closed-face + numbers)) (;; basic folder (and (setq fld-name (wl-folder-get-folder-name-by-id (get-text-property (point) 'wl-folder-entity-id))) @@ -275,50 +300,59 @@ (if (get-text-property (point) 'wl-e21-icon) (delete-char 1) (forward-char 1)) - (let ((start (point)) - type) - (wl-e21-insert-image - (cond - ((string= fld-name wl-trash-folder);; trash folder - (let ((num (nth 2 numbers)));; number of messages - (get (if (or (not num) (zerop num)) - 'wl-folder-trash-empty-image - 'wl-folder-trash-image) - 'image))) - ((string= fld-name wl-draft-folder);; draft folder - (get 'wl-folder-draft-image 'image)) - ((string= fld-name wl-queue-folder);; queue folder - (get 'wl-folder-queue-image 'image)) - (;; and one of many other folders - (setq type (elmo-folder-get-type fld-name)) - (get (intern (format "wl-folder-%s-image" type)) 'image)))) - (when wl-use-highlight-mouse-line - (put-text-property start (line-end-position) - 'mouse-face 'highlight))))))) - (let ((inhibit-read-only t)) - (if (and numbers (nth 0 numbers) (nth 1 numbers)) - (let ((unsync (nth 0 numbers)) - (unread (nth 1 numbers)) - (inhibit-read-only t)) - (put-text-property - (line-beginning-position) (line-end-position) - 'face - (cond ((and unsync (zerop unsync)) - (if (and unread (zerop unread)) - 'wl-highlight-folder-zero-face - 'wl-highlight-folder-unread-face)) - ((and unsync - (>= unsync wl-folder-many-unsync-threshold)) - 'wl-highlight-folder-many-face) - (t - 'wl-highlight-folder-few-face)))) - (beginning-of-line) - (put-text-property (point) (line-end-position) 'face - (if (looking-at (format "^[ ]*\\(%s\\|%s\\)" - wl-folder-unsubscribe-mark - wl-folder-removed-mark)) - 'wl-highlight-folder-killed-face - 'wl-highlight-folder-unknown-face)))))) + (let ((start (point))) + (let (type) + (wl-e21-insert-image + (cond + ((string= fld-name wl-trash-folder);; trash folder + (let ((num (nth 2 numbers)));; number of messages + (get (if (or (not num) (zerop num)) + 'wl-folder-trash-empty-image + 'wl-folder-trash-image) + 'image))) + ((string= fld-name wl-draft-folder);; draft folder + (get 'wl-folder-draft-image 'image)) + ((string= fld-name wl-queue-folder);; queue folder + (get 'wl-folder-queue-image 'image)) + (;; and one of many other folders + (setq type (elmo-folder-get-type fld-name)) + (get (intern (format "wl-folder-%s-image" type)) 'image))))) + (let ((end (line-end-position))) + (when wl-use-highlight-mouse-line + (put-text-property start end 'mouse-face 'highlight)) + (setq start (point)) + (beginning-of-line) + (let ((text-face + (if (looking-at (format "^[ \t]*\\(%s\\|%s\\)" + wl-folder-unsubscribe-mark + wl-folder-removed-mark)) + 'wl-highlight-folder-killed-face + 'wl-highlight-folder-unknown-face))) + (if (and wl-highlight-folder-by-numbers + numbers (nth 0 numbers) (nth 1 numbers) + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" end t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond + ((and unsync (zerop unsync)) + (if (and unread (zerop unread)) + 'wl-highlight-folder-zero-face + 'wl-highlight-folder-unread-face)) + ((and unsync + (>= unsync + wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property start (match-beginning 0) + 'face text-face) + (put-text-property (match-beginning 0) + (match-end 0) + 'face face)) + (put-text-property start (match-end 0) 'face face))) + (put-text-property start end 'face text-face))))))))))) (defun wl-highlight-plugged-current-line () (interactive) @@ -369,10 +403,6 @@ (wl-folder-queue-image . wl-queue-folder-icon) (wl-folder-trash-image . wl-trash-folder-icon))) -(defvar wl-folder-toggle-icon-list - '((wl-folder-opened-image . wl-opened-group-folder-icon) - (wl-folder-closed-image . wl-closed-group-folder-icon))) - (defun wl-folder-init-icons () (let ((load-path (cons wl-icon-dir load-path)) (icons wl-folder-internal-icon-list) diff --git a/wl/wl-folder.el b/wl/wl-folder.el index cc5d4c7..95b09ab 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -61,24 +61,6 @@ (defvar wl-folder-mode-map nil) -(defvar wl-folder-opened-glyph nil) -(defvar wl-folder-closed-glyph nil) -(defvar wl-folder-nntp-glyph nil) -(defvar wl-folder-imap4-glyph nil) -(defvar wl-folder-pop3-glyph nil) -(defvar wl-folder-localdir-glyph nil) -(defvar wl-folder-localnews-glyph nil) -(defvar wl-folder-internal-glyph nil) -(defvar wl-folder-multi-glyph nil) -(defvar wl-folder-filter-glyph nil) -(defvar wl-folder-archive-glyph nil) -(defvar wl-folder-pipe-glyph nil) -(defvar wl-folder-maildir-glyph nil) -(defvar wl-folder-trash-empty-glyph nil) -(defvar wl-folder-trash-glyph nil) -(defvar wl-folder-draft-glyph nil) -(defvar wl-folder-queue-glyph nil) - (defvar wl-folder-buffer-disp-summary nil) (defvar wl-folder-buffer-cur-entity-id nil) (defvar wl-folder-buffer-cur-path nil) @@ -1404,6 +1386,8 @@ If current line is group folder, all subfolders are marked." ;; Avoid byte-compile warning. (eval-when-compile + (unless wl-on-xemacs + (defalias 'wl-xmas-setup-folder 'ignore)) (unless wl-on-emacs21 (defalias 'wl-e21-setup-folder 'ignore))) diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index d30040a..74bb3db 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (if (and (featurep 'xemacs) (featurep 'dragdrop)) @@ -36,11 +36,14 @@ (provide 'wl-highlight) (eval-when-compile - (if wl-on-xemacs - (require 'wl-xmas) - (if wl-on-nemacs - (require 'wl-nemacs) - (require 'wl-mule))) + (cond (wl-on-xemacs + (require 'wl-xmas)) + (wl-on-emacs21 + (require 'wl-e21)) + (wl-on-nemacs + (require 'wl-nemacs)) + (t + (require 'wl-mule))) (defun-maybe extent-begin-glyph (a)) (defun-maybe delete-extent (a)) (defun-maybe make-extent (a b)) @@ -729,6 +732,13 @@ () ; noop (` (defun (, name) (,@ everything-else))))) +(defmacro wl-delete-all-overlays () + (if wl-on-nemacs + nil + '(mapcar (lambda (x) + (delete-overlay x)) + (overlays-in (point-min) (point-max))))) + (defun-hilit wl-highlight-summary-displaying () (interactive) (wl-delete-all-overlays) @@ -741,41 +751,35 @@ (overlay-put ov 'face 'wl-highlight-summary-displaying-face)))) (defun-hilit2 wl-highlight-folder-group-line (numbers) - (if wl-highlight-group-folder-by-numbers - (let (fsymbol bol eol) - (beginning-of-line) - (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) - (setq fsymbol - (let ((unsync (nth 0 numbers)) - (unread (nth 1 numbers))) - (cond ((and unsync (eq unsync 0)) - (if (and unread (> unread 0)) - 'wl-highlight-folder-unread-face - 'wl-highlight-folder-zero-face)) - ((and unsync - (>= unsync wl-folder-many-unsync-threshold)) - 'wl-highlight-folder-many-face) - (t - 'wl-highlight-folder-few-face)))) - (put-text-property bol eol 'face fsymbol)) - (let ((highlights (list "opened" "closed")) - fregexp fsymbol bol eol matched type extent num type) - (beginning-of-line) - (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) - (catch 'highlighted - (while highlights - (setq fregexp (symbol-value - (intern (format "wl-highlight-folder-%s-regexp" - (car highlights))))) - (setq fsymbol (intern (format "wl-highlight-folder-%s-face" - (car highlights)))) - (when (looking-at fregexp) - (put-text-property bol eol 'face fsymbol) - (setq matched t) - (throw 'highlighted nil)) - (setq highlights (cdr highlights))))))) + (end-of-line) + (let ((eol (point)) + bol) + (beginning-of-line) + (setq bol (point)) + (let ((text-face (cond ((looking-at wl-highlight-folder-opened-regexp) + 'wl-highlight-folder-opened-face) + ((looking-at wl-highlight-folder-closed-regexp) + 'wl-highlight-folder-closed-face)))) + (if (and wl-highlight-folder-by-numbers + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" eol t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond ((and unsync (zerop unsync)) + (if (and unread (> unread 0)) + 'wl-highlight-folder-unread-face + 'wl-highlight-folder-zero-face)) + ((and unsync + (>= unsync wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property bol (match-beginning 0) 'face text-face) + (put-text-property (match-beginning 0) (match-end 0) + 'face face)) + (put-text-property bol (match-end 0) 'face face))) + (put-text-property bol eol 'face text-face))))) (defun-hilit2 wl-highlight-summary-line-string (line mark temp-mark indent) (let (fsymbol) @@ -814,7 +818,7 @@ (put-text-property 0 (length line) 'face fsymbol line)) (if wl-use-highlight-mouse-line (put-text-property 0 (length line) 'mouse-face 'highlight line))) - + (defun-hilit2 wl-highlight-summary-current-line (&optional smark regexp temp-too) (interactive) (save-excursion @@ -921,12 +925,6 @@ Variables used: (wl-highlight-folder-current-line) (forward-line 1))))))) -(if (not wl-on-nemacs) - (defsubst wl-delete-all-overlays () - (mapcar (lambda (x) - (delete-overlay x)) - (overlays-in (point-min) (point-max))))) - (defun-hilit2 wl-highlight-folder-path (folder-path) "Highlight current folder path...overlay" (save-excursion @@ -958,7 +956,7 @@ Variables used: "For evaluation" (interactive) (wl-highlight-summary (point-min)(point-max))) - + (defun-hilit2 wl-highlight-summary (start end) "Highlight summary between start and end. Faces used: diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 8d7adc1..7f11536 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -25,10 +25,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (eval-when-compile (require 'wl-folder) @@ -53,54 +53,46 @@ Special commands: "Highlight current folder line." (interactive) (save-excursion - (let ((highlights (list "opened" "closed")) + (end-of-line) + (let ((end (point)) + (start (progn (beginning-of-line) (point))) (inhibit-read-only t) - (fld-name (wl-folder-get-folder-name-by-id - (get-text-property (point) 'wl-folder-entity-id))) - fregexp fsymbol bol eol matched type extent num type) - (beginning-of-line) - (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) - (if (and numbers (nth 0 numbers) (nth 1 numbers)) - (progn - (setq fsymbol - (let ((unsync (nth 0 numbers)) - (unread (nth 1 numbers))) - (cond ((and unsync (eq unsync 0)) - (if (and unread (> unread 0)) - 'wl-highlight-folder-unread-face - 'wl-highlight-folder-zero-face)) - ((and unsync - (>= unsync wl-folder-many-unsync-threshold)) - 'wl-highlight-folder-many-face) - (t - 'wl-highlight-folder-few-face)))) - (put-text-property bol eol 'face fsymbol) - (setq matched t))) - (catch 'highlighted - (while highlights - (setq fregexp (symbol-value - (intern (format "wl-highlight-folder-%s-regexp" - (car highlights))))) - (if (not wl-highlight-group-folder-by-numbers) - (setq fsymbol (intern (format "wl-highlight-folder-%s-face" - (car highlights))))) - (when (looking-at fregexp) - (put-text-property bol eol 'face fsymbol) - (setq matched t) - (throw 'highlighted nil)) - (setq highlights (cdr highlights)))) - (if (not matched) - (if (looking-at (format "^[ ]*\\(%s\\|%s\\)" - wl-folder-unsubscribe-mark - wl-folder-removed-mark)) - (put-text-property bol eol 'face - 'wl-highlight-folder-killed-face) - (put-text-property bol eol 'face - 'wl-highlight-folder-unknown-face))) - (if wl-use-highlight-mouse-line - (wl-highlight-folder-mouse-line))))) - + (text-face + (cond ((looking-at wl-highlight-folder-opened-regexp) + 'wl-highlight-folder-opened-face) + ((looking-at wl-highlight-folder-closed-regexp) + 'wl-highlight-folder-closed-face) + (t + (if (looking-at (format "^[ \t]*\\(%s\\|%s\\)" + wl-folder-unsubscribe-mark + wl-folder-removed-mark)) + 'wl-highlight-folder-killed-face + 'wl-highlight-folder-unknown-face))))) + (if (and wl-highlight-folder-by-numbers + numbers (nth 0 numbers) (nth 1 numbers) + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" end t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond + ((and unsync (zerop unsync)) + (if (and unread (zerop unread)) + 'wl-highlight-folder-zero-face + 'wl-highlight-folder-unread-face)) + ((and unsync + (>= unsync wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property start (match-beginning 0) 'face text-face) + (put-text-property (match-beginning 0) (point) 'face face)) + (put-text-property start (point) 'face face)) + (goto-char start)) + (put-text-property start end 'face text-face))) + (when wl-use-highlight-mouse-line + (wl-highlight-folder-mouse-line)))) + (defun wl-highlight-plugged-current-line ()) (defun wl-plugged-set-folder-icon (folder string) string) @@ -108,10 +100,6 @@ Special commands: (defun wl-folder-init-icons ()) ; dummy. (defun wl-plugged-init-icons ()) ; dummy. -(defun wl-xmas-setup-folder ()) ; dummy -(defun wl-xmas-setup-summary ()) -(defun wl-xmas-setup-draft-toolbar ()) - (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) diff --git a/wl/wl-nemacs.el b/wl/wl-nemacs.el index bb48858..e68d62d 100644 --- a/wl/wl-nemacs.el +++ b/wl/wl-nemacs.el @@ -29,11 +29,6 @@ ;;; Code: ;; -(defun wl-xmas-setup-folder ()) ; dummy -(defun wl-xmas-setup-summary ()) -(defun wl-xmas-setup-draft-toolbar ()) - -(defun wl-summary-setup-mouse ()) (defun wl-message-overload-functions () (local-set-key "l" 'wl-message-toggle-disp-summary)) @@ -49,7 +44,6 @@ (defun wl-highlight-summary-line-string (line mark indent before-indent)) (defun wl-highlight-body-region (beg end)) (defun wl-highlight-message (start end hack-sig &optional body-only)) -(defun wl-delete-all-overlays ()) (defun wl-highlight-summary-current-line (&optional smark regexp temp-too)) (defun wl-highlight-plugged-current-line ()) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index f8029af..6e5f057 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -753,6 +753,8 @@ Returns nil if selecting folder was in failure." ;; Avoid byte-compile warning. (eval-when-compile + (unless wl-on-xemacs + (defalias 'wl-xmas-setup-summary 'ignore)) (unless wl-on-emacs21 (defalias 'wl-e21-setup-summary 'ignore))) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index fef2f22..9cd87ce 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'elmo-vars) @@ -531,7 +531,7 @@ Default is for 'reply-to-author'." (repeat :tag "Fields For Cc" string) (repeat :tag "Fields For Newsgroups" string)))) :group 'wl-draft) - + (defcustom wl-draft-reply-without-argument-list '(("Followup-To" . (nil nil ("Followup-To"))) ("Mail-Followup-To" . (("Mail-Followup-To") nil ("Newsgroups"))) @@ -575,7 +575,7 @@ Default is for 'reply-to-all'." :type 'boolean :group 'wl-draft) -;;;; +;;;; (defcustom wl-init-file "~/.wl" "*User customization setting file." :type 'file @@ -1809,7 +1809,7 @@ list : reserved specified permanent marks." "*If the summary is larger than this lines, don't highlight it." :type 'integer :group 'wl-highlight) - + ;; highilght about draft and message (defcustom wl-highlight-body-too t "*In addition to header, highlight the body too. if non nil." @@ -1881,7 +1881,7 @@ uuencoded files and large digests. If this is nil, all messages will be highlighted." :type 'integer :group 'wl-highlight) - + ;; highilght about signature (of draft and message) (defcustom wl-highlight-signature-separator '("\n--+\n" "\n\n--+.*\n*\\'") @@ -1898,14 +1898,14 @@ This variable can also be a regex. " "*If the signature is larger than this chars, don't treat it as a signature." :type 'integer :group 'wl-highlight) - + ;; highilght about mouse (defcustom wl-use-highlight-mouse-line (and (or wl-on-xemacs wl-on-emacs21) window-system) "*Highlight mouse line, if non nil." :type 'boolean :group 'wl-highlight) - + ;; highilght about folder (defcustom wl-highlight-folder-with-icon (or (and (featurep 'xemacs) @@ -1914,9 +1914,12 @@ This variable can also be a regex. " "*Highlight folder with icon(XEmacs or Emacs 21)." :type 'boolean :group 'wl-highlight) -(defcustom wl-highlight-group-folder-by-numbers t - "*Highlight group folder by numbers." - :type 'boolean +(defcustom wl-highlight-folder-by-numbers t + "Highlight folder lines by numbers. If it is a number, only numbers +will be highlighted." + :type '(choice (const :tag "whole line" t) + (const :tag "only numbers" 1) + (const :tag "don't highlight" nil)) :group 'wl-highlight) (defcustom wl-highlight-signature-search-func 'wl-highlight-signature-search diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 698f1d4..5a9af6a 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -24,10 +24,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (eval-when-compile (require 'wl-folder) @@ -37,26 +37,6 @@ (require 'wl-highlight) (defvar-maybe wl-draft-mode-map (make-sparse-keymap))) -(defun wl-xmas-setup-toolbar (bar) - (let ((dir wl-icon-dir) - icon up down disabled name) - (when dir - (while bar - (setq icon (aref (car bar) 0) - name (symbol-name icon) - bar (cdr bar)) - (when (not (boundp icon)) - (setq up (concat dir elmo-path-sep name "-up.xpm")) - (setq down (concat dir elmo-path-sep name "-down.xpm")) - (setq disabled (concat dir elmo-path-sep name "-disabled.xpm")) - (if (not (file-exists-p up)) - (setq bar nil - dir nil) - (set icon (toolbar-make-button-list - up (and (file-exists-p down) down) - (and (file-exists-p disabled) disabled))))))) - dir)) - (defvar wl-use-toolbar (if (featurep 'toolbar) 'default-toolbar nil)) (defvar wl-plugged-glyph nil) (defvar wl-unplugged-glyph nil) @@ -70,8 +50,8 @@ wl-folder-prev-entity t "Previous Folder"] [wl-folder-check-current-entity wl-folder-check-current-entity t "Check Current Folder"] -; [wl-draft -; wl-draft t "Write a New Message"] + ;;[wl-draft + ;; wl-draft t "Write a New Message"] [wl-folder-sync-current-entity wl-folder-sync-current-entity t "Sync Current Folder"] [wl-draft @@ -127,7 +107,7 @@ ) "The Message buffer toolbar.") -(defalias 'wl-draft-insert-signature 'insert-signature) ;; for draft toolbar. +(defalias 'wl-draft-insert-signature 'insert-signature);; for draft toolbar. (defvar wl-draft-toolbar '([wl-draft-send-from-toolbar @@ -141,120 +121,192 @@ ) "The Draft buffer toolbar.") -(defun wl-xmas-setup-folder-toolbar () - (and wl-use-toolbar - (wl-xmas-setup-toolbar wl-folder-toolbar) - (set-specifier (symbol-value wl-use-toolbar) - (cons (current-buffer) wl-folder-toolbar)))) - -(defun wl-xmas-setup-summary-toolbar () - (and wl-use-toolbar - (wl-xmas-setup-toolbar wl-summary-toolbar) - (set-specifier (symbol-value wl-use-toolbar) - (cons (current-buffer) wl-summary-toolbar)))) - -(defun wl-xmas-setup-message-toolbar () - (and wl-use-toolbar - (wl-xmas-setup-toolbar wl-message-toolbar) - (set-specifier (symbol-value wl-use-toolbar) - (cons (current-buffer) wl-message-toolbar)))) - -(defun wl-xmas-setup-draft-toolbar () - (and wl-use-toolbar - (wl-xmas-setup-toolbar wl-draft-toolbar) - (set-specifier (symbol-value wl-use-toolbar) - (cons (current-buffer) wl-draft-toolbar)))) - -;; XEmacs implementations. +(defun wl-xmas-setup-toolbar (bar) + (let ((dir wl-icon-dir) + icon up down disabled name) + (when dir + (while bar + (setq icon (aref (car bar) 0) + name (symbol-name icon) + bar (cdr bar)) + (unless (boundp icon) + (setq up (expand-file-name (concat name "-up.xpm") dir) + down (expand-file-name (concat name "-down.xpm") dir) + disabled (expand-file-name (concat name "-disabled.xpm") dir)) + (if (file-exists-p up) + (set icon (toolbar-make-button-list + up (and (file-exists-p down) down) + (and (file-exists-p disabled) disabled))) + (setq bar nil + dir nil))))) + dir)) + +(defun wl-xmas-make-icon-glyph (icon-string icon-file + &optional locale tag-set) + (let ((glyph (make-glyph (vector 'string :data icon-string)))) + (when wl-highlight-folder-with-icon + (set-glyph-image glyph + (vector 'xpm :file (expand-file-name + icon-file wl-icon-dir)) + locale tag-set 'prepend)) + glyph)) + +(eval-when-compile + (defsubst wl-xmas-setup-folder-toolbar () + (and wl-use-toolbar + (wl-xmas-setup-toolbar wl-folder-toolbar) + (set-specifier (symbol-value wl-use-toolbar) + (cons (current-buffer) wl-folder-toolbar)))) + + (defsubst wl-xmas-setup-summary-toolbar () + (and wl-use-toolbar + (wl-xmas-setup-toolbar wl-summary-toolbar) + (set-specifier (symbol-value wl-use-toolbar) + (cons (current-buffer) wl-summary-toolbar)))) + + (defsubst wl-xmas-setup-message-toolbar () + (and wl-use-toolbar + (wl-xmas-setup-toolbar wl-message-toolbar) + (set-specifier (symbol-value wl-use-toolbar) + (cons (current-buffer) wl-message-toolbar)))) + + (defsubst wl-xmas-setup-draft-toolbar () + (and wl-use-toolbar + (wl-xmas-setup-toolbar wl-draft-toolbar) + (set-specifier (symbol-value wl-use-toolbar) + (cons (current-buffer) wl-draft-toolbar))))) + +(defvar wl-folder-toggle-icon-list + '((wl-folder-opened-glyph . wl-opened-group-folder-icon) + (wl-folder-closed-glyph . wl-closed-group-folder-icon))) + +(eval-when-compile + (defsubst wl-xmas-highlight-folder-group-line (glyph text-face numbers) + (let ((start (match-beginning 1)) + (end (match-end 1))) + (let (extent) + (while (and (setq extent (extent-at start nil nil extent 'at)) + (not (and (eq start (extent-start-position extent)) + (eq end (extent-end-position extent)) + (extent-end-glyph extent))))) + (unless extent + (setq extent (make-extent start end))) + (set-extent-properties extent `(end-open t start-closed t invisible t)) + (set-extent-end-glyph + extent + (or (get glyph 'glyph) + (put glyph 'glyph + (wl-xmas-make-icon-glyph + (buffer-substring-no-properties start end) + (symbol-value + (cdr (assq glyph wl-folder-toggle-icon-list)))))))) + (let ((inhibit-read-only t)) + (when wl-use-highlight-mouse-line + (put-text-property start (point-at-eol) 'mouse-face 'highlight)) + (setq start end + end (point-at-eol)) + (if (and wl-highlight-folder-by-numbers + numbers (nth 0 numbers) (nth 1 numbers) + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" end t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond ((and unsync (zerop unsync)) + (if (and unread (zerop unread)) + 'wl-highlight-folder-zero-face + 'wl-highlight-folder-unread-face)) + ((and unsync + (>= unsync + wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property start (match-beginning 0) + 'face text-face) + (put-text-property (match-beginning 0) (point) 'face face)) + (put-text-property start end 'face face))) + (put-text-property start end 'face text-face)))))) + (defun wl-highlight-folder-current-line (&optional numbers) (interactive) (save-excursion - (let ((highlights (list "opened" "closed")) - (inhibit-read-only t) - (fld-name (wl-folder-get-folder-name-by-id - (get-text-property (point) 'wl-folder-entity-id))) - fregexp fsymbol bol eol matched type extent num type glyph) - (setq eol (progn (end-of-line) (point)) - bol (progn (beginning-of-line) (point))) - (when (and fld-name (looking-at "[ \t]+\\([^ \t]+\\)")) - (if (and (setq extent (extent-at (match-beginning 1) nil nil nil 'at)) - (extent-begin-glyph extent)) - (delete-extent extent)) - (setq extent (make-extent (match-beginning 1) (match-beginning 1))) - (cond - ((string= fld-name wl-trash-folder) ;; set trash folder icon - (setq num (nth 2 numbers)) ;; number of messages - (set-extent-begin-glyph extent - (if (or (null num) - (eq num 0)) - wl-folder-trash-empty-glyph - wl-folder-trash-glyph))) - ((string= fld-name wl-draft-folder) ;; set draft folder icon - (set-extent-begin-glyph extent wl-folder-draft-glyph)) - ((string= fld-name wl-queue-folder) - (set-extent-begin-glyph extent wl-folder-queue-glyph)) - ((and (setq type (elmo-folder-get-type fld-name)) - (or numbers ;; XXX dirty...!! - (not (assoc fld-name wl-folder-group-alist)))) - ;; not group folder. - (set-extent-begin-glyph extent - (symbol-value - (intern (format "wl-folder-%s-glyph" - type))))))) - (when (and numbers (nth 0 numbers) (nth 1 numbers)) - (setq fsymbol - (let ((unsync (nth 0 numbers)) - (unread (nth 1 numbers))) - (cond ((and unsync (eq unsync 0)) - (if (and unread (> unread 0)) - 'wl-highlight-folder-unread-face - 'wl-highlight-folder-zero-face)) - ((and unsync - (>= unsync wl-folder-many-unsync-threshold)) - 'wl-highlight-folder-many-face) - (t - 'wl-highlight-folder-few-face)))) - (put-text-property bol eol 'face nil) - (put-text-property bol eol 'face fsymbol) - (setq matched t)) - (while highlights - (setq fregexp (symbol-value - (intern (format "wl-highlight-folder-%s-regexp" - (car highlights))))) - (if (not wl-highlight-group-folder-by-numbers) - (setq fsymbol (intern (format "wl-highlight-folder-%s-face" - (car highlights))))) - (when (looking-at fregexp) - (setq extent (make-extent (match-beginning 1) (match-end 1)) - glyph (intern (format "wl-folder-%s-glyph" - (car highlights)))) - (if (null (symbol-value glyph)) - (set glyph (wl-xmas-make-icon-glyph - (extent-string extent) - (symbol-value - (cdr (assq glyph wl-folder-toggle-icon-list)))))) - (setq glyph (symbol-value glyph)) - (set-extent-property extent 'end-open t) - (set-extent-property extent 'start-closed t) - (set-extent-property extent 'invisible t) - (set-extent-end-glyph extent glyph) - (put-text-property bol eol 'face nil) - (put-text-property bol eol 'face fsymbol) - (setq matched t highlights nil)) - (setq highlights (cdr highlights))) - (when (not matched) - (put-text-property bol eol 'face nil) - (if (looking-at (format "^[ ]*\\(%s\\|%s\\)" - wl-folder-unsubscribe-mark - wl-folder-removed-mark)) - (put-text-property bol eol 'face - 'wl-highlight-folder-killed-face) - (put-text-property bol eol 'face - 'wl-highlight-folder-unknown-face))) - (if wl-use-highlight-mouse-line - (wl-highlight-folder-mouse-line)) - (if (and (featurep 'dragdrop) wl-use-dnd) - (wl-dnd-set-drop-target bol eol))))) + (beginning-of-line) + (let (fld-name extent) + (cond + (;; opened folder group + (looking-at wl-highlight-folder-opened-regexp) + (wl-xmas-highlight-folder-group-line 'wl-folder-opened-glyph + 'wl-highlight-folder-opened-face + numbers)) + (;; closed folder group + (looking-at wl-highlight-folder-closed-regexp) + (wl-xmas-highlight-folder-group-line 'wl-folder-closed-glyph + 'wl-highlight-folder-closed-face + numbers)) + (;; basic folder + (and (setq fld-name (wl-folder-get-folder-name-by-id + (get-text-property (point) 'wl-folder-entity-id))) + (looking-at "[ \t]+\\([^ \t]+\\)")) + (let ((start (match-beginning 1))) + (let (extent) + (while (and (setq extent (extent-at start nil nil extent 'at)) + (not (and (eq start (extent-start-position extent)) + (eq start (extent-end-position extent)) + (extent-begin-glyph extent))))) + (unless extent + (setq extent (make-extent start start))) + (let (type) + (set-extent-begin-glyph + extent + (cond + ((string= fld-name wl-trash-folder);; trash folder + (let ((num (nth 2 numbers)));; number of messages + (get (if (or (not num) (zerop num)) + 'wl-folder-trash-empty-glyph + 'wl-folder-trash-glyph) + 'glyph))) + ((string= fld-name wl-draft-folder);; draft folder + (get 'wl-folder-draft-glyph 'glyph)) + ((string= fld-name wl-queue-folder);; queue folder + (get 'wl-folder-queue-glyph 'glyph)) + (;; and one of many other folders + (setq type (elmo-folder-get-type fld-name)) + (get (intern (format "wl-folder-%s-glyph" type)) 'glyph)))))) + (let ((end (point-at-eol))) + (when wl-use-highlight-mouse-line + (put-text-property start end 'mouse-face 'highlight)) + (let ((text-face + (if (looking-at (format "^[ \t]*\\(%s\\|%s\\)" + wl-folder-unsubscribe-mark + wl-folder-removed-mark)) + 'wl-highlight-folder-killed-face + 'wl-highlight-folder-unknown-face))) + (if (and wl-highlight-folder-by-numbers + numbers (nth 0 numbers) (nth 1 numbers) + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" end t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond + ((and unsync (zerop unsync)) + (if (and unread (zerop unread)) + 'wl-highlight-folder-zero-face + 'wl-highlight-folder-unread-face)) + ((and unsync + (>= unsync + wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property start (match-beginning 0) + 'face text-face) + (put-text-property (match-beginning 0) + (match-end 0) + 'face face)) + (put-text-property start (match-end 0) 'face face))) + (put-text-property start end 'face text-face)))))))))) (defun wl-highlight-plugged-current-line () (interactive) @@ -264,9 +316,9 @@ (beginning-of-line) (when (looking-at "[ \t]*\\(\\[\\([^]]+\\)\\]\\)") (setq switch (elmo-match-buffer 2)) - (if (and (setq extent (extent-at (match-end 1) nil nil nil 'at)) - (extent-end-glyph extent)) - (delete-extent extent)) + (when (and (setq extent (extent-at (match-end 1) nil nil nil 'at)) + (extent-end-glyph extent)) + (delete-extent extent)) (setq extent (make-extent (match-beginning 1) (match-end 1))) (set-extent-property extent 'end-open t) (set-extent-property extent 'start-closed t) @@ -280,12 +332,14 @@ (len (length string)) type) (if (string= folder wl-queue-folder) - (put-text-property 0 len 'begin-glyph wl-folder-queue-glyph string) + (put-text-property 0 len 'begin-glyph + (get 'wl-folder-queue-glyph 'glyph) + string) (if (setq type (elmo-folder-get-type folder)) (put-text-property 0 len 'begin-glyph - (symbol-value - (intern (format "wl-folder-%s-glyph" type))) + (get (intern (format "wl-folder-%s-glyph" type)) + 'glyph) string))) string)) @@ -307,53 +361,37 @@ (wl-folder-queue-glyph . wl-queue-folder-icon) (wl-folder-trash-glyph . wl-trash-folder-icon))) -(defvar wl-folder-toggle-icon-list - '((wl-folder-opened-glyph . wl-opened-group-folder-icon) - (wl-folder-closed-glyph . wl-closed-group-folder-icon))) - -(defun wl-xmas-make-icon-glyph (icon-string icon-file &optional locale tag-set) - (let ((glyph (make-glyph (vector 'string :data icon-string)))) - (if wl-highlight-folder-with-icon - (set-glyph-image glyph - (vector 'xpm :file (expand-file-name - icon-file wl-icon-dir)) - locale tag-set 'prepend)) - glyph)) - (defun wl-folder-init-icons () (mapcar (lambda (x) - (if (null (symbol-value (car x))) - (set (car x) (wl-xmas-make-icon-glyph "" (symbol-value (cdr x)))))) + (unless (get (car x) 'glyph) + (put (car x) 'glyph + (wl-xmas-make-icon-glyph "" (symbol-value (cdr x)))))) 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)) + (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)))) + (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)) + (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))))) + (setq wl-plug-state-indicator-off (cons extent wl-unplugged-glyph))))) (defun wl-make-date-string () (let ((s (current-time-string))) @@ -395,10 +433,10 @@ (select-window (event-window event)) (set-buffer cur-buf) (setq proceed (wl-message-next-page))) - (if proceed - (if (memq 'shift (event-modifiers event)) - (wl-summary-down t) - (wl-summary-next t))))) + (when proceed + (if (memq 'shift (event-modifiers event)) + (wl-summary-down t) + (wl-summary-next t))))) (defun wl-message-wheel-down (event) (interactive "e") @@ -408,10 +446,10 @@ (select-window (event-window event)) (set-buffer cur-buf) (setq proceed (wl-message-prev-page))) - (if proceed - (if (memq 'shift (event-modifiers event)) - (wl-summary-up t) - (wl-summary-prev t))))) + (when proceed + (if (memq 'shift (event-modifiers event)) + (wl-summary-up t) + (wl-summary-prev t))))) (defun wl-draft-overload-menubar () (when (featurep 'menubar) @@ -455,7 +493,7 @@ Special commands: (if wl-show-plug-status-on-modeline '("" wl-plug-state-indicator "Wanderlust: %12b") '("Wanderlust: %12b")))) - (local-set-key "\C-c\C-s" 'wl-draft-send) ; override + (local-set-key "\C-c\C-s" 'wl-draft-send);; override (wl-xmas-setup-draft-toolbar) (wl-draft-overload-menubar))