* 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'.
+2000-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <kaoru@kaisei.org>
* utils/ptexinfmt.el (texinfo-multitable-widths,
(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)))))
@item MH \e$BE*\e(B FCC\e$B!#\e(B(@samp{FCC: %Backup} \e$B$d\e(B @samp{FCC: $Backup} \e$B$b2D\e(B)\e$B!#\e(B
@item MIME \e$BBP1~\e(B (by SEMI or tm)\e$B!#\e(B
@item \e$B%K%e!<%9\e(B/\e$B%a!<%k$NAw?.$rE}9g$7$?%a%C%;!<%8Aw?.%I%i%U%H!#\e(B
-@item \e$B%U%)%k%@0lMw$N%"%$%3%sI=<(\e(B (XEmacs)\e$B!#\e(B
+@item \e$B%U%)%k%@0lMw$N%"%$%3%sI=<(\e(B (XEmacs \e$B$H\e(B Emacs 21)\e$B!#\e(B
@item \e$BBg$-$J%Q!<%H$r<h$j4s$;$:$KI=<(\e(B(IMAP4)\e$B!#\e(B
@item \e$B%a%C%;!<%8$N8!:w$r%5!<%PB&$G<B9T\e(B(IMAP4)\e$B!#F|K\8l8!:w$b2D!#\e(B
@item \e$B2>A[%U%)%k%@!#\e(B
(autoload 'wl "wl" "Wanderlust" t)
(autoload 'wl-draft "wl-draft" "Write draft with Wanderlust." t)
-;; @r{\e$B%"%$%3%s$rCV$/%G%#%l%/%H%j\e(B (XEmacs \e$B$N$_\e(B)\e$B!#=i4|@_Dj$O\e(B @code{nil}\e$B!#\e(B}
+;; @r{\e$B%"%$%3%s$rCV$/%G%#%l%/%H%j\e(B (XEmacs \e$B$H\e(B Emacs 21)\e$B!#=i4|@_Dj$O\e(B @code{nil}\e$B!#\e(B}
;; @r{(XEmacs \e$B$N\e(B package \e$B$H$7$F%$%s%9%H!<%k$5$l$F$$$k>l9g!"I,MW$"$j$^$;$s\e(B)}
(setq wl-icon-dir "~/work/wl/etc")
\e$B=i4|@_Dj$O\e(B 70\e$B!#\e(B
\e$BL$F14|?t$,$?$/$5$s$+$I$&$+$NogCM!#$3$NCM$r1[$($k$H?'$,JQ$o$j$^$9!#\e(B
+@item wl-highlight-folder-by-numbers
+@vindex wl-highlight-folder-by-numbers
+\e$B%U%)%k%@%P%C%U%!$K$*$1$k3F9T$N%O%$%i%$%H$N7A<0$r;XDj$7$^$9!#=i4|CM$O\e(B
+@code{t} \e$B$G!"9TA4BN$K%a%C%;!<%8?t$K1~$8$??'$rIU$1$^$9!#\e(B@code{nil} \e$B$G$O%U%)\e(B
+\e$B%k%@$N>uBV$K1~$8$??'$rIU$1$^$9!#$^$?!"?t;z\e(B (\e$BNc$($P\e(B @code{1}) \e$B$K$7$F$*$/\e(B
+\e$B$H!"%a%C%;!<%8?t$H%U%)%k%@$N>uBV$NN>J}$K1~$8$?%O%$%i%$%H$,9T$J$o$l$^$9!#\e(B
+
@item wl-folder-desktop-name
@vindex wl-folder-desktop-name
\e$B=i4|@_Dj$O\e(B @samp{Desktop}\e$B!#\e(B
\e$B$^$?!"\e(B2\e$B9TL\0J9_$G$O%5!<%P$H%]!<%H$N%*%s%i%$%s$H%*%U%i%$%s>uBV$rI=<($7!"\e(B
@samp{[ON]} \e$B$O$=$N%5!<%P$d%]!<%H$,%*%s%i%$%s$G$"$k$3$H$r!"\e(B
@samp{[--]} \e$B$O%*%U%i%$%s$G$"$k$3$H$r<($7$F$$$^$9\e(B
-(XEmacs \e$B$G$O%"%$%3%s$GI=<($5$l$^$9\e(B)\e$B!#\e(B
+(XEmacs \e$B$H\e(B Emacs 21 \e$B$G$O%"%$%3%s$GI=<($5$l$^$9\e(B)\e$B!#\e(B
\e$B$=$7$F$=$l$>$l$N9T$G\e(B @kbd{@key{SPC}} \e$B$d\e(B @kbd{@key{RET}} \e$B$r2!$9$3$H$G\e(B
\e$B>uBV$r@Z$jBX$($k$3$H$,$G$-$^$9!#\e(B
@item wl-highlight-folder-opened-face
\e$B%U%)%k%@%b!<%I$G!"3+$$$?%0%k!<%W$K$D$/\e(B face \e$B$G$9!#\e(B
-\e$BJQ?t\e(B @code{wl-highlight-group-folder-by-numbers} \e$B$,\e(B nil \e$B$N$H$-M-8z$G$9!#\e(B
+\e$BJQ?t\e(B @code{wl-highlight-folder-by-numbers} \e$B$,\e(B @code{nil} \e$B$+\e(B @dfn{\e$B?t\e(B} \e$B$N\e(B
+\e$B$H$-M-8z$G$9!#\e(B
@item wl-highlight-folder-closed-face
\e$B%U%)%k%@%b!<%I$G!"JD$8$?%0%k!<%W$K$D$/\e(B face \e$B$G$9!#\e(B
-\e$BJQ?t\e(B @code{wl-highlight-group-folder-by-numbers} \e$B$,\e(B nil \e$B$N$H$-M-8z$G$9!#\e(B
+\e$BJQ?t\e(B @code{wl-highlight-folder-by-numbers} \e$B$,\e(B @code{nil} \e$B$+\e(B @dfn{\e$B?t\e(B} \e$B$N\e(B
+\e$B$H$-M-8z$G$9!#\e(B
@item wl-highlight-folder-path-face
\e$B%U%)%k%@%b!<%I$G!"8=:_A*BrCf$N%U%)%k%@$^$G$N%Q%9$K$D$/\e(B face \e$B$G$9!#\e(B
@item wl-highlight-folder-with-icon
@vindex wl-highlight-folder-with-icon
-XEmacs \e$B$N$_M-8z$G$9!#=i4|@_Dj$O\e(B XEmacs \e$B$K0MB8$7$^$9\e(B(\e$B%"%$%3%s$r;HMQ$G$-$k\e(B
-XEmacs \e$B$G$O\e(B t \e$B$K$J$j$^$9\e(B)\e$B!#\e(B
+XEmacs \e$B$^$?$O\e(B Emacs 21 \e$B$GM-8z$G$9!#=i4|@_Dj$O$=$N\e(B (X)Emacs \e$B$K0MB8$7$^$9\e(B
+(\e$B%"%$%3%s$r;HMQ$G$-$k\e(B (X)Emacs \e$B$G$O\e(B t \e$B$K$J$j$^$9\e(B)\e$B!#\e(B
@item wl-strict-diff-folders
@vindex wl-strict-diff-folders
@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.
(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")
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}.
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}
@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
@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
+2000-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <teranisi@gohome.org>
* wl.el (wl): Initialize plug-related settings before `wl-init'.
(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)
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)
(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)))
(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)
(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)
(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)
;; 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)))
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(if (and (featurep 'xemacs)
(featurep 'dragdrop))
(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))
() ; 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)
(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)
(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
(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
"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:
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile
(require 'wl-folder)
"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)
(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)
;;; 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))
(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 ())
;; 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)))
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'elmo-vars)
(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")))
:type 'boolean
:group 'wl-draft)
-;;;;
+;;;;
(defcustom wl-init-file "~/.wl"
"*User customization setting file."
:type 'file
"*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."
be highlighted."
:type 'integer
:group 'wl-highlight)
-
+
;; highilght about signature (of draft and message)
(defcustom wl-highlight-signature-separator
'("\n--+\n" "\n\n--+.*\n*\\'")
"*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)
"*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
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile
(require 'wl-folder)
(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)
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
)
"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
)
"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)
(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)
(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))
(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)))
(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")
(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)
(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))
projects / elisp / wanderlust.git / commitdiff