Mercurial > hg > xemacs-beta
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))