Mercurial > hg > xemacs-beta
annotate tests/glyph-test.el @ 5623:444713e89160
Fix XLIKE_output_blank comment typo.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2011-12-27 Didier Verna <didier@xemacs.org>
* redisplay-xlike-inc.c (XLIKE_output_blank): Fix comment typo.
| author | Didier Verna <didier@xemacs.org> |
|---|---|
| date | Tue, 27 Dec 2011 15:37:03 +0100 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
|
4781
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
1 ;;; Copyright (C) 1998 Andy Piper |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
2 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
3 ;; This file is part of XEmacs. |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
4 ;; |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
5 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
6 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
7 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
8 ;; option) any later version. |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
9 ;; |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
10 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
11 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
12 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
13 ;; for more details. |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
14 ;; |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
15 ;; You should have received a copy of the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4781
diff
changeset
|
16 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
|
4781
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
17 |
| 428 | 18 (set-extent-begin-glyph |
| 19 (make-extent (point) (point)) | |
| 442 | 20 (setq im (make-glyph [xbm :file "xemacsicon.xbm"]))) |
| 428 | 21 |
| 438 | 22 (set-extent-begin-glyph |
| 23 (make-extent (point) (point)) | |
| 24 (make-glyph [string :data "xemacs"])) | |
| 25 | |
| 428 | 26 (defun foo () |
| 27 (interactive) | |
| 28 (setq ok-select (not ok-select))) | |
| 29 | |
| 30 (defun fee () (interactive) (message "hello")) | |
| 31 | |
| 32 ;; button in a group | |
| 33 (setq ok-select nil) | |
| 34 (set-extent-begin-glyph | |
| 35 (make-extent (point) (point)) | |
| 442 | 36 (make-glyph |
| 37 (setq radio-button1 | |
| 38 [button :face widget | |
| 39 :descriptor ["ok1" (setq ok-select t) | |
| 428 | 40 :style radio :selected ok-select]]))) |
| 41 ;; button in a group | |
| 42 (set-extent-begin-glyph | |
| 43 (make-extent (point) (point)) | |
| 442 | 44 (make-glyph |
| 45 (setq radio-button2 | |
| 46 [button :descriptor ["ok2" (setq ok-select nil) :style radio | |
| 428 | 47 :selected (not ok-select)]]))) |
| 48 ;; toggle button | |
| 49 (set-extent-begin-glyph | |
| 50 (make-extent (point) (point)) | |
| 51 (setq tbutton | |
| 442 | 52 (make-glyph [button :descriptor ["ok3" (setq ok-select nil) |
| 428 | 53 :style toggle |
| 54 :selected (not ok-select)]]))) | |
| 55 (set-extent-begin-glyph | |
| 56 (make-extent (point) (point)) | |
| 442 | 57 (make-glyph |
| 58 (setq toggle-button | |
| 59 [button :descriptor ["ok4" :style toggle | |
| 60 :callback | |
| 61 (setq ok-select (not ok-select)) | |
| 62 :selected ok-select]]))) | |
| 428 | 63 |
| 64 ;; normal pushbutton | |
| 65 (set-extent-begin-glyph | |
| 66 (make-extent (point) (point)) | |
| 67 (setq push-button | |
| 68 (make-glyph [button :width 10 :height 2 | |
| 69 :face modeline-mousable | |
| 442 | 70 :descriptor "ok" :callback foo |
| 428 | 71 :selected t]))) |
| 72 ;; tree view | |
| 73 (set-extent-begin-glyph | |
| 74 (make-extent (point) (point)) | |
| 75 (setq tree (make-glyph | |
| 76 [tree-view :width 10 | |
| 77 :descriptor "My Tree" | |
| 442 | 78 :items (["One" foo] |
| 79 (["Two" foo] | |
| 80 ["Four" foo] | |
| 81 "Six") | |
| 82 "Three")]))) | |
| 428 | 83 |
| 84 ;; tab control | |
| 85 (set-extent-begin-glyph | |
| 86 (make-extent (point) (point)) | |
| 87 (setq tab (make-glyph | |
| 88 [tab-control :descriptor "My Tab" | |
| 89 :face highlight | |
| 438 | 90 :orientation right |
| 442 | 91 :items (["One" foo :selected t] |
| 92 ["Two" fee :selected nil] | |
| 93 ["Three" foo :selected nil])]))) | |
| 428 | 94 |
| 95 ;; progress gauge | |
| 96 (set-extent-begin-glyph | |
| 97 (make-extent (point) (point)) | |
| 98 (setq pgauge (make-glyph | |
| 442 | 99 [progress-gauge :width 10 :height 2 :value 0 |
| 428 | 100 :descriptor "ok"]))) |
| 101 ;; progress the progress ... | |
| 102 (let ((x 0)) | |
| 103 (while (<= x 100) | |
| 442 | 104 (set-glyph-image pgauge `[progress-gauge :width 10 :height 2 |
| 105 :descriptor "ok" :value ,x]) | |
| 428 | 106 (setq x (+ x 5)) |
| 107 (sit-for 0.1))) | |
| 108 | |
| 109 ;; progress gauge in the modeline | |
| 110 (setq global-mode-string | |
| 111 (cons (make-extent nil nil) | |
| 112 (setq pg (make-glyph | |
| 113 [progress-gauge :width 5 :pixel-height 16 | |
| 114 :descriptor "ok"])))) | |
| 115 ;; progress the progress ... | |
| 116 (let ((x 0)) | |
| 117 (while (<= x 100) | |
| 442 | 118 (set-glyph-image pg |
| 119 `[progress-gauge :width 5 :pixel-height 16 | |
| 120 :descriptor "ok" :value ,x]) | |
| 428 | 121 (setq x (+ x 5)) |
| 462 | 122 (redisplay-frame) |
| 428 | 123 (sit-for 0.1))) |
| 124 | |
| 125 (set-extent-begin-glyph | |
| 126 (make-extent (point) (point)) | |
| 127 (make-glyph | |
| 128 [button :face modeline-mousable | |
| 129 :descriptor "ok" :callback foo | |
| 130 :image [xpm :file "../etc/xemacs-icon.xpm"]])) | |
| 131 | |
| 132 ;; normal pushbutton | |
| 133 (set-extent-begin-glyph | |
| 134 (make-extent (point) (point)) | |
| 438 | 135 (setq pbutton |
| 136 (make-glyph [button :descriptor ["A Big Button" foo ]]))) | |
| 428 | 137 |
| 138 ;; edit box | |
| 139 (set-extent-begin-glyph | |
| 140 (make-extent (point) (point)) | |
| 442 | 141 (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30 |
| 428 | 142 :face bold-italic |
| 143 :descriptor ["Hello"]]))) | |
| 144 ;; combo box | |
| 145 (set-extent-begin-glyph | |
| 146 (make-extent (point) (point)) | |
| 442 | 147 (make-glyph (setq combo-box |
| 148 [combo-box :width 10 :descriptor ["Hello"] | |
| 149 :items ("One" "Two" "Three")]))) | |
| 428 | 150 |
| 151 ;; label | |
| 152 (set-extent-begin-glyph | |
| 153 (make-extent (point) (point)) | |
| 442 | 154 (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"]))) |
| 428 | 155 |
| 156 ;; string | |
| 157 (set-extent-begin-glyph | |
| 158 (make-extent (point) (point)) | |
| 442 | 159 (make-glyph |
| 160 (setq str | |
| 161 [string :data "Hello There"]))) | |
| 428 | 162 |
| 163 ;; scrollbar | |
| 164 ;(set-extent-begin-glyph | |
| 165 ; (make-extent (point) (point)) | |
| 166 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]])) | |
| 167 | |
| 168 ;; generic subwindow | |
| 169 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70])) | |
| 170 (set-extent-begin-glyph (make-extent (point) (point)) sw) | |
| 171 | |
| 172 ;; layout | |
| 173 (setq layout | |
| 174 (make-glyph | |
| 442 | 175 `[layout :descriptor "The Layout" |
| 176 :orientation vertical | |
| 177 :justify left | |
| 178 :border [string :data "Hello There Mrs"] | |
| 179 :items ([layout :orientation horizontal | |
| 180 :items (,radio-button1 ,radio-button2)] | |
| 181 ,edit-field ,toggle-button ,label ,str)])) | |
| 182 ;(set-glyph-face layout 'gui-element) | |
| 428 | 183 (set-extent-begin-glyph |
| 184 (make-extent (point) (point)) layout) | |
| 434 | 185 |
| 442 | 186 ;; another test layout |
| 187 (set-extent-begin-glyph | |
| 188 (make-extent (point) (point)) | |
| 189 (setq layout-2 | |
| 190 (make-glyph `[layout :descriptor "The Layout" | |
| 191 :orientation vertical | |
| 192 :items ([progress-gauge :value 0 :width 10 :height 2 | |
| 193 :descriptor "ok"])]))) | |
| 194 | |
| 195 (set-glyph-image layout-2 `[layout :descriptor "The Layout" | |
| 196 :orientation vertical | |
| 197 :items ([progress-gauge :value 4 :width 10 :height 2 | |
| 198 :descriptor "ok"])]) | |
| 434 | 199 (setq test-toggle-widget nil) |
| 200 | |
| 201 (defun test-toggle (widget) | |
| 202 (set-extent-begin-glyph | |
| 203 (make-extent (point) (point)) | |
| 204 (make-glyph (vector 'button | |
| 205 :descriptor "ok" | |
| 206 :style 'toggle | |
| 207 :selected `(funcall test-toggle-value | |
| 208 ,widget) | |
| 209 :callback `(funcall test-toggle-action | |
| 210 ,widget))))) | |
| 211 | |
| 212 (defun test-toggle-action (widget &optional event) | |
| 213 (if widget | |
| 214 (message "Widget is t") | |
| 215 (message "Widget is nil"))) | |
| 216 | |
| 217 (defun test-toggle-value (widget) | |
| 218 (setq widget (not widget)) | |
| 219 (not widget)) |