Mercurial > hg > xemacs-beta

comparison tests/glyph-test.el @ 428:3ecd8885ac67 r21-2-22

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