git.chise.org Git - chise/xemacs-chise.git.1/blob - tests/glyph-test.el

   1 (set-extent-begin-glyph
   2  (make-extent (point) (point))
   3  (setq im (make-glyph [xpm :file "xemacs-icon.xpm"])))
   4
   5 (defun foo ()
   6   (interactive)
   7   (setq ok-select (not ok-select)))
   8
   9 (defun fee () (interactive) (message "hello"))
  10
  11 ;; button in a group
  12 (setq ok-select nil)
  13 (set-extent-begin-glyph
  14  (make-extent (point) (point))
  15  (setq radio-button1
  16        (make-glyph
  17         [button :descriptor ["ok     " (setq ok-select t)
  18                              :style radio :selected ok-select]])))
  19 ;; button in a group
  20 (set-extent-begin-glyph
  21  (make-extent (point) (point))
  22  (setq radio-button2
  23        (make-glyph
  24         [button :descriptor ["ok" (setq ok-select nil) :style radio
  25                              :selected (not ok-select)]])))
  26 ;; toggle button
  27 (set-extent-begin-glyph
  28  (make-extent (point) (point))
  29  (setq tbutton
  30        (make-glyph [button :descriptor ["ok" (setq ok-select nil)
  31                                         :style toggle
  32                                         :selected (not ok-select)]])))
  33 (set-extent-begin-glyph
  34  (make-extent (point) (point))
  35  (setq toggle-button
  36        (make-glyph [button :descriptor ["ok" :style toggle
  37                                         :callback
  38                                         (setq ok-select (not ok-select))
  39                                         :selected ok-select]])))
  40
  41 ;; normal pushbutton
  42 (set-extent-begin-glyph
  43  (make-extent (point) (point))
  44  (setq push-button
  45        (make-glyph [button :width 10 :height 2
  46                            :face modeline-mousable
  47                            :descriptor "ok" :callback foo
  48                            :selected t])))
  49 ;; tree view
  50 (set-extent-begin-glyph
  51  (make-extent (point) (point))
  52  (setq tree (make-glyph
  53              [tree-view :width 10
  54                         :descriptor "My Tree"
  55                         :properties (:items (["One" foo]
  56                                              (["Two" foo]
  57                                               ["Four" foo]
  58                                               "Six")
  59                                              "Three"))])))
  60
  61 ;; tab control
  62 (set-extent-begin-glyph
  63  (make-extent (point) (point))
  64  (setq tab (make-glyph
  65             [tab-control :descriptor "My Tab"
  66                          :face highlight
  67                          :properties (:items (["One" foo]
  68                                               ["Two" fee]
  69                                               ["Three" foo]))])))
  70
  71 ;; progress gauge
  72 (set-extent-begin-glyph
  73  (make-extent (point) (point))
  74  (setq pgauge (make-glyph
  75                [progress-gauge :width 10 :height 2
  76                                :descriptor "ok"])))
  77 ;; progress the progress ...
  78 (let ((x 0))
  79   (while (<= x 100)
  80     (set-image-instance-property (glyph-image-instance pgauge) :percent x)
  81     (setq x (+ x 5))
  82     (sit-for 0.1)))
  83
  84 ;; progress gauge in the modeline
  85 (setq global-mode-string
  86       (cons (make-extent nil nil)
  87             (setq pg (make-glyph
  88                       [progress-gauge :width 5 :pixel-height 16
  89                                       :descriptor "ok"]))))
  90 ;; progress the progress ...
  91 (let ((x 0))
  92   (while (<= x 100)
  93     (set-image-instance-property (glyph-image-instance pg) :percent x)
  94     (setq x (+ x 5))
  95     (sit-for 0.1)))
  96
  97 (set-extent-begin-glyph
  98  (make-extent (point) (point))
  99  (make-glyph
 100   [button :face modeline-mousable
 101           :descriptor "ok" :callback foo
 102           :image [xpm :file "../etc/xemacs-icon.xpm"]]))
 103
 104 ;; normal pushbutton
 105 (set-extent-begin-glyph
 106  (make-extent (point) (point))
 107  (make-glyph [button :descriptor ["A Big Button" foo ]]))
 108
 109 ;; edit box
 110 (set-extent-begin-glyph
 111  (make-extent (point) (point))
 112  (setq edit-field (make-glyph [edit-field :pixel-width 50 :pixel-height 30
 113                                           :face bold-italic
 114                                           :descriptor ["Hello"]])))
 115 ;; combo box
 116 (set-extent-begin-glyph
 117  (make-extent (point) (point))
 118  (setq combo-box (make-glyph
 119                   [combo-box :width 10 :descriptor ["Hello"]
 120                              :properties (:items ("One" "Two" "Three"))])))
 121
 122 ;; label
 123 (set-extent-begin-glyph
 124  (make-extent (point) (point))
 125  (setq label (make-glyph [label :pixel-width 150 :descriptor "Hello"])))
 126
 127 ;; string
 128 (set-extent-begin-glyph
 129  (make-extent (point) (point))
 130  (setq str (make-glyph [string :data "Hello There"])))
 131
 132 ;; scrollbar
 133 ;(set-extent-begin-glyph
 134 ; (make-extent (point) (point))
 135 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
 136
 137 ;; generic subwindow
 138 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
 139 (set-extent-begin-glyph (make-extent (point) (point)) sw)
 140
 141 ;; layout
 142 (setq layout
 143       (make-glyph
 144        [layout :pixel-width 200 :pixel-height 250
 145                :orientation vertical
 146                :justify left
 147                :border [string :data "Hello There Mrs"]
 148                :items ([layout :orientation horizontal
 149                                :items (radio-button1 radio-button2)]
 150                        edit-field toggle-button label str)]))
 151 (set-glyph-face layout 'gui-element)
 152 (set-extent-begin-glyph
 153  (make-extent (point) (point)) layout)
 154