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 ;; progress gauge
  29 (set-extent-begin-glyph
  30  (make-extent (point) (point))
  31  (setq pgauge (make-glyph
  32                [progress :width 10 :height 2
  33                          :descriptor "ok"])))
  34 ;; progress the progress ...
  35 (let ((x 0))
  36   (while (<= x 100)
  37     (set-image-instance-property (glyph-image-instance pgauge) :percent x)
  38     (setq x (+ x 5))
  39     (sit-for 0.1)))
  40
  41 ;; progress gauge in the modeline
  42 (setq global-mode-string
  43       (cons (make-extent nil nil)
  44             (setq pg (make-glyph
  45                       [progress :width 5 :pixel-height 16
  46                                 :descriptor "ok"]))))
  47 ;; progress the progress ...
  48 (let ((x 0))
  49   (while (<= x 100)
  50     (set-image-instance-property (glyph-image-instance pg) :percent x)
  51     (setq x (+ x 5))
  52     (sit-for 0.1)))
  53
  54 (set-extent-begin-glyph
  55  (make-extent (point) (point))
  56  (make-glyph
  57   [button :face modeline-mousable
  58           :descriptor "ok" :callback foo
  59           :image (make-glyph
  60                   [xpm :file "../etc/xemacs-icon.xpm"])]))
  61
  62 ;; normal pushbutton
  63 (set-extent-begin-glyph
  64  (make-extent (point) (point))
  65  (make-glyph [button :descriptor ["A Big Button" foo ]]))
  66 ;; edit box
  67 (set-extent-begin-glyph
  68  (make-extent (point) (point))
  69  (setq hedit (make-glyph [edit :pixel-width 50 :pixel-height 30
  70                                :face bold-italic
  71                                :descriptor ["Hello"]])))
  72 ;; combo box
  73 (set-extent-begin-glyph
  74  (make-extent (point) (point))
  75  (setq hcombo (make-glyph
  76                [combo :width 10 :height 3 :descriptor ["Hello"]
  77                       :properties (:items ("One" "Two" "Three"))])))
  78
  79 ;; line
  80 (set-extent-begin-glyph
  81  (make-extent (point) (point))
  82  (make-glyph [label :pixel-width 150 :descriptor "Hello"]))
  83
  84 ;; scrollbar
  85 ;(set-extent-begin-glyph
  86 ; (make-extent (point) (point))
  87 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
  88
  89 ;; generic subwindow
  90 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 50]))
  91 (set-extent-begin-glyph (make-extent (point) (point)) sw)
  92