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