update.

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

diff --git a/tests/glyph-test.el b/tests/glyph-test.el
index 67533cc..7330032 100644 (file)
--- a/tests/glyph-test.el
+++ b/tests/glyph-test.el
@@ -1,6 +1,10 @@
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq im (make-glyph [xpm :file "xemacs-icon.xpm"])))
+ (setq im (make-glyph [xbm :file "xemacsicon.xbm"])))
+
+(set-extent-begin-glyph 
+ (make-extent (point) (point))
+ (make-glyph [string :data "xemacs"]))
 
 (defun foo ()
   (interactive)
@@ -12,31 +16,33 @@
 (setq ok-select nil)
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq radio-button1 
-       (make-glyph 
-       [button :descriptor ["ok     " (setq ok-select t)
+ (make-glyph 
+  (setq radio-button1 
+       [button :face widget
+               :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 
+ (make-glyph 
+  (setq radio-button2
+       [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 
-                                       :callback 
-                                       (setq ok-select (not ok-select))
-                                       :selected ok-select]])))
+ (make-glyph 
+  (setq toggle-button
+       [button :descriptor ["ok4" :style toggle 
+                            :callback 
+                            (setq ok-select (not ok-select))
+                            :selected ok-select]])))
 
 ;; normal pushbutton
 (set-extent-begin-glyph 
@@ -44,7 +50,7 @@
  (setq push-button 
        (make-glyph [button :width 10 :height 2
                           :face modeline-mousable
-                          :descriptor "ok" :callback foo 
+                          :descriptor "ok" :callback foo
                           :selected t])))
 ;; tree view
 (set-extent-begin-glyph 
@@ -52,11 +58,11 @@
  (setq tree (make-glyph 
             [tree-view :width 10
                        :descriptor "My Tree"
-                       :properties (:items (["One" foo]
-                                            (["Two" foo]
-                                             ["Four" foo]
-                                             "Six")
-                                            "Three"))])))
+                       :items (["One" foo]
+                               (["Two" foo]
+                                ["Four" foo]
+                                "Six")
+                               "Three")])))
 
 ;; tab control
 (set-extent-begin-glyph 
@@ -64,20 +70,22 @@
  (setq tab (make-glyph 
            [tab-control :descriptor "My Tab"
                         :face highlight
-                        :properties (:items (["One" foo]
-                                             ["Two" fee]
-                                             ["Three" foo]))])))
+                        :orientation right
+                        :items (["One" foo :selected t]
+                                ["Two" fee :selected nil]
+                                ["Three" foo :selected nil])])))
 
 ;; progress gauge
 (set-extent-begin-glyph 
  (make-extent (point) (point))
  (setq pgauge (make-glyph 
-              [progress-gauge :width 10 :height 2 
+              [progress-gauge :width 10 :height 2 :value 0
                               :descriptor "ok"])))
 ;; progress the progress ...
 (let ((x 0))
   (while (<= x 100)
-    (set-image-instance-property (glyph-image-instance pgauge) :percent x)
+    (set-glyph-image pgauge `[progress-gauge :width 10 :height 2
+                                            :descriptor "ok" :value ,x])
     (setq x (+ x 5))
     (sit-for 0.1)))
 
@@ -90,8 +98,11 @@
 ;; progress the progress ...
 (let ((x 0))
   (while (<= x 100)
-    (set-image-instance-property (glyph-image-instance pg) :percent x)
+    (set-glyph-image pg
+                    `[progress-gauge :width 5 :pixel-height 16
+                                     :descriptor "ok" :value ,x])
     (setq x (+ x 5))
+    (redisplay-frame)
     (sit-for 0.1)))
 
 (set-extent-begin-glyph 
@@ -104,30 +115,33 @@
 ;; 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 
  (make-extent (point) (point)) 
- (setq edit-field (make-glyph [edit-field :pixel-width 50 :pixel-height 30
+ (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30
                                          :face bold-italic
                                          :descriptor ["Hello"]])))
 ;; combo box
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq combo-box (make-glyph
-                 [combo-box :width 10 :descriptor ["Hello"] 
-                            :properties (:items ("One" "Two" "Three"))])))
+ (make-glyph (setq combo-box
+                  [combo-box :width 10 :descriptor ["Hello"] 
+                             :items ("One" "Two" "Three")])))
 
 ;; label
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq label (make-glyph [label :pixel-width 150 :descriptor "Hello"])))
+ (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"])))
 
 ;; string
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq str (make-glyph [string :data "Hello There"])))
+ (make-glyph 
+  (setq str
+       [string :data "Hello There"])))
 
 ;; scrollbar
 ;(set-extent-begin-glyph 
@@ -141,17 +155,30 @@
 ;; layout
 (setq layout 
       (make-glyph
-       [layout :pixel-width 200 :pixel-height 250
-              :orientation vertical
-              :justify left
-              :border [string :data "Hello There Mrs"]
-              :items ([layout :orientation horizontal
-                              :items (radio-button1 radio-button2)]
-                      edit-field toggle-button label str)]))
-(set-glyph-face layout 'gui-element)
+       `[layout :descriptor "The Layout"
+               :orientation vertical
+               :justify left
+               :border [string :data "Hello There Mrs"]
+               :items ([layout :orientation horizontal
+                               :items (,radio-button1 ,radio-button2)]
+                       ,edit-field ,toggle-button ,label ,str)]))
+;(set-glyph-face layout 'gui-element)
 (set-extent-begin-glyph
  (make-extent (point) (point)) layout)
 
+;; another test layout
+(set-extent-begin-glyph
+ (make-extent (point) (point)) 
+ (setq layout-2
+       (make-glyph `[layout :descriptor "The Layout"
+                           :orientation vertical
+                           :items ([progress-gauge :value 0 :width 10 :height 2
+                                                   :descriptor "ok"])])))
+
+(set-glyph-image layout-2 `[layout :descriptor "The Layout"
+                                  :orientation vertical
+                                  :items ([progress-gauge :value 4 :width 10 :height 2
+                                                          :descriptor "ok"])])
 (setq test-toggle-widget nil)
        
 (defun test-toggle (widget)