annotate tests/glyph-test.el @ 388:aabb7f5b1c81 r21-2-9

Import from CVS: tag r21-2-9
author cvs
date Mon, 13 Aug 2007 11:09:42 +0200
parents bbff43aa5eb7
children 74fd4e045ea6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
1 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
2 (make-extent (point) (point))
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
3 (setq icon (make-glyph [xpm :file "../etc/xemacs-icon.xpm"])))
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
4
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
5 (defun foo ()
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
6 (interactive)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
7 (setq ok-select (not ok-select)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
8
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
9 ;; button in a group
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
10 (setq ok-select nil)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
11 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
12 (make-extent (point) (point))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
13 (make-glyph [button :descriptor ["ok " (setq ok-select t)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
14 :style radio :selected ok-select]]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
15 ;; button in a group
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
16 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
17 (make-extent (point) (point))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
18 (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
19 :selected (not ok-select)]]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
20 ;; normal pushbutton
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
21 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
22 (make-extent (point) (point))
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
23 (setq pbutton (make-glyph
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
24 [button :width 10 :height 2
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
25 :face modeline-mousable
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
26 :descriptor "ok" :callback foo
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
27 :selected t])))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
28 ;; progress gauge
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
29 (set-extent-begin-glyph
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
30 (make-extent (point) (point))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
31 (setq pgauge (make-glyph
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
32 [progress :width 10 :height 2
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
33 :descriptor "ok"])))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
34 ;; progress the progress ...
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
35 (let ((x 0))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
36 (while (<= x 100)
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
37 (set-image-instance-property (glyph-image-instance pgauge) :percent x)
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
38 (setq x (+ x 5))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
39 (sit-for 0.1)))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
40
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
41 ;; progress gauge in the modeline
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
42 (setq global-mode-string
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
43 (cons (make-extent nil nil)
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
44 (setq pg (make-glyph
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
45 [progress :width 5 :pixel-height 16
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
46 :descriptor "ok"]))))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
47 ;; progress the progress ...
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
48 (let ((x 0))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
49 (while (<= x 100)
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
50 (set-image-instance-property (glyph-image-instance pg) :percent x)
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
51 (setq x (+ x 5))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
52 (sit-for 0.1)))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
53
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
54 (set-extent-begin-glyph
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
55 (make-extent (point) (point))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
56 (make-glyph
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
57 [button :face modeline-mousable
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
58 :descriptor "ok" :callback foo
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
59 :image (make-glyph
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
60 [xpm :file "../etc/xemacs-icon.xpm"])]))
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
61
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
62 ;; normal pushbutton
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
63 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
64 (make-extent (point) (point))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
65 (make-glyph [button :descriptor ["A Big Button" foo ]]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
66 ;; edit box
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
67 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
68 (make-extent (point) (point))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
69 (setq hedit (make-glyph [edit :pixel-width 50 :pixel-height 30
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
70 :face bold-italic
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
71 :descriptor ["Hello"]])))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
72 ;; combo box
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
73 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
74 (make-extent (point) (point))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
75 (setq hcombo (make-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
76 [combo :width 10 :height 3 :descriptor ["Hello"]
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
77 :properties (:items ("One" "Two" "Three"))])))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
78
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
79 ;; line
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
80 (set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
81 (make-extent (point) (point))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
82 (make-glyph [label :pixel-width 150 :descriptor "Hello"]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
83
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
84 ;; scrollbar
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
85 ;(set-extent-begin-glyph
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
86 ; (make-extent (point) (point))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
87 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
88
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
89 ;; generic subwindow
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
90 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 50]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
91 (set-extent-begin-glyph (make-extent (point) (point)) sw)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
92