;;; wl-mule.el -- Wanderlust modules for Mule compatible Emacsen.
;; (Mule2.3@19.28, Mule2.3@19.34, Emacs 20.x)
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
;;
;;; 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))
+ ;; Remove previous face.
+ (put-text-property start (point) 'face nil)
+ (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)
(local-set-key [mouse-4] 'wl-message-wheel-down)
(local-set-key [mouse-5] 'wl-message-wheel-up)
(local-set-key [S-mouse-4] 'wl-message-wheel-down)
- (local-set-key [S-mouse-5] 'wl-message-wheel-up))
+ (local-set-key [S-mouse-5] 'wl-message-wheel-up)
+ (if (fboundp 'set-keymap-parent)
+ (set-keymap-parent wl-message-button-map (current-local-map)))
+ (define-key wl-message-button-map [mouse-2]
+ 'wl-message-button-dispatcher))
(defun wl-message-wheel-up (event)
(interactive "e")
(local-set-key [menu-bar mail signature]
'("Insert Signature" . insert-signature))
(local-set-key [menu-bar headers fcc]
- '("FCC" . wl-draft-fcc)))
+ '("Fcc" . wl-draft-fcc)))
(defun wl-draft-overload-functions ()
- (setq mode-line-buffer-identification
- (format "Wanderlust: %s" (buffer-name)))
- (local-set-key "\C-c\C-s" 'wl-draft-send) ; override
- (wl-draft-overload-menubar)
- (when wl-show-plug-status-on-modeline
- (setq mode-line-format (wl-make-modeline))))
-
-(defalias 'wl-make-modeline 'wl-make-modeline-subr)
+ (wl-mode-line-buffer-identification)
+ (local-set-key "\C-c\C-s" 'wl-draft-send);; override
+ (wl-draft-overload-menubar))
;; for "ja-mule-canna-2.3.mini" on PocketBSD
(defun-maybe make-face (a))
nil))))
match)))))
-(provide 'wl-mule)
+(defun wl-read-event-char ()
+ "Get the next event."
+ (let ((event (read-event)))
+ (cons (and (numberp event) event) event)))
+
+(require 'product)
+(product-provide (provide 'wl-mule) (require 'wl-version))
;;; wl-mule.el ends here
projects / elisp / wanderlust.git / blobdiff