X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-mule.el;h=ad63c74ebff9bdb147de9ade7caf2428ef2dee21;hb=222ed6f3293eb94760d791eee910f5b8b1556d1e;hp=900bf785f6b058f16d44980595fa7b29da28c151;hpb=e3e5f572d472484c24a40f53375103b9c9a0a7a9;p=elisp%2Fwanderlust.git diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 900bf78..ad63c74 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -1,7 +1,7 @@ ;;; 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 +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news @@ -25,10 +25,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (eval-when-compile (require 'wl-folder) @@ -53,72 +53,63 @@ 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)) + ;; 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") @@ -183,14 +174,9 @@ Special commands: '("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)) @@ -293,6 +279,12 @@ Warning: Unknown req `%S' with options `%S'" req options)) 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