384
|
1 (set-extent-begin-glyph
|
|
2 (make-extent (point) (point))
|
412
|
3 (setq icon (make-glyph [xpm :file "../etc/xemacs-icon.xpm"])))
|
384
|
4
|
|
5 (defun foo ()
|
412
|
6 (interactive)
|
384
|
7 (setq ok-select (not ok-select)))
|
|
8
|
|
9 ;; button in a group
|
|
10 (setq ok-select nil)
|
|
11 (set-extent-begin-glyph
|
|
12 (make-extent (point) (point))
|
412
|
13 (make-glyph [button :descriptor ["ok " (setq ok-select t)
|
|
14 :style radio :selected ok-select]]))
|
384
|
15 ;; button in a group
|
|
16 (set-extent-begin-glyph
|
|
17 (make-extent (point) (point))
|
412
|
18 (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio
|
|
19 :selected (not ok-select)]]))
|
420
|
20 ;; toggle button
|
|
21 (set-extent-begin-glyph
|
|
22 (make-extent (point) (point))
|
|
23 (setq tbutton
|
|
24 (make-glyph [button :descriptor ["ok" (setq ok-select nil)
|
|
25 :style toggle
|
|
26 :selected (not ok-select)]])))
|
|
27 (set-extent-begin-glyph
|
|
28 (make-extent (point) (point))
|
|
29 (make-glyph [button :descriptor ["ok" :style toggle
|
|
30 :callback
|
|
31 (setq ok-select (not ok-select))
|
|
32 :selected ok-select]]))
|
|
33
|
384
|
34 ;; normal pushbutton
|
|
35 (set-extent-begin-glyph
|
|
36 (make-extent (point) (point))
|
412
|
37 (setq pbutton (make-glyph
|
420
|
38 [button :width 10 :height 2
|
412
|
39 :face modeline-mousable
|
|
40 :descriptor "ok" :callback foo
|
|
41 :selected t])))
|
418
|
42 ;; tree view
|
|
43 (set-extent-begin-glyph
|
|
44 (make-extent (point) (point))
|
|
45 (setq tree (make-glyph
|
420
|
46 [tree-view :width 10
|
|
47 :descriptor "My Tree"
|
|
48 :properties (:items (["One" foo]
|
|
49 (["Two" foo]
|
|
50 ["Four" foo]
|
|
51 "Six")
|
|
52 "Three"))])))
|
418
|
53
|
|
54 ;; tab control
|
|
55 (set-extent-begin-glyph
|
|
56 (make-extent (point) (point))
|
|
57 (setq tab (make-glyph
|
420
|
58 [tab-control :descriptor "My Tab"
|
|
59 :face default
|
|
60 :properties (:items (["One" foo]
|
|
61 ["Two" foo]
|
|
62 ["Three" foo]))])))
|
418
|
63
|
388
|
64 ;; progress gauge
|
|
65 (set-extent-begin-glyph
|
|
66 (make-extent (point) (point))
|
|
67 (setq pgauge (make-glyph
|
420
|
68 [progress-gauge :width 10 :height 2
|
|
69 :descriptor "ok"])))
|
388
|
70 ;; progress the progress ...
|
|
71 (let ((x 0))
|
|
72 (while (<= x 100)
|
412
|
73 (set-image-instance-property (glyph-image-instance pgauge) :percent x)
|
388
|
74 (setq x (+ x 5))
|
|
75 (sit-for 0.1)))
|
|
76
|
|
77 ;; progress gauge in the modeline
|
|
78 (setq global-mode-string
|
|
79 (cons (make-extent nil nil)
|
|
80 (setq pg (make-glyph
|
420
|
81 [progress-gauge :width 5 :pixel-height 16
|
|
82 :descriptor "ok"]))))
|
388
|
83 ;; progress the progress ...
|
|
84 (let ((x 0))
|
|
85 (while (<= x 100)
|
412
|
86 (set-image-instance-property (glyph-image-instance pg) :percent x)
|
388
|
87 (setq x (+ x 5))
|
|
88 (sit-for 0.1)))
|
|
89
|
|
90 (set-extent-begin-glyph
|
|
91 (make-extent (point) (point))
|
|
92 (make-glyph
|
|
93 [button :face modeline-mousable
|
|
94 :descriptor "ok" :callback foo
|
412
|
95 :image (make-glyph
|
|
96 [xpm :file "../etc/xemacs-icon.xpm"])]))
|
388
|
97
|
384
|
98 ;; normal pushbutton
|
|
99 (set-extent-begin-glyph
|
|
100 (make-extent (point) (point))
|
412
|
101 (make-glyph [button :descriptor ["A Big Button" foo ]]))
|
418
|
102
|
384
|
103 ;; edit box
|
|
104 (set-extent-begin-glyph
|
|
105 (make-extent (point) (point))
|
420
|
106 (setq hedit (make-glyph [edit-field :pixel-width 50 :pixel-height 30
|
|
107 :face bold-italic
|
|
108 :descriptor ["Hello"]])))
|
384
|
109 ;; combo box
|
|
110 (set-extent-begin-glyph
|
|
111 (make-extent (point) (point))
|
412
|
112 (setq hcombo (make-glyph
|
420
|
113 [combo-box :width 10 :height 3 :descriptor ["Hello"]
|
|
114 :properties (:items ("One" "Two" "Three"))])))
|
384
|
115
|
412
|
116 ;; line
|
384
|
117 (set-extent-begin-glyph
|
|
118 (make-extent (point) (point))
|
412
|
119 (make-glyph [label :pixel-width 150 :descriptor "Hello"]))
|
384
|
120
|
|
121 ;; scrollbar
|
|
122 ;(set-extent-begin-glyph
|
|
123 ; (make-extent (point) (point))
|
|
124 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
|
|
125
|
|
126 ;; generic subwindow
|
420
|
127 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
|
384
|
128 (set-extent-begin-glyph (make-extent (point) (point)) sw)
|
|
129
|