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 icon (make-glyph [xpm :file "../etc/xemacs-icon.xpm"])))
   4
   5 (defun foo ()
   6   (interactive)
   7   (setq ok-select (not ok-select)))
   8
   9 ;; button in a group
  10 (setq ok-select nil)
  11 (set-extent-begin-glyph
  12  (make-extent (point) (point))
  13  (make-glyph [button :descriptor ["ok     " (setq ok-select t)
  14                                   :style radio :selected ok-select]]))
  15 ;; button in a group
  16 (set-extent-begin-glyph
  17  (make-extent (point) (point))
  18  (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio
  19                                   :selected (not ok-select)]]))
  20 ;; toggle button
  21 (set-extent-begin-glyph
  22  (make-extent (point) (point))
  23  (setq tbutton
  24        (make-glyph [button :descriptor ["ok" (setq ok-select nil)
  25                                         :style toggle
  26                                         :selected (not ok-select)]])))
  27 (set-extent-begin-glyph
  28  (make-extent (point) (point))
  29  (make-glyph [button :descriptor ["ok" :style toggle
  30                                   :callback
  31                                   (setq ok-select (not ok-select))
  32                                   :selected ok-select]]))
  33
  34 ;; normal pushbutton
  35 (set-extent-begin-glyph
  36  (make-extent (point) (point))
  37  (setq pbutton (make-glyph
  38                 [button :width 10 :height 2
  39                         :face modeline-mousable
  40                         :descriptor "ok" :callback foo
  41                         :selected t])))
  42 ;; tree view
  43 (set-extent-begin-glyph
  44  (make-extent (point) (point))
  45  (setq tree (make-glyph
  46              [tree-view :width 10
  47                         :descriptor "My Tree"
  48                         :properties (:items (["One" foo]
  49                                              (["Two" foo]
  50                                               ["Four" foo]
  51                                               "Six")
  52                                              "Three"))])))
  53
  54 ;; tab control
  55 (set-extent-begin-glyph
  56  (make-extent (point) (point))
  57  (setq tab (make-glyph
  58             [tab-control :descriptor "My Tab"
  59                          :face default
  60                          :properties (:items (["One" foo]
  61                                               ["Two" foo]
  62                                               ["Three" foo]))])))
  63
  64 ;; progress gauge
  65 (set-extent-begin-glyph
  66  (make-extent (point) (point))
  67  (setq pgauge (make-glyph
  68                [progress-gauge :width 10 :height 2
  69                                :descriptor "ok"])))
  70 ;; progress the progress ...
  71 (let ((x 0))
  72   (while (<= x 100)
  73     (set-image-instance-property (glyph-image-instance pgauge) :percent x)
  74     (setq x (+ x 5))
  75     (sit-for 0.1)))
  76
  77 ;; progress gauge in the modeline
  78 (setq global-mode-string
  79       (cons (make-extent nil nil)
  80             (setq pg (make-glyph
  81                       [progress-gauge :width 5 :pixel-height 16
  82                                       :descriptor "ok"]))))
  83 ;; progress the progress ...
  84 (let ((x 0))
  85   (while (<= x 100)
  86     (set-image-instance-property (glyph-image-instance pg) :percent x)
  87     (setq x (+ x 5))
  88     (sit-for 0.1)))
  89
  90 (set-extent-begin-glyph
  91  (make-extent (point) (point))
  92  (make-glyph
  93   [button :face modeline-mousable
  94           :descriptor "ok" :callback foo
  95           :image (make-glyph
  96                   [xpm :file "../etc/xemacs-icon.xpm"])]))
  97
  98 ;; normal pushbutton
  99 (set-extent-begin-glyph
 100  (make-extent (point) (point))
 101  (make-glyph [button :descriptor ["A Big Button" foo ]]))
 102
 103 ;; edit box
 104 (set-extent-begin-glyph
 105  (make-extent (point) (point))
 106  (setq hedit (make-glyph [edit-field :pixel-width 50 :pixel-height 30
 107                                      :face bold-italic
 108                                      :descriptor ["Hello"]])))
 109 ;; combo box
 110 (set-extent-begin-glyph
 111  (make-extent (point) (point))
 112  (setq hcombo (make-glyph
 113                [combo-box :width 10 :height 3 :descriptor ["Hello"]
 114                           :properties (:items ("One" "Two" "Three"))])))
 115
 116 ;; line
 117 (set-extent-begin-glyph
 118  (make-extent (point) (point))
 119  (make-glyph [label :pixel-width 150 :descriptor "Hello"]))
 120
 121 ;; scrollbar
 122 ;(set-extent-begin-glyph
 123 ; (make-extent (point) (point))
 124 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
 125
 126 ;; generic subwindow
 127 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
 128 (set-extent-begin-glyph (make-extent (point) (point)) sw)
 129