annotate tests/glyph-test.el @ 438:84b14dcb0985 r21-2-27

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