462
+ − 1 (require 'gnome)
+ − 2
+ − 3 (gtk-define-test
+ − 4 "GNOME Stock Pixmaps" gnome gnome-pixmaps nil
+ − 5 (let ((hbox nil)
+ − 6 (vbox nil)
+ − 7 (widget nil)
+ − 8 (label nil)
+ − 9 (i 0))
+ − 10 (mapc (lambda (b)
+ − 11 (if (= (% i 5) 0)
+ − 12 (progn
+ − 13 (setq hbox (gtk-hbutton-box-new))
+ − 14 (gtk-box-set-spacing hbox 5)
+ − 15 (gtk-container-add window hbox)))
+ − 16
+ − 17 (setq widget (gnome-stock-pixmap-widget-new window (car b))
+ − 18 vbox (gtk-vbox-new t 0)
+ − 19 label (gtk-label-new (cdr b)))
+ − 20 (gtk-container-add hbox vbox)
+ − 21 (gtk-container-add vbox widget)
+ − 22 (gtk-container-add vbox label)
+ − 23 (gtk-widget-show-all vbox)
+ − 24 (setq i (1+ i)))
+ − 25 gnome-stock-pixmaps)))
+ − 26
+ − 27 (gtk-define-test
+ − 28 "GNOME Stock Buttons" gnome gnome-buttons nil
+ − 29 (let ((hbbox nil)
+ − 30 (button nil)
+ − 31 (i 0))
+ − 32 (mapc (lambda (b)
+ − 33 (setq button (gnome-stock-button (car b)))
+ − 34 (gtk-signal-connect button 'clicked (lambda (obj data)
+ − 35 (message "Stock GNOME Button: %s" data))
+ − 36 (cdr b))
+ − 37 (if (= (% i 3) 0)
+ − 38 (progn
+ − 39 (setq hbbox (gtk-hbutton-box-new))
+ − 40 (gtk-button-box-set-spacing hbbox 5)
+ − 41 (gtk-container-add window hbbox)))
+ − 42
+ − 43 (gtk-container-add hbbox button)
+ − 44 (gtk-widget-show button)
+ − 45 (setq i (1+ i)))
+ − 46 gnome-stock-buttons)))
+ − 47
+ − 48 (gtk-define-test
+ − 49 "GNOME About" gnome gnome-about t
+ − 50 (setq window (gnome-about-new "XEmacs/GTK Test Application"
+ − 51 "1.0a"
+ − 52 "Copyright (C) 2000 Free Software Foundation"
+ − 53 '("William M. Perry <wmperry@gnu.org>"
+ − 54 "Ichabod Crane")
+ − 55 "This is a comment string... what wonderful commentary you have my dear!"
+ − 56 "")))
+ − 57
+ − 58 (gtk-define-test
+ − 59 "GNOME File Entry" gnome gnome-file-entry nil
+ − 60 (let ((button (gnome-file-entry-new nil "Test browse dialog...")))
+ − 61 (gtk-container-add window button)))
+ − 62
+ − 63 (gtk-define-test
+ − 64 "GNOME Color Picker" gnome gnome-color-picker nil
+ − 65 (let ((picker (gnome-color-picker-new))
+ − 66 (hbox (gtk-hbox-new nil 0))
+ − 67 (label (gtk-label-new "Please choose a color: ")))
+ − 68
+ − 69 (gtk-box-pack-start hbox label nil nil 2)
+ − 70 (gtk-box-pack-start hbox picker t t 2)
+ − 71 (gtk-container-add window hbox)
+ − 72 (gtk-widget-show-all hbox)))
+ − 73
+ − 74 (gtk-define-test
+ − 75 "GNOME Desktop Entry Editor" gnome gnome-dentry-edit nil
+ − 76 (let* ((notebook (gtk-notebook-new)))
+ − 77 (gnome-dentry-edit-new-notebook notebook)
+ − 78 (gtk-container-add window notebook)))
+ − 79
+ − 80 (gtk-define-test
+ − 81 "GNOME Date Edit" gnome gnome-date-entry nil
+ − 82 (let ((date (gnome-date-edit-new 0 t t))
+ − 83 button)
+ − 84 (gtk-box-pack-start window date t t 0)
+ − 85
+ − 86 (setq button (gtk-check-button-new-with-label "Show time"))
+ − 87 (gtk-signal-connect button 'clicked
+ − 88 (lambda (button date)
+ − 89 (let ((flags (gnome-date-edit-get-flags date)))
+ − 90 (if (gtk-toggle-button-get-active button)
+ − 91 (push 'show-time flags)
+ − 92 (setq flags (delq 'show-time flags)))
+ − 93 (gnome-date-edit-set-flags date flags))) date)
+ − 94 (gtk-toggle-button-set-active button t)
+ − 95 (gtk-box-pack-start window button nil nil 0)
+ − 96
+ − 97 (setq button (gtk-check-button-new-with-label "24 Hour format"))
+ − 98 (gtk-signal-connect button 'clicked
+ − 99 (lambda (button date)
+ − 100 (let ((flags (gnome-date-edit-get-flags date)))
+ − 101 (if (gtk-toggle-button-get-active button)
+ − 102 (push '24-hr flags)
+ − 103 (setq flags (delq '24-hr flags)))
+ − 104 (gnome-date-edit-set-flags date flags))) date)
+ − 105 (gtk-toggle-button-set-active button t)
+ − 106 (gtk-box-pack-start window button nil nil 0)
+ − 107
+ − 108 (setq button (gtk-check-button-new-with-label "Week starts on monday"))
+ − 109 (gtk-signal-connect button 'clicked
+ − 110 (lambda (button date)
+ − 111 (let ((flags (gnome-date-edit-get-flags date)))
+ − 112 (if (gtk-toggle-button-get-active button)
+ − 113 (push 'week-starts-on-monday flags)
+ − 114 (setq flags (delq 'week-starts-on-monday flags)))
+ − 115 (gnome-date-edit-set-flags date flags))) date)
+ − 116 (gtk-toggle-button-set-active button t)
+ − 117 (gtk-box-pack-start window button nil nil 0)))
+ − 118
+ − 119 (gtk-define-test
+ − 120 "GNOME Font Picker" gnome gnome-font-picker nil
+ − 121 (let ((hbox (gtk-hbox-new nil 5))
+ − 122 (fp (gnome-font-picker-new))
+ − 123 (label (gtk-label-new "Choose a font: "))
+ − 124 (button nil))
+ − 125 (gtk-box-pack-start hbox label t t 0)
+ − 126 (gtk-box-pack-start hbox fp nil nil 2)
+ − 127 (gnome-font-picker-set-title fp "Select a font...")
+ − 128 (gnome-font-picker-set-mode fp 'font-info)
+ − 129 (gtk-box-pack-start window hbox t t 0)
+ − 130
+ − 131 (setq button (gtk-check-button-new-with-label "Use font in label"))
+ − 132 (gtk-signal-connect button 'clicked
+ − 133 (lambda (button fp)
+ − 134 (gnome-font-picker-fi-set-use-font-in-label
+ − 135 fp (gtk-toggle-button-get-active button) 14))
+ − 136 fp)
+ − 137 (gtk-box-pack-start window button nil nil 0)
+ − 138
+ − 139 (setq button (gtk-check-button-new-with-label "Show size"))
+ − 140 (gtk-signal-connect button 'clicked
+ − 141 (lambda (button fp)
+ − 142 (gnome-font-picker-fi-set-show-size
+ − 143 fp (gtk-toggle-button-get-active button)))
+ − 144 fp)
+ − 145 (gtk-box-pack-start window button nil nil 0)))
+ − 146
+ − 147 (gtk-define-test
+ − 148 "GNOME Application" gnome gnome-app t
+ − 149 (setq window (gnome-app-new "XEmacs" "XEmacs/GNOME"))
+ − 150 (let ((menubar (gtk-menu-bar-new))
+ − 151 (contents nil)
+ − 152 ;(toolbar-instance (specifier-instance top-toolbar))
+ − 153 (toolbar nil)
+ − 154 (item nil)
+ − 155 (flushright nil))
+ − 156 (mapc (lambda (node)
+ − 157 (if (not node)
+ − 158 (setq flushright t)
+ − 159 (setq item (gtk-build-xemacs-menu node))
+ − 160 (gtk-widget-show item)
+ − 161 (if flushright (gtk-menu-item-right-justify item))
+ − 162 (gtk-menu-append menubar item)))
+ − 163 current-menubar)
+ − 164
+ − 165 (setq toolbar (gtk-toolbar-new 'horizontal 'both))
+ − 166 (mapc (lambda (x)
+ − 167 (let ((button (gtk-button-new))
+ − 168 (pixmap (gnome-stock-pixmap-widget-new toolbar x)))
+ − 169 (gtk-container-add button pixmap)
+ − 170 (gtk-toolbar-append-widget toolbar button (symbol-name x) nil)))
+ − 171 '(open save print cut copy paste undo spellcheck srchrpl mail help))
+ − 172
+ − 173 (setq contents (gtk-hbox-new nil 5))
+ − 174 (let ((hbox contents)
+ − 175 (vbox (gtk-vbox-new nil 5))
+ − 176 (frame nil)
+ − 177 (label nil))
+ − 178 (gtk-box-pack-start hbox vbox nil nil 0)
+ − 179
+ − 180 (setq frame (gtk-frame-new "Normal Label")
+ − 181 label (gtk-label-new "This is a Normal label"))
+ − 182 (gtk-container-add frame label)
+ − 183 (gtk-box-pack-start vbox frame nil nil 0)
+ − 184
+ − 185 (setq frame (gtk-frame-new "Multi-line Label")
+ − 186 label (gtk-label-new "This is a multi-line label.\nSecond line\nThird line"))
+ − 187 (gtk-container-add frame label)
+ − 188 (gtk-box-pack-start vbox frame nil nil 0)
+ − 189
+ − 190 (setq frame (gtk-frame-new "Left Justified Label")
+ − 191 label (gtk-label-new "This is a Left-Justified\nMulti-line label.\nThird line"))
+ − 192 (gtk-label-set-justify label 'left)
+ − 193 (gtk-container-add frame label)
+ − 194 (gtk-box-pack-start vbox frame nil nil 0)
+ − 195
+ − 196 (setq frame (gtk-frame-new "Right Justified Label")
+ − 197 label (gtk-label-new "This is a Right-Justified\nMulti-line label.\nFourth line, (j/k)"))
+ − 198 (gtk-label-set-justify label 'right)
+ − 199 (gtk-container-add frame label)
+ − 200 (gtk-box-pack-start vbox frame nil nil 0)
+ − 201
+ − 202 ;; Start a second row so that we don't make a ridiculously tall window
+ − 203 (setq vbox (gtk-vbox-new nil 5))
+ − 204 (gtk-box-pack-start hbox vbox nil nil 0)
+ − 205
+ − 206 (setq frame (gtk-frame-new "Line wrapped label")
+ − 207 label (gtk-label-new
+ − 208 (concat "This is an example of a line-wrapped label. It should not be taking "
+ − 209 "up the entire " ;;; big space to test spacing
+ − 210 "width allocated to it, but automatically wraps the words to fit. "
+ − 211 "The time has come, for all good men, to come to the aid of their party. "
+ − 212 "The sixth sheik's six sheep's sick.\n"
+ − 213 " It supports multiple paragraphs correctly, and correctly adds "
+ − 214 "many extra spaces. ")))
+ − 215 (gtk-label-set-line-wrap label t)
+ − 216 (gtk-container-add frame label)
+ − 217 (gtk-box-pack-start vbox frame nil nil 0)
+ − 218
+ − 219 (setq frame (gtk-frame-new "Filled, wrapped label")
+ − 220 label (gtk-label-new
+ − 221 (concat
+ − 222 "This is an example of a line-wrapped, filled label. It should be taking "
+ − 223 "up the entire width allocated to it. Here is a seneance to prove "
+ − 224 "my point. Here is another sentence. "
+ − 225 "Here comes the sun, do de do de do.\n"
+ − 226 " This is a new paragraph.\n"
+ − 227 " This is another newer, longer, better paragraph. It is coming to an end, "
+ − 228 "unfortunately.")))
+ − 229 (gtk-label-set-justify label 'fill)
+ − 230 (gtk-label-set-line-wrap label t)
+ − 231 (gtk-container-add frame label)
+ − 232 (gtk-box-pack-start vbox frame nil nil 0)
+ − 233
+ − 234 (setq frame (gtk-frame-new "Underlined label")
+ − 235 label (gtk-label-new (concat "This label is underlined!\n"
+ − 236 "This one is underlined in ���ܸ������quite a funky fashion")))
+ − 237 (gtk-label-set-justify label 'left)
+ − 238 (gtk-label-set-pattern label "_________________________ _ _________ _ _____ _ __ __ ___ ____ _____")
+ − 239 (gtk-container-add frame label)
+ − 240 (gtk-box-pack-start vbox frame nil nil 0))
+ − 241
+ − 242 (gtk-widget-show-all toolbar)
+ − 243 (gtk-widget-show-all menubar)
+ − 244 (gtk-widget-show-all contents)
+ − 245 (gnome-app-set-menus window menubar)
+ − 246 (gnome-app-set-toolbar window toolbar)
+ − 247 (gnome-app-set-contents window contents)))
