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

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