X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tests%2Fglyph-test.el;h=7330032a48694c2af18d7544679b41ed97b51e66;hb=efdb31fd4c8db81d2414c32d491f1bf994263c74;hp=d0aaf9a143224aaf9a304822357e7edec4e60042;hpb=f3ec20f455f3f1212d2c5ee4cadc984330da9c38;p=chise%2Fxemacs-chise.git.1 diff --git a/tests/glyph-test.el b/tests/glyph-test.el index d0aaf9a..7330032 100644 --- a/tests/glyph-test.el +++ b/tests/glyph-test.el @@ -1,40 +1,91 @@ (set-extent-begin-glyph (make-extent (point) (point)) - (setq icon (make-glyph [xpm :file "../etc/xemacs-icon.xpm"]))) + (setq im (make-glyph [xbm :file "xemacsicon.xbm"]))) + +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph [string :data "xemacs"])) (defun foo () - (interactive) + (interactive) (setq ok-select (not ok-select))) +(defun fee () (interactive) (message "hello")) + ;; button in a group (setq ok-select nil) (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [button :descriptor ["ok " (setq ok-select t) - :style radio :selected ok-select]])) + (make-glyph + (setq radio-button1 + [button :face widget + :descriptor ["ok1" (setq ok-select t) + :style radio :selected ok-select]]))) ;; button in a group (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio - :selected (not ok-select)]])) + (make-glyph + (setq radio-button2 + [button :descriptor ["ok2" (setq ok-select nil) :style radio + :selected (not ok-select)]]))) +;; toggle button +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tbutton + (make-glyph [button :descriptor ["ok3" (setq ok-select nil) + :style toggle + :selected (not ok-select)]]))) +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph + (setq toggle-button + [button :descriptor ["ok4" :style toggle + :callback + (setq ok-select (not ok-select)) + :selected ok-select]]))) + ;; normal pushbutton (set-extent-begin-glyph (make-extent (point) (point)) - (setq pbutton (make-glyph - [button :width 10 :height 2 - :face modeline-mousable - :descriptor "ok" :callback foo - :selected t]))) + (setq push-button + (make-glyph [button :width 10 :height 2 + :face modeline-mousable + :descriptor "ok" :callback foo + :selected t]))) +;; tree view +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tree (make-glyph + [tree-view :width 10 + :descriptor "My Tree" + :items (["One" foo] + (["Two" foo] + ["Four" foo] + "Six") + "Three")]))) + +;; tab control +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tab (make-glyph + [tab-control :descriptor "My Tab" + :face highlight + :orientation right + :items (["One" foo :selected t] + ["Two" fee :selected nil] + ["Three" foo :selected nil])]))) + ;; progress gauge (set-extent-begin-glyph (make-extent (point) (point)) (setq pgauge (make-glyph - [progress :width 10 :height 2 - :descriptor "ok"]))) + [progress-gauge :width 10 :height 2 :value 0 + :descriptor "ok"]))) ;; progress the progress ... (let ((x 0)) (while (<= x 100) - (set-image-instance-property (glyph-image-instance pgauge) :percent x) + (set-glyph-image pgauge `[progress-gauge :width 10 :height 2 + :descriptor "ok" :value ,x]) (setq x (+ x 5)) (sit-for 0.1))) @@ -42,13 +93,16 @@ (setq global-mode-string (cons (make-extent nil nil) (setq pg (make-glyph - [progress :width 5 :pixel-height 16 - :descriptor "ok"])))) + [progress-gauge :width 5 :pixel-height 16 + :descriptor "ok"])))) ;; progress the progress ... (let ((x 0)) (while (<= x 100) - (set-image-instance-property (glyph-image-instance pg) :percent x) + (set-glyph-image pg + `[progress-gauge :width 5 :pixel-height 16 + :descriptor "ok" :value ,x]) (setq x (+ x 5)) + (redisplay-frame) (sit-for 0.1))) (set-extent-begin-glyph @@ -56,30 +110,38 @@ (make-glyph [button :face modeline-mousable :descriptor "ok" :callback foo - :image (make-glyph - [xpm :file "../etc/xemacs-icon.xpm"])])) + :image [xpm :file "../etc/xemacs-icon.xpm"]])) ;; normal pushbutton (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [button :descriptor ["A Big Button" foo ]])) + (setq pbutton + (make-glyph [button :descriptor ["A Big Button" foo ]]))) + ;; edit box (set-extent-begin-glyph (make-extent (point) (point)) - (setq hedit (make-glyph [edit :pixel-width 50 :pixel-height 30 - :face bold-italic - :descriptor ["Hello"]]))) + (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30 + :face bold-italic + :descriptor ["Hello"]]))) ;; combo box (set-extent-begin-glyph (make-extent (point) (point)) - (setq hcombo (make-glyph - [combo :width 10 :height 3 :descriptor ["Hello"] - :properties (:items ("One" "Two" "Three"))]))) + (make-glyph (setq combo-box + [combo-box :width 10 :descriptor ["Hello"] + :items ("One" "Two" "Three")]))) + +;; label +(set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"]))) -;; line +;; string (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [label :pixel-width 150 :descriptor "Hello"])) + (make-glyph + (setq str + [string :data "Hello There"]))) ;; scrollbar ;(set-extent-begin-glyph @@ -87,6 +149,54 @@ ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]])) ;; generic subwindow -(setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 50])) +(setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70])) (set-extent-begin-glyph (make-extent (point) (point)) sw) +;; layout +(setq layout + (make-glyph + `[layout :descriptor "The Layout" + :orientation vertical + :justify left + :border [string :data "Hello There Mrs"] + :items ([layout :orientation horizontal + :items (,radio-button1 ,radio-button2)] + ,edit-field ,toggle-button ,label ,str)])) +;(set-glyph-face layout 'gui-element) +(set-extent-begin-glyph + (make-extent (point) (point)) layout) + +;; another test layout +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq layout-2 + (make-glyph `[layout :descriptor "The Layout" + :orientation vertical + :items ([progress-gauge :value 0 :width 10 :height 2 + :descriptor "ok"])]))) + +(set-glyph-image layout-2 `[layout :descriptor "The Layout" + :orientation vertical + :items ([progress-gauge :value 4 :width 10 :height 2 + :descriptor "ok"])]) +(setq test-toggle-widget nil) + +(defun test-toggle (widget) + (set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph (vector 'button + :descriptor "ok" + :style 'toggle + :selected `(funcall test-toggle-value + ,widget) + :callback `(funcall test-toggle-action + ,widget))))) + +(defun test-toggle-action (widget &optional event) + (if widget + (message "Widget is t") + (message "Widget is nil"))) + +(defun test-toggle-value (widget) + (setq widget (not widget)) + (not widget))