From: yamaoka <yamaoka>
Date: Fri, 5 Nov 1999 12:50:12 +0000 (+0000)
Subject: (mime-insert-button): Don't use xpm buttons under TTY.
X-Git-Tag: wemi-1_13-last-~12
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=da46d216fa49bf48737e04b480e9687004dac467;p=elisp%2Fsemi.git

(mime-insert-button): Don't use xpm buttons under TTY.
(mime-create-xpm-button): Use `mime-xpm-button-glyph-cache'.
(mime-xpm-button-glyph-cache): New variable.
(TopLevel): Don't use xpm buttons if the feature `xpm' is not provided.
(TopLevel): Require `alist'.
---

diff --git a/ChangeLog b/ChangeLog
index a540f67..8e2c38b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
 1999-11-05  Katsumi Yamaoka   <yamaoka@jpl.org>
 
+	* semi-def.el (mime-insert-button): Don't use xpm buttons under TTY.
+	(mime-create-xpm-button): Use `mime-xpm-button-glyph-cache'.
+	(mime-xpm-button-glyph-cache): New variable.
+	(TopLevel): Don't use xpm buttons if the feature `xpm' is not
+	provided.
+	(TopLevel): Require `alist'.
+
+1999-11-05  Katsumi Yamaoka   <yamaoka@jpl.org>
+
 	* semi-def.el (mime-insert-button): Funcall
 	`mime-create-button-function'.
 	(mime-create-button-function): New user option.
diff --git a/semi-def.el b/semi-def.el
index 6bc960d..ec2d69e 100644
--- a/semi-def.el
+++ b/semi-def.el
@@ -25,14 +25,11 @@
 ;;; Code:
 
 (require 'poe)
-
 (eval-when-compile (require 'cl))
-
 (require 'custom)
-
 (require 'widget)
-
 (eval-when-compile (require 'static))
+(require 'alist)
 
 (defconst mime-user-interface-product ["WEMI" (1 13 7) "Shimada"]
   "Product name, version number and code name of MIME-kernel package.")
@@ -80,7 +77,7 @@
 	  (delete-region start end))))
   (insert "\n"))
 
-(static-when (featurep 'xemacs)
+(static-when (and (featurep 'xemacs) (featurep 'xpm))
   (defcustom mime-xpm-button-shadow-thickness 3
     "A number of pixels should be used for the shadows on the edges of
 the buttons."
@@ -97,38 +94,45 @@ the buttons."
     :group 'mime
     :type 'string)
 
+  (defvar mime-xpm-button-glyph-cache nil)
+
   (defun mime-create-xpm-button (string function)
     (set-extent-properties (make-extent (point)
 					(progn
 					  (insert "[" string "]")
 					  (point)))
 			   '(invisible t intangible t))
-    (let* ((button (xpm-button-create string
-				      mime-xpm-button-shadow-thickness
-				      mime-xpm-button-foreground
-				      mime-xpm-button-background))
-	   (extent (make-extent (point) (point)))
-	   (down-glyph (make-glyph (car (cdr button))))
-	   (up-glyph (make-glyph (car button)))
-	   (down-func `(lambda (event)
+    (let* ((spec (list string
+		       mime-xpm-button-shadow-thickness
+		       mime-xpm-button-foreground
+		       mime-xpm-button-background))
+	   (button (cdr (assoc spec mime-xpm-button-glyph-cache))))
+      (or button
+	  (set-alist 'mime-xpm-button-glyph-cache spec
+		     (setq button (apply (function xpm-button-create)
+					 spec))))
+      (let* ((extent (make-extent (point) (point)))
+	     (down-glyph (make-glyph (car (cdr button))))
+	     (up-glyph (make-glyph (car button)))
+	     (down-func `(lambda (event)
+			   (interactive "e")
+			   (set-extent-begin-glyph ,extent ,down-glyph)))
+	     (up-func `(lambda (event)
 			 (interactive "e")
-			 (set-extent-begin-glyph ,extent ,down-glyph)))
-	   (up-func `(lambda (event)
-		       (interactive "e")
-		       (mouse-set-point event)
-		       (set-extent-begin-glyph ,extent ,up-glyph)
-		       (,function)))
-	   (keymap (make-sparse-keymap)))
-      (define-key keymap 'button1 down-func)
-      (define-key keymap 'button2 down-func)
-      (define-key keymap 'button1up up-func)
-      (define-key keymap 'button2up up-func)
-      (set-extent-begin-glyph extent up-glyph)
-      (set-extent-property extent 'keymap keymap))
-    (insert "\n"))
+			 (mouse-set-point event)
+			 (set-extent-begin-glyph ,extent ,up-glyph)
+			 (,function)))
+	     (keymap (make-sparse-keymap)))
+	(define-key keymap 'button1 down-func)
+	(define-key keymap 'button2 down-func)
+	(define-key keymap 'button1up up-func)
+	(define-key keymap 'button2up up-func)
+	(set-extent-begin-glyph extent up-glyph)
+	(set-extent-property extent 'keymap keymap))
+      (insert "\n")))
   )
 
-(static-if (featurep 'xemacs)
+(static-if (and (featurep 'xemacs) (featurep 'xpm))
     (defcustom mime-create-button-function 'mime-create-widget-button
       "A function called to create the content button."
       :group 'mime
@@ -148,7 +152,13 @@ the buttons."
     (narrow-to-region (point) (point))
     (mapcar (function
 	     (lambda (line)
-	       (funcall mime-create-button-function line function)))
+	       (static-if (featurep 'xemacs)
+		   (if (and (not (device-on-window-system-p))
+			    (eq 'mime-create-xpm-button
+				mime-create-button-function))
+		       (mime-create-widget-button line function)
+		     (funcall mime-create-button-function line function))
+		 (funcall mime-create-button-function line function))))
 	    (split-string string "\n"))))
 
 (defvar mime-button-mother-dispatcher nil)