X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-e21.el;h=ad3a99fabddf680896eca002f76f484d5cefc2fc;hb=ae56e2b3b791ee7f880a935b5df69903829796ca;hp=70483af89a1b8289d3a67c0d68148b476fcef92b;hpb=10a95fa561ec82f555499e359e703a69eaecbad5;p=elisp%2Fwanderlust.git diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 70483af..ad3a99f 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -1,7 +1,7 @@ ;;; wl-e21.el -- Wanderlust modules for Emacs 21. -;; Copyright 2000 Katsumi Yamaoka -;; Yuuichi Teranishi +;; Copyright (C) 2000,2001 Katsumi Yamaoka +;; Copyright (C) 2000,2001 Yuuichi Teranishi ;; Author: Katsumi Yamaoka ;; Keywords: mail, net news @@ -54,10 +54,15 @@ ;; (overlay-put overlay 'wl-e21-icon t) ;; ;; Make it to be removable. ;; (overlay-put overlay 'evaporate t)) +;; +;; Note that a port of Emacs to some platforms (e.g. MS-Windoze) does +;; not yet support images. It is a pity that neither icons nor tool- +;; bars will not be displayed in such systems. ;;; Code: ;; +(require 'elmo) (eval-when-compile (require 'wl-folder) (require 'wl-summary) @@ -72,8 +77,6 @@ (add-hook 'wl-init-hook 'wl-biff-init-icons) (add-hook 'wl-init-hook 'wl-plugged-init-icons) -;; (add-hook 'wl-make-plugged-hook 'wl-biff-init-icons) -;; (add-hook 'wl-make-plugged-hook 'wl-plugged-init-icons) (add-hook 'wl-summary-mode-hook 'wl-setup-summary) @@ -163,27 +166,34 @@ ) "The Draft buffer toolbar.") +(eval-when-compile + (defmacro wl-e21-display-image-p () + '(and (display-graphic-p) + (image-type-available-p 'xpm)))) + (defun wl-e21-setup-toolbar (bar) - (let ((load-path (cons wl-icon-dir load-path)) - (props '(:type xpm :ascent center - :color-symbols (("backgroundToolBarColor" . "None")) - :file)) - (success t) - icon up down disabled name success) - (while bar - (setq icon (aref (pop bar) 0)) - (unless (boundp icon) - (setq name (symbol-name icon) - up (find-image `((,@props ,(concat name "-up.xpm"))))) - (if up - (progn - (setq down (find-image `((,@props ,(concat name "-down.xpm")))) - disabled (find-image `((,@props - ,(concat name "-disabled.xpm"))))) - (set icon (vector down up disabled disabled))) - (setq bar nil - success nil)))) - success)) + (when (and wl-use-toolbar + (wl-e21-display-image-p)) + (let ((load-path (cons wl-icon-dir load-path)) + (props '(:type xpm :ascent center + :color-symbols (("backgroundToolBarColor" . "None")) + :file)) + (success t) + icon up down disabled name success) + (while bar + (setq icon (aref (pop bar) 0)) + (unless (boundp icon) + (setq name (symbol-name icon) + up (find-image `((,@props ,(concat name "-up.xpm"))))) + (if up + (progn + (setq down (find-image `((,@props ,(concat name "-down.xpm")))) + disabled (find-image + `((,@props ,(concat name "-disabled.xpm"))))) + (set icon (vector down up disabled disabled))) + (setq bar nil + success nil)))) + success))) (defvar wl-e21-toolbar-configurations '((auto-resize-tool-bar . t) @@ -213,29 +223,21 @@ :image (symbol-value (aref def 0))))))) (defun wl-e21-setup-folder-toolbar () - (and wl-use-toolbar - (display-graphic-p) - (wl-e21-setup-toolbar wl-folder-toolbar) - (wl-e21-make-toolbar-buttons wl-folder-mode-map wl-folder-toolbar))) + (when (wl-e21-setup-toolbar wl-folder-toolbar) + (wl-e21-make-toolbar-buttons wl-folder-mode-map wl-folder-toolbar))) (defun wl-e21-setup-summary-toolbar () - (and wl-use-toolbar - (display-graphic-p) - (wl-e21-setup-toolbar wl-summary-toolbar) - (wl-e21-make-toolbar-buttons wl-summary-mode-map wl-summary-toolbar))) + (when (wl-e21-setup-toolbar wl-summary-toolbar) + (wl-e21-make-toolbar-buttons wl-summary-mode-map wl-summary-toolbar))) (eval-when-compile (defsubst wl-e21-setup-message-toolbar (keymap) - (and wl-use-toolbar - (display-graphic-p) - (wl-e21-setup-toolbar wl-message-toolbar) - (wl-e21-make-toolbar-buttons keymap wl-message-toolbar))) + (when (wl-e21-setup-toolbar wl-message-toolbar) + (wl-e21-make-toolbar-buttons keymap wl-message-toolbar))) (defsubst wl-e21-setup-draft-toolbar () - (and wl-use-toolbar - (display-graphic-p) - (wl-e21-setup-toolbar wl-draft-toolbar) - (wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar)))) + (when (wl-e21-setup-toolbar wl-draft-toolbar) + (wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar)))) (defvar wl-folder-toggle-icon-list '((wl-folder-opened-image . wl-opened-group-folder-icon) @@ -243,7 +245,7 @@ (eval-when-compile (defsubst wl-e21-highlight-folder-group-line (start end icon numbers) - (when (display-graphic-p) + (when (wl-e21-display-image-p) (let (overlay) (let ((overlays (overlays-in start end))) (while (and (setq overlay (pop overlays)) @@ -332,7 +334,7 @@ (setq start (match-beginning 1) end (match-end 1)) (let (image) - (when (display-graphic-p) + (when (wl-e21-display-image-p) (let (overlay) (let ((overlays (overlays-in start end))) (while (and (setq overlay (pop overlays)) @@ -342,6 +344,8 @@ (overlay-put overlay 'wl-e21-icon t) (overlay-put overlay 'evaporate t)) (let (type) + (unless (get (caar wl-folder-internal-icon-list) 'image) + (wl-folder-init-icons)) (setq image (cond ((string= fld-name wl-trash-folder);; trash folder (let ((num (nth 2 numbers)));; number of messages @@ -354,7 +358,7 @@ ((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)) + (setq type (elmo-folder-type fld-name)) (get (intern (format "wl-folder-%s-image" type)) 'image))))) (overlay-put overlay 'before-string image))) @@ -378,7 +382,7 @@ (defun wl-highlight-plugged-current-line () (interactive) - (when (display-graphic-p) + (when (wl-e21-display-image-p) (save-excursion (beginning-of-line) (when (looking-at "[\t ]*\\(\\[\\([^]]+\\)\\]\\)") @@ -402,13 +406,13 @@ (overlay-put overlay 'invisible t)))))))) (defun wl-plugged-set-folder-icon (folder string) - (if (display-graphic-p) + (if (wl-e21-display-image-p) (let (type) (cond ((string= folder wl-queue-folder) (concat (propertize " " 'display (get 'wl-folder-queue-image 'image)) string)) - ((setq type (elmo-folder-get-type folder)) + ((setq type (elmo-folder-type folder)) (concat (propertize " " 'display (get (intern (format "wl-folder-%s-image" type)) @@ -431,80 +435,92 @@ (wl-folder-archive-image . wl-archive-folder-icon) (wl-folder-pipe-image . wl-pipe-folder-icon) (wl-folder-maildir-image . wl-maildir-folder-icon) + (wl-folder-nmz-image . wl-nmz-folder-icon) + (wl-folder-shimbun-image . wl-shimbun-folder-icon) (wl-folder-trash-empty-image . wl-empty-trash-folder-icon) (wl-folder-draft-image . wl-draft-folder-icon) (wl-folder-queue-image . wl-queue-folder-icon) (wl-folder-trash-image . wl-trash-folder-icon))) (defun wl-folder-init-icons () - (let ((load-path (cons wl-icon-dir load-path)) - (icons wl-folder-internal-icon-list) - icon name image) - (while (setq icon (pop icons)) - (unless (get (car icon) 'image) - (setq name (symbol-value (cdr icon)) - image (find-image `((:type xpm :file ,name :ascent center)))) - (when image - (put (car icon) 'image (propertize name 'display image))))))) + (when (wl-e21-display-image-p) + (let ((load-path (cons wl-icon-dir load-path)) + (icons wl-folder-internal-icon-list) + icon name image) + (while (setq icon (pop icons)) + (unless (get (car icon) 'image) + (setq name (symbol-value (cdr icon)) + image (find-image `((:type xpm :file ,name :ascent center)))) + (when image + (put (car icon) 'image (propertize name 'display image)))))))) (defun wl-plugged-init-icons () - (unless wl-plugged-image - (let ((load-path (cons wl-icon-dir load-path))) - (setq wl-plugged-image (find-image `((:type xpm - :file ,wl-plugged-icon - :ascent center))) - wl-unplugged-image (find-image `((:type xpm - :file ,wl-unplugged-icon - :ascent center)))))) - (if (display-mouse-p) - (let ((props (list 'local-map (purecopy (make-mode-line-mouse2-map - #'wl-toggle-plugged)) - 'help-echo "mouse-2 toggles plugged status"))) - (if (display-graphic-p) - (setq wl-modeline-plug-state-on - (apply 'propertize wl-plug-state-indicator-on - `(display ,wl-plugged-image ,@props)) - wl-modeline-plug-state-off - (apply 'propertize wl-plug-state-indicator-off - `(display ,wl-unplugged-image ,@props))) + (let ((props (when (display-mouse-p) + (list 'local-map (purecopy (make-mode-line-mouse2-map + #'wl-toggle-plugged)) + 'help-echo "mouse-2 toggles plugged status")))) + (if (wl-e21-display-image-p) + (progn + (unless wl-plugged-image + (let ((load-path (cons wl-icon-dir load-path))) + (setq wl-plugged-image (find-image + `((:type xpm + :file ,wl-plugged-icon + :ascent center))) + wl-unplugged-image (find-image + `((:type xpm + :file ,wl-unplugged-icon + :ascent center)))))) + (setq wl-modeline-plug-state-on + (apply 'propertize wl-plug-state-indicator-on + `(display ,wl-plugged-image ,@props)) + wl-modeline-plug-state-off + (apply 'propertize wl-plug-state-indicator-off + `(display ,wl-unplugged-image ,@props)))) + (if props (setq wl-modeline-plug-state-on (apply 'propertize wl-plug-state-indicator-on props) wl-modeline-plug-state-off - (apply 'propertize wl-plug-state-indicator-off props)))) - (setq wl-modeline-plug-state-on wl-plug-state-indicator-on - wl-modeline-plug-state-off wl-plug-state-indicator-off))) + (apply 'propertize wl-plug-state-indicator-off props)) + (setq wl-modeline-plug-state-on wl-plug-state-indicator-on + wl-modeline-plug-state-off wl-plug-state-indicator-off))))) (defun wl-biff-init-icons () - (unless wl-biff-mail-image - (let ((load-path (cons wl-icon-dir load-path))) - (setq wl-biff-mail-image (find-image - `((:type xpm :file ,wl-biff-mail-icon - :ascent center))) - wl-biff-nomail-image (find-image - `((:type xpm :file ,wl-biff-nomail-icon - :ascent center)))))) - (if (display-mouse-p) - (let ((props (list 'local-map (purecopy (make-mode-line-mouse2-map - (lambda nil - (call-interactively - 'wl-biff-check-folders)))) - 'help-echo "mouse-2 checks new mails"))) - (if (display-graphic-p) - (setq wl-modeline-biff-state-on - (apply 'propertize wl-biff-state-indicator-on - `(display ,wl-biff-mail-image ,@props)) - wl-modeline-biff-state-off - (apply 'propertize wl-biff-state-indicator-off - `(display ,wl-biff-nomail-image ,@props))) + (let ((props (when (display-mouse-p) + (list 'local-map (purecopy (make-mode-line-mouse2-map + (lambda nil + (call-interactively + 'wl-biff-check-folders)))) + 'help-echo "mouse-2 checks new mails")))) + (if (wl-e21-display-image-p) + (progn + (unless wl-biff-mail-image + (let ((load-path (cons wl-icon-dir load-path))) + (setq wl-biff-mail-image (find-image + `((:type xpm + :file ,wl-biff-mail-icon + :ascent center))) + wl-biff-nomail-image (find-image + `((:type xpm + :file ,wl-biff-nomail-icon + :ascent center)))))) + (setq wl-modeline-biff-state-on + (apply 'propertize wl-biff-state-indicator-on + `(display ,wl-biff-mail-image ,@props)) + wl-modeline-biff-state-off + (apply 'propertize wl-biff-state-indicator-off + `(display ,wl-biff-nomail-image ,@props)))) + (if props (setq wl-modeline-biff-state-on (apply 'propertize wl-biff-state-indicator-on props) wl-modeline-biff-state-off - (apply 'propertize wl-biff-state-indicator-off props)))) - (setq wl-modeline-biff-state-on wl-biff-state-indicator-on - wl-modeline-biff-state-off wl-biff-state-indicator-off))) + (apply 'propertize wl-biff-state-indicator-off props)) + (setq wl-modeline-biff-state-on wl-biff-state-indicator-on + wl-modeline-biff-state-off wl-biff-state-indicator-off))))) (defun wl-make-date-string () - (format-time-string "%a, %d %b %Y %T %z")) + (let ((system-time-locale "C")) + (format-time-string "%a, %d %b %Y %T %z"))) (defalias 'wl-setup-folder 'wl-e21-setup-folder-toolbar) @@ -526,7 +542,8 @@ (defun wl-message-wheel-up (event) (interactive "e") - (if (string-match wl-message-buf-name (buffer-name)) + (if (string-match (regexp-quote wl-message-buffer-cache-name) + (regexp-quote (buffer-name))) (wl-message-next-page) (let ((cur-buf (current-buffer)) proceed) @@ -541,7 +558,8 @@ (defun wl-message-wheel-down (event) (interactive "e") - (if (string-match wl-message-buf-name (buffer-name)) + (if (string-match (regexp-quote wl-message-buffer-cache-name) + (regexp-quote (buffer-name))) (wl-message-prev-page) (let ((cur-buf (current-buffer)) proceed) @@ -567,7 +585,7 @@ (define-key keymap [menu-bar mail signature] '("Insert Signature" . insert-signature)) (define-key keymap [menu-bar headers fcc] - '("FCC" . wl-draft-fcc)))) + '("Fcc" . wl-draft-fcc)))) (defun wl-draft-mode-setup () (require 'derived) @@ -604,6 +622,11 @@ Special commands: (defalias 'wl-defface 'defface) +(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-e21) (require 'wl-version))