From: yamaoka Date: Mon, 19 Feb 2001 11:05:17 +0000 (+0000) Subject: * wl-e21.el (wl-biff-init-icons): Don't generate icons of the display does not X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=e73c7a588b72ef5d0ae18fb8743d93a4e4f66b4a;p=elisp%2Fwanderlust.git * wl-e21.el (wl-biff-init-icons): Don't generate icons of the display does not support graphics. (wl-plugged-init-icons): Ditto. (wl-folder-init-icons): Ditto. * wl-demo.el (wl-demo): Chech closely whether the display supports graphics. --- diff --git a/wl/ChangeLog b/wl/ChangeLog index a18812d..bb9217d 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,13 @@ +2001-02-19 Katsumi Yamaoka + + * wl-e21.el (wl-biff-init-icons): Don't generate icons of the + display does not support graphics. + (wl-plugged-init-icons): Ditto. + (wl-folder-init-icons): Ditto. + + * wl-demo.el (wl-demo): Chech closely whether the display + supports graphics. + 2001-02-15 Yuuichi Teranishi * wl-summary.el (wl-cache-prefetch-message): Fixed last change. diff --git a/wl/wl-demo.el b/wl/wl-demo.el index 990cab2..d727255 100644 --- a/wl/wl-demo.el +++ b/wl/wl-demo.el @@ -1,7 +1,7 @@ ;;; wl-demo.el -- Opening demo on Wanderlust. -;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi -;; Copyright (C) 2000 Katsumi Yamaoka +;; Copyright (C) 1998,1999,2000,2001 Yuuichi Teranishi +;; Copyright (C) 2000,2001 Katsumi Yamaoka ;; Author: Yuuichi Teranishi ;; Katsumi Yamaoka @@ -60,7 +60,6 @@ (defalias-maybe 'set-extent-end-glyph 'ignore) (defalias-maybe 'set-glyph-face 'ignore) (defalias-maybe 'set-specifier 'ignore) - (defalias-maybe 'tool-bar-mode 'ignore) (defalias-maybe 'window-pixel-height 'ignore) (defalias-maybe 'window-pixel-width 'ignore)) @@ -204,11 +203,36 @@ any conversions and evaluate FORMS there like `progn'." "Demo on the startup screen. Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." (interactive "P") + (if (and image-type (interactive-p)) + (let* ((selection (append + (if (and (get 'wl-logo-xbm 'width) + (cond ((featurep 'xemacs) + (device-on-window-system-p)) + (wl-on-emacs21 + (display-graphic-p)) + (t window-system))) + '(("xbm" . xbm))) + (if (and (get 'wl-logo-xpm 'width) + (or (and (featurep 'xemacs) + (featurep 'xpm) + (device-on-window-system-p)) + (and wl-on-emacs21 + (display-graphic-p) + (featurep 'image) + (image-type-available-p 'xpm)))) + '(("xpm" . xpm))) + '(("ascii")))) + (type (completing-read "Image type: " selection nil t))) + (setq image-type (if (assoc type selection) + (cdr (assoc type selection))))) + (setq image-type (or image-type wl-demo-display-logo))) (let ((demo-buf (let ((default-enable-multibyte-characters t) (default-mc-flag t) (default-line-spacing 0)) (get-buffer-create "*WL Demo*")))) (switch-to-buffer demo-buf) + (erase-buffer) + (setq truncate-lines t) (cond ((featurep 'xemacs) (if (device-on-window-system-p) (progn @@ -217,7 +241,7 @@ Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." nil demo-buf)) (set-specifier (symbol-value 'scrollbar-height) 0 demo-buf) (set-specifier (symbol-value 'scrollbar-width) 0 demo-buf)))) - ((and (> emacs-major-version 20) (display-graphic-p)) + ((and wl-on-emacs21 (display-graphic-p)) (make-local-hook 'kill-buffer-hook) (let* ((frame (selected-frame)) (toolbar (frame-parameter frame 'tool-bar-lines))) @@ -235,32 +259,27 @@ Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." nil t) (set-face-background 'fringe (face-background 'default frame) frame)))) - (erase-buffer) - (setq truncate-lines t) - (let* ((wl-demo-display-logo - (if (and image-type (interactive-p)) - (let* ((selection '(("xbm" . xbm) ("xpm" . xpm) ("ascii"))) - (type (completing-read "Image type: " selection nil t))) - (if (assoc type selection) - (cdr (assoc type selection)) - t)) - (or image-type wl-demo-display-logo))) - (logo (if (cond ((featurep 'xemacs) - (device-on-window-system-p)) - ((featurep 'image) - (display-graphic-p)) - (t window-system)) - (cond ((and (eq 'xbm wl-demo-display-logo) - (get 'wl-logo-xbm 'width)) - 'wl-logo-xbm) - (wl-demo-display-logo - (cond ((get 'wl-logo-xpm 'width) - 'wl-logo-xpm) - ((get 'wl-logo-xbm 'width) - 'wl-logo-xbm)))))) - (ww (window-width)) - (wh (window-height)) - rest) + (let ((logo (cond ((eq 'xbm image-type) + (if (and (get 'wl-logo-xbm 'width) + (cond ((featurep 'xemacs) + (device-on-window-system-p)) + (wl-on-emacs21 + (display-graphic-p)) + (t window-system))) + 'wl-logo-xbm)) + ((eq 'xpm image-type) + (if (and (get 'wl-logo-xpm 'width) + (or (and (featurep 'xemacs) + (featurep 'xpm) + (device-on-window-system-p)) + (and wl-on-emacs21 + (display-graphic-p) + (featurep 'image) + (image-type-available-p 'xpm)))) + 'wl-logo-xpm)))) + (ww (window-width)) + (wh (window-height)) + rest) (if logo (let ((lw (get logo 'width)) (lh (get logo 'height)) @@ -275,7 +294,8 @@ Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." (* lw ww)) 2 (window-pixel-width)))) (set-extent-end-glyph (make-extent (point) (point)) image)) - ((featurep 'image) + ((and wl-on-emacs21 + (display-graphic-p)) (if (eq 'wl-logo-xbm logo) (let ((bg (face-background 'wl-highlight-logo-face)) (fg (face-foreground 'wl-highlight-logo-face))) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 1c99c8e..ce261d8 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -1,7 +1,7 @@ ;;; wl-e21.el -- Wanderlust modules for Emacs 21. -;; Copyright (C) 2000 Katsumi Yamaoka -;; Copyright (C) 2000 Yuuichi Teranishi +;; Copyright (C) 2000,2001 Katsumi Yamaoka +;; Copyright (C) 2000,2001 Yuuichi Teranishi ;; Author: Katsumi Yamaoka ;; Keywords: mail, net news @@ -435,36 +435,40 @@ (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 (display-graphic-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))) + (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)))) (setq wl-modeline-plug-state-on (apply 'propertize wl-plug-state-indicator-on props) wl-modeline-plug-state-off @@ -473,14 +477,6 @@ 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 @@ -488,12 +484,24 @@ '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))) + (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)))) (setq wl-modeline-biff-state-on (apply 'propertize wl-biff-state-indicator-on props) wl-modeline-biff-state-off