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