diff tests/glyph-test.el @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 84b14dcb0985
children 0784d089fdc9
line wrap: on
line diff
--- a/tests/glyph-test.el	Mon Aug 13 11:33:40 2007 +0200
+++ b/tests/glyph-test.el	Mon Aug 13 11:35:02 2007 +0200
@@ -1,6 +1,6 @@
 (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))
@@ -16,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 
@@ -48,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 
@@ -56,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 
@@ -69,20 +71,21 @@
 	    [tab-control :descriptor "My Tab"
 			 :face highlight
 			 :orientation right
-			 :properties (:items (["One" foo]
-					      ["Two" fee]
-					      ["Three" foo]))])))
+			 :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)))
 
@@ -95,7 +98,9 @@
 ;; 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))
     (sit-for 0.1)))
 
@@ -115,25 +120,27 @@
 ;; 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 
@@ -147,17 +154,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)