diff tests/glyph-test.el @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 501cfd01ee6d
children e804706bfb8c
line wrap: on
line diff
--- a/tests/glyph-test.el	Mon Aug 13 11:19:22 2007 +0200
+++ b/tests/glyph-test.el	Mon Aug 13 11:20:41 2007 +0200
@@ -1,89 +1,40 @@
-(set-extent-begin-glyph 
- (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"]))
+ (setq icon (make-glyph [xpm :file "../etc/xemacs-icon.xpm"])))
 
 (defun foo ()
-  (interactive)
+  (interactive) 
   (setq ok-select (not ok-select)))
 
-(defun fee () (interactive) (message "hello"))
-
 ;; button in a group
 (setq ok-select nil)
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq radio-button1 
-       (make-glyph 
-	[button :face widget
-		:descriptor ["ok1" (setq ok-select t)
-			     :style radio :selected ok-select]])))
+ (make-glyph [button :descriptor ["ok     " (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 ["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 ["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 ["ok4" :style toggle 
-					:callback 
-					(setq ok-select (not ok-select))
-					:selected ok-select]])))
-
+ (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio 
+				  :selected (not ok-select)]]))
 ;; normal pushbutton
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq push-button 
-       (make-glyph [button :width 10 :height 2
-			   :face modeline-mousable
-			   :descriptor "ok" :callback foo
-			   :selected t])))
-;; tree view
-(set-extent-begin-glyph 
- (make-extent (point) (point))
- (setq tree (make-glyph 
-	     [tree-view :width 10
-			:descriptor "My Tree"
-			:properties (:items (["One" foo]
-					     (["Two" foo]
-					      ["Four" foo]
-					      "Six")
-					     "Three"))])))
-
-;; tab control
-(set-extent-begin-glyph 
- (make-extent (point) (point))
- (setq tab (make-glyph 
-	    [tab-control :descriptor "My Tab"
-			 :face highlight
-			 :orientation right
-			 :properties (:items (["One" foo :selected t]
-					      ["Two" fee :selected nil]
-					      ["Three" foo :selected nil]))])))
-
+ (setq pbutton (make-glyph 
+		[button :width 10 :height 2 
+			:face modeline-mousable
+			:descriptor "ok" :callback foo 
+			:selected t])))
 ;; progress gauge
 (set-extent-begin-glyph 
  (make-extent (point) (point))
  (setq pgauge (make-glyph 
-	       [progress-gauge :width 10 :height 2 
-			       :descriptor "ok"])))
+	       [progress :width 10 :height 2 
+			 :descriptor "ok"])))
 ;; progress the progress ...
 (let ((x 0))
   (while (<= x 100)
-    (set-image-instance-property (glyph-image-instance pgauge) :value x)
+    (set-image-instance-property (glyph-image-instance pgauge) :percent x)
     (setq x (+ x 5))
     (sit-for 0.1)))
 
@@ -91,12 +42,12 @@
 (setq global-mode-string 
       (cons (make-extent nil nil)
 	    (setq pg (make-glyph 
-		      [progress-gauge :width 5 :pixel-height 16
-				      :descriptor "ok"]))))
+		      [progress :width 5 :pixel-height 16
+				:descriptor "ok"]))))
 ;; progress the progress ...
 (let ((x 0))
   (while (<= x 100)
-    (set-image-instance-property (glyph-image-instance pg) :value x)
+    (set-image-instance-property (glyph-image-instance pg) :percent x)
     (setq x (+ x 5))
     (sit-for 0.1)))
 
@@ -105,36 +56,30 @@
  (make-glyph 
   [button :face modeline-mousable
 	  :descriptor "ok" :callback foo
-	  :image [xpm :file "../etc/xemacs-icon.xpm"]]))
+	  :image (make-glyph 
+		  [xpm :file "../etc/xemacs-icon.xpm"])]))
 
 ;; normal pushbutton
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq pbutton
-       (make-glyph [button :descriptor ["A Big Button" foo ]])))
-
+ (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
-					  :face bold-italic
-					  :descriptor ["Hello"]])))
+ (setq hedit (make-glyph [edit :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"))])))
+ (setq hcombo (make-glyph 
+	       [combo :width 10 :height 3 :descriptor ["Hello"] 
+		      :properties (:items ("One" "Two" "Three"))])))
 
-;; label
+;; line
 (set-extent-begin-glyph 
  (make-extent (point) (point))
- (setq label (make-glyph [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 [label :pixel-width 150 :descriptor "Hello"]))
 
 ;; scrollbar
 ;(set-extent-begin-glyph 
@@ -142,41 +87,6 @@
 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
 
 ;; generic subwindow
-(setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
+(setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 50]))
 (set-extent-begin-glyph (make-extent (point) (point)) sw)
 
-;; layout
-(setq layout 
-      (make-glyph
-       [layout :descriptor "The Layout"
-	       :orientation vertical
-	       :justify left
-	       :border [string :data "Hello There Mrs"]
-	       :items ([native-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)
-
-(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))