Mercurial > hg > xemacs-beta

comparison tests/glyph-test.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents aabb7f5b1c81
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
1 (set-extent-begin-glyph 1 (set-extent-begin-glyph
2 (make-extent (point) (point)) 2 (make-extent (point) (point))
3 (setq icon (make-glyph [xpm :file "../etc/xemacs-icon.xpm"]))) 3 (setq im (make-glyph [xpm :file "xemacs-icon.xpm"])))
4
5 (set-extent-begin-glyph
6 (make-extent (point) (point))
7 (make-glyph [string :data "xemacs"]))
4 8
5 (defun foo () 9 (defun foo ()
6 (interactive) 10 (interactive)
7 (setq ok-select (not ok-select))) 11 (setq ok-select (not ok-select)))
12
13 (defun fee () (interactive) (message "hello"))
8 14
9 ;; button in a group 15 ;; button in a group
10 (setq ok-select nil) 16 (setq ok-select nil)
11 (set-extent-begin-glyph 17 (set-extent-begin-glyph
12 (make-extent (point) (point)) 18 (make-extent (point) (point))
13 (make-glyph [button :descriptor ["ok " (setq ok-select t) 19 (setq radio-button1
14 :style radio :selected ok-select]])) 20 (make-glyph
21 [button :descriptor ["ok " (setq ok-select t)
22 :style radio :selected ok-select]])))
15 ;; button in a group 23 ;; button in a group
16 (set-extent-begin-glyph 24 (set-extent-begin-glyph
17 (make-extent (point) (point)) 25 (make-extent (point) (point))
18 (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio 26 (setq radio-button2
19 :selected (not ok-select)]])) 27 (make-glyph
28 [button :descriptor ["ok" (setq ok-select nil) :style radio
29 :selected (not ok-select)]])))
30 ;; toggle button
31 (set-extent-begin-glyph
32 (make-extent (point) (point))
33 (setq tbutton
34 (make-glyph [button :descriptor ["ok" (setq ok-select nil)
35 :style toggle
36 :selected (not ok-select)]])))
37 (set-extent-begin-glyph
38 (make-extent (point) (point))
39 (setq toggle-button
40 (make-glyph [button :descriptor ["ok" :style toggle
41 :callback
42 (setq ok-select (not ok-select))
43 :selected ok-select]])))
44
20 ;; normal pushbutton 45 ;; normal pushbutton
21 (set-extent-begin-glyph 46 (set-extent-begin-glyph
22 (make-extent (point) (point)) 47 (make-extent (point) (point))
23 (setq pbutton (make-glyph 48 (setq push-button
24 [button :width 10 :height 2 49 (make-glyph [button :width 10 :height 2
25 :face modeline-mousable 50 :face modeline-mousable
26 :descriptor "ok" :callback foo 51 :descriptor "ok" :callback foo
27 :selected t]))) 52 :selected t])))
53 ;; tree view
54 (set-extent-begin-glyph
55 (make-extent (point) (point))
56 (setq tree (make-glyph
57 [tree-view :width 10
58 :descriptor "My Tree"
59 :properties (:items (["One" foo]
60 (["Two" foo]
61 ["Four" foo]
62 "Six")
63 "Three"))])))
64
65 ;; tab control
66 (set-extent-begin-glyph
67 (make-extent (point) (point))
68 (setq tab (make-glyph
69 [tab-control :descriptor "My Tab"
70 :face highlight
71 :orientation right
72 :properties (:items (["One" foo]
73 ["Two" fee]
74 ["Three" foo]))])))
75
28 ;; progress gauge 76 ;; progress gauge
29 (set-extent-begin-glyph 77 (set-extent-begin-glyph
30 (make-extent (point) (point)) 78 (make-extent (point) (point))
31 (setq pgauge (make-glyph 79 (setq pgauge (make-glyph
32 [progress :width 10 :height 2 80 [progress-gauge :width 10 :height 2
33 :descriptor "ok"]))) 81 :descriptor "ok"])))
34 ;; progress the progress ... 82 ;; progress the progress ...
35 (let ((x 0)) 83 (let ((x 0))
36 (while (<= x 100) 84 (while (<= x 100)
37 (set-image-instance-property (glyph-image-instance pgauge) :percent x) 85 (set-image-instance-property (glyph-image-instance pgauge) :percent x)
38 (setq x (+ x 5)) 86 (setq x (+ x 5))
40 88
41 ;; progress gauge in the modeline 89 ;; progress gauge in the modeline
42 (setq global-mode-string 90 (setq global-mode-string
43 (cons (make-extent nil nil) 91 (cons (make-extent nil nil)
44 (setq pg (make-glyph 92 (setq pg (make-glyph
45 [progress :width 5 :pixel-height 16 93 [progress-gauge :width 5 :pixel-height 16
46 :descriptor "ok"])))) 94 :descriptor "ok"]))))
47 ;; progress the progress ... 95 ;; progress the progress ...
48 (let ((x 0)) 96 (let ((x 0))
49 (while (<= x 100) 97 (while (<= x 100)
50 (set-image-instance-property (glyph-image-instance pg) :percent x) 98 (set-image-instance-property (glyph-image-instance pg) :percent x)
51 (setq x (+ x 5)) 99 (setq x (+ x 5))
54 (set-extent-begin-glyph 102 (set-extent-begin-glyph
55 (make-extent (point) (point)) 103 (make-extent (point) (point))
56 (make-glyph 104 (make-glyph
57 [button :face modeline-mousable 105 [button :face modeline-mousable
58 :descriptor "ok" :callback foo 106 :descriptor "ok" :callback foo
59 :image (make-glyph 107 :image [xpm :file "../etc/xemacs-icon.xpm"]]))
60 [xpm :file "../etc/xemacs-icon.xpm"])]))
61 108
62 ;; normal pushbutton 109 ;; normal pushbutton
63 (set-extent-begin-glyph 110 (set-extent-begin-glyph
64 (make-extent (point) (point)) 111 (make-extent (point) (point))
65 (make-glyph [button :descriptor ["A Big Button" foo ]])) 112 (setq pbutton
113 (make-glyph [button :descriptor ["A Big Button" foo ]])))
114
66 ;; edit box 115 ;; edit box
67 (set-extent-begin-glyph 116 (set-extent-begin-glyph
68 (make-extent (point) (point)) 117 (make-extent (point) (point))
69 (setq hedit (make-glyph [edit :pixel-width 50 :pixel-height 30 118 (setq edit-field (make-glyph [edit-field :pixel-width 50 :pixel-height 30
70 :face bold-italic 119 :face bold-italic
71 :descriptor ["Hello"]]))) 120 :descriptor ["Hello"]])))
72 ;; combo box 121 ;; combo box
73 (set-extent-begin-glyph 122 (set-extent-begin-glyph
74 (make-extent (point) (point)) 123 (make-extent (point) (point))
75 (setq hcombo (make-glyph 124 (setq combo-box (make-glyph
76 [combo :width 10 :height 3 :descriptor ["Hello"] 125 [combo-box :width 10 :descriptor ["Hello"]
77 :properties (:items ("One" "Two" "Three"))]))) 126 :properties (:items ("One" "Two" "Three"))])))
78 127
79 ;; line 128 ;; label
80 (set-extent-begin-glyph 129 (set-extent-begin-glyph
81 (make-extent (point) (point)) 130 (make-extent (point) (point))
82 (make-glyph [label :pixel-width 150 :descriptor "Hello"])) 131 (setq label (make-glyph [label :pixel-width 150 :descriptor "Hello"])))
132
133 ;; string
134 (set-extent-begin-glyph
135 (make-extent (point) (point))
136 (setq str (make-glyph [string :data "Hello There"])))
83 137
84 ;; scrollbar 138 ;; scrollbar
85 ;(set-extent-begin-glyph 139 ;(set-extent-begin-glyph
86 ; (make-extent (point) (point)) 140 ; (make-extent (point) (point))
87 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]])) 141 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
88 142
89 ;; generic subwindow 143 ;; generic subwindow
90 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 50])) 144 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
91 (set-extent-begin-glyph (make-extent (point) (point)) sw) 145 (set-extent-begin-glyph (make-extent (point) (point)) sw)
92 146
147 ;; layout
148 (setq layout
149 (make-glyph
150 [layout :pixel-width 200 :pixel-height 250
151 :orientation vertical
152 :justify left
153 :border [string :data "Hello There Mrs"]
154 :items ([layout :orientation horizontal
155 :items (radio-button1 radio-button2)]
156 edit-field toggle-button label str)]))
157 (set-glyph-face layout 'gui-element)
158 (set-extent-begin-glyph
159 (make-extent (point) (point)) layout)
160
161 (setq test-toggle-widget nil)
162
163 (defun test-toggle (widget)
164 (set-extent-begin-glyph
165 (make-extent (point) (point))
166 (make-glyph (vector 'button
167 :descriptor "ok"
168 :style 'toggle
169 :selected `(funcall test-toggle-value
170 ,widget)
171 :callback `(funcall test-toggle-action
172 ,widget)))))
173
174 (defun test-toggle-action (widget &optional event)
175 (if widget
176 (message "Widget is t")
177 (message "Widget is nil")))
178
179 (defun test-toggle-value (widget)
180 (setq widget (not widget))
181 (not widget))