From 6517983ba781a47492c0ba3869d34fb5051be7ea Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 20 Feb 2001 09:20:50 +0000 Subject: [PATCH] * wl-e21.el (wl-e21-setup-draft-toolbar): Don't refer to `wl-use-toolbar' nor `display-graphic-p'. (wl-e21-setup-message-toolbar): Ditto. (wl-e21-setup-summary-toolbar): Ditto. (wl-e21-setup-folder-toolbar): Ditto. (wl-biff-init-icons): Rewrite using `wl-e21-display-image-p'. (wl-plugged-init-icons): Ditto. (wl-folder-init-icons): Use `wl-e21-display-image-p' instead of `display-graphic-p'. (wl-plugged-set-folder-icon): Ditto. (wl-highlight-plugged-current-line): Ditto. (wl-highlight-folder-current-line): Ditto. (wl-e21-highlight-folder-group-line): Ditto. (wl-e21-setup-toolbar): Ditto. (wl-e21-display-image-p): New macro. * wl-demo.el (wl-demo): Simplified. (wl-demo-image-type-alist): Use `image-type-available-p' for checking whether the image type `xbm' is available. --- wl/ChangeLog | 25 ++++++++ wl/wl-demo.el | 68 +++++++++----------- wl/wl-e21.el | 192 +++++++++++++++++++++++++++++---------------------------- 3 files changed, 153 insertions(+), 132 deletions(-) diff --git a/wl/ChangeLog b/wl/ChangeLog index 6754591..485ffdd 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,11 +1,36 @@ 2001-02-20 Katsumi Yamaoka + * wl-e21.el (wl-e21-setup-draft-toolbar): Don't refer to + `wl-use-toolbar' nor `display-graphic-p'. + (wl-e21-setup-message-toolbar): Ditto. + (wl-e21-setup-summary-toolbar): Ditto. + (wl-e21-setup-folder-toolbar): Ditto. + + (wl-biff-init-icons): Rewrite using `wl-e21-display-image-p'. + (wl-plugged-init-icons): Ditto. + + (wl-folder-init-icons): Use `wl-e21-display-image-p' instead of + `display-graphic-p'. + (wl-plugged-set-folder-icon): Ditto. + (wl-highlight-plugged-current-line): Ditto. + (wl-highlight-folder-current-line): Ditto. + (wl-e21-highlight-folder-group-line): Ditto. + (wl-e21-setup-toolbar): Ditto. + (wl-e21-display-image-p): New macro. + + * wl-demo.el (wl-demo): Simplified. + (wl-demo-image-type-alist): Use `image-type-available-p' for + checking whether the image type `xbm' is available. + +2001-02-20 Katsumi Yamaoka + * wl-e21.el (wl-highlight-folder-current-line): Call `wl-folder-init-icons' when folder icons have not been initialized. * wl-vars.el (wl-demo-display-logo): Add `bitmap' to the selection. * wl-demo.el: Work also with BITMAP-MULE under Emacs 21. + (wl-demo-image-type-alist): New macro. 2001-02-19 Katsumi Yamaoka diff --git a/wl/wl-demo.el b/wl/wl-demo.el index bce828e..5210f26 100644 --- a/wl/wl-demo.el +++ b/wl/wl-demo.el @@ -155,17 +155,22 @@ any conversions and evaluate FORMS there like `progn'." (if (and xpm (or (and (featurep 'xemacs) (featurep 'xpm)) - (and (condition-case nil - (require 'image) - (error nil)) - (image-type-available-p 'xpm)))) + (condition-case nil + (require 'image) + (error nil)))) (progn (put 'wl-logo-xpm 'width (car xpm)) (put 'wl-logo-xpm 'height (nth 1 xpm)) (put 'wl-logo-xpm 'image (if (featurep 'xemacs) (make-glyph (vector 'xpm ':data (nth 2 xpm))) - (create-image (nth 2 xpm) 'xpm t)))))) + (condition-case nil + (let ((image-types '(xpm))) + (create-image (nth 2 xpm) 'xpm t)) + (error + (put 'wl-logo-xpm 'width nil) + (put 'wl-logo-xpm 'height nil) + nil))))))) (let (width height) (let ((xbm (wl-logo-xbm))) @@ -182,8 +187,14 @@ any conversions and evaluate FORMS there like `progn'." (put 'wl-logo-xbm 'image (if (featurep 'xemacs) (make-glyph (vector 'xbm ':data xbm)) - (create-image (nth 2 xbm) 'xbm t - ':width (car xbm) ':height (nth 1 xbm))))))) + (condition-case nil + (let ((image-types '(xbm))) + (create-image (nth 2 xbm) 'xbm t + ':width (car xbm) ':height (nth 1 xbm))) + (error + (put 'wl-logo-xbm 'width nil) + (put 'wl-logo-xbm 'height nil) + nil))))))) (if (and width (not (featurep 'xemacs)) (condition-case nil @@ -225,7 +236,8 @@ any conversions and evaluate FORMS there like `progn'." (or (and (featurep 'xemacs) (device-on-window-system-p)) (and wl-on-emacs21 - (display-graphic-p)))) + (display-graphic-p) + (image-type-available-p 'xbm)))) '(("xbm" . xbm))) (if (and (get 'wl-logo-bitmap 'width) (not (featurep 'xemacs)) @@ -248,6 +260,8 @@ Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." selection)) (setq image-type (cdr type)) (setq image-type (cdr (car selection)))))) + (if image-type + (setq image-type (intern (format "wl-logo-%s" image-type)))) (let ((demo-buf (let ((default-enable-multibyte-characters t) (default-mc-flag t) (default-line-spacing 0)) @@ -282,38 +296,16 @@ Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." nil t) (set-face-background 'fringe (face-background 'default frame) frame)))) - (let ((logo (cond ((eq 'bitmap image-type) - (if (and (get 'wl-logo-bitmap 'width) - (not (featurep 'xemacs)) - (featurep 'bitmap)) - 'wl-logo-bitmap)) - ((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) - (image-type-available-p 'xpm)))) - 'wl-logo-xpm)))) - (ww (window-width)) + (let ((ww (window-width)) (wh (window-height)) rest) - (if logo - (let ((lw (get logo 'width)) - (lh (get logo 'height)) - (image (get logo 'image))) + (if image-type + (let ((lw (get image-type 'width)) + (lh (get image-type 'height)) + (image (get image-type 'image))) (cond ((featurep 'xemacs) - (if (eq 'wl-logo-xbm logo) + (if (eq 'wl-logo-xbm image-type) (set-glyph-face image 'wl-highlight-logo-face)) (setq rest (- wh 1 (/ (+ (* lh wh) (window-pixel-height) -1) (window-pixel-height)))) @@ -323,8 +315,8 @@ Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'." (set-extent-end-glyph (make-extent (point) (point)) image)) ((and wl-on-emacs21 (display-graphic-p) - (not (eq 'wl-logo-bitmap logo))) - (if (eq 'wl-logo-xbm logo) + (not (eq 'wl-logo-bitmap image-type))) + (if (eq 'wl-logo-xbm image-type) (let ((bg (face-background 'wl-highlight-logo-face)) (fg (face-foreground 'wl-highlight-logo-face))) (if (stringp bg) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 399f9e8..1e3465e 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -54,6 +54,10 @@ ;; (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: ;; @@ -161,27 +165,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) @@ -211,29 +222,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) @@ -241,7 +244,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)) @@ -330,7 +333,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)) @@ -378,7 +381,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,7 +405,7 @@ (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 @@ -437,7 +440,7 @@ (wl-folder-trash-image . wl-trash-folder-icon))) (defun wl-folder-init-icons () - (when (display-graphic-p) + (when (wl-e21-display-image-p) (let ((load-path (cons wl-icon-dir load-path)) (icons wl-folder-internal-icon-list) icon name image) @@ -449,67 +452,68 @@ (put (car icon) 'image (propertize name 'display image)))))))) (defun wl-plugged-init-icons () - (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) - (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)))) + (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 () - (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) - (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)))) + (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 () (let ((system-time-locale "C")) -- 1.7.10.4