From: yamaoka <yamaoka>
Date: Tue, 20 Feb 2001 09:21:14 +0000 (+0000)
Subject: * wl-e21.el (wl-e21-setup-draft-toolbar): Don't refer to `wl-use-toolbar' nor
X-Git-Tag: wl-2_8-root^2~33
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=524492149c25e81de0ed0bf445d5bfd7553f36be;p=elisp%2Fwanderlust.git

* 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.
---

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 8c0579c..1ebf5ee 100644
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,27 @@
+2001-02-20  Katsumi Yamaoka    <yamaoka@jpl.org>
+
+	* 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.
+
 2000-02-20  Yuuichi Teranishi  <teranisi@gohome.org>
 
 	* wl-summary.el (wl-summary-sync): Rename 'all-shown' to `all-visible'.
@@ -49,6 +73,7 @@
 	* 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    <yamaoka@jpl.org>
 
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 8fdf43f..86129aa 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:
 ;;
@@ -162,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)
@@ -212,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)
@@ -242,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))
@@ -331,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))
@@ -379,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 ]*\\(\\[\\([^]]+\\)\\]\\)")
@@ -403,7 +406,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
@@ -439,7 +442,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)
@@ -451,67 +454,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"))