XEmacs 21.2.32 "Kastor & Polydeukes".

[chise/xemacs-chise.git.1] / tests / glyph-test.el

diff --git a/tests/glyph-test.el b/tests/glyph-test.el
index 365322c..425b1b8 100644 (file)
--- a/tests/glyph-test.el
+++ b/tests/glyph-test.el
@@ -2,6 +2,10 @@
  (make-extent (point) (point))
  (setq im (make-glyph [xpm :file "xemacs-icon.xpm"])))
 
+(set-extent-begin-glyph 
+ (make-extent (point) (point))
+ (make-glyph [string :data "xemacs"]))
+
 (defun foo ()
   (interactive)
   (setq ok-select (not ok-select)))
@@ -14,26 +18,26 @@
  (make-extent (point) (point))
  (setq radio-button1 
        (make-glyph 
-       [button :descriptor ["ok     " (setq ok-select t)
+       [button :descriptor ["ok1" (setq ok-select t)
                             :style radio :selected ok-select]])))
 ;; button in a group
 (set-extent-begin-glyph 
  (make-extent (point) (point))
  (setq radio-button2
        (make-glyph
-       [button :descriptor ["ok" (setq ok-select nil) :style radio 
+`      [button :descriptor ["ok2" (setq ok-select nil) :style radio 
                             :selected (not ok-select)]])))
 ;; toggle button
 (set-extent-begin-glyph 
  (make-extent (point) (point))
  (setq tbutton
-       (make-glyph [button :descriptor ["ok" (setq ok-select nil) 
+       (make-glyph [button :descriptor ["ok3" (setq ok-select nil) 
                                        :style toggle 
                                        :selected (not ok-select)]])))
 (set-extent-begin-glyph 
  (make-extent (point) (point))
  (setq toggle-button
-       (make-glyph [button :descriptor ["ok" :style toggle 
+       (make-glyph [button :descriptor ["ok4" :style toggle 
                                        :callback 
                                        (setq ok-select (not ok-select))
                                        :selected ok-select]])))
@@ -64,9 +68,10 @@
  (setq tab (make-glyph 
            [tab-control :descriptor "My Tab"
                         :face highlight
-                        :properties (:items (["One" foo]
-                                             ["Two" fee]
-                                             ["Three" foo]))])))
+                        :orientation right
+                        :properties (:items (["One" foo :selected t]
+                                             ["Two" fee :selected nil]
+                                             ["Three" foo :selected nil]))])))
 
 ;; progress gauge
 (set-extent-begin-glyph 
@@ -104,7 +109,8 @@
 ;; normal pushbutton
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (make-glyph [button :descriptor ["A Big Button" foo ]]))
+ (setq pbutton
+       (make-glyph [button :descriptor ["A Big Button" foo ]])))
 
 ;; edit box
 (set-extent-begin-glyph 
@@ -151,4 +157,25 @@
 (set-glyph-face layout 'gui-element)
 (set-extent-begin-glyph
  (make-extent (point) (point)) layout)
-                              
+
+(setq test-toggle-widget nil)
+       
+(defun test-toggle (widget)
+  (set-extent-begin-glyph 
+   (make-extent (point) (point))
+   (make-glyph (vector 'button
+                      :descriptor "ok"
+                      :style 'toggle
+                      :selected `(funcall test-toggle-value
+                                          ,widget)
+                      :callback `(funcall test-toggle-action
+                                          ,widget)))))
+
+(defun test-toggle-action (widget &optional event)
+  (if widget
+      (message "Widget is t")
+    (message "Widget is nil")))
+
+(defun test-toggle-value (widget)
+  (setq widget (not widget))
+  (not widget))