261 lines
6.1 KiB
Plaintext
261 lines
6.1 KiB
Plaintext
;;;File: widgets.gwm -- various widgets for decorations
|
|
|
|
;;Author: Brian L. Kahn
|
|
;;Copyright 1992, MITRE Corporation
|
|
;;Not for sale or resale, distribution unlimited
|
|
|
|
|
|
(load "cursor-names.gwm")
|
|
(: widget.bar-cursor
|
|
(cursor-make XC_fleur))
|
|
(: widget.menu-cursor
|
|
(cursor-make XC_crosshair))
|
|
(: widget.scroll-cursor
|
|
(cursor-make XC_sb_v_double_arrow))
|
|
(: widget.scroll-up-cursor
|
|
(cursor-make XC_sb_up_arrow))
|
|
(: widget.scroll-down-cursor
|
|
(cursor-make XC_sb_down_arrow))
|
|
(: widget.scroll-index-cursor
|
|
(cursor-make XC_sb_right_arrow))
|
|
(: widget.weave
|
|
(pixmap-make "/usr/include/X11/bitmaps/cross_weave"))
|
|
(: widget.gray
|
|
(pixmap-make "/usr/include/X11/bitmaps/gray"))
|
|
(: widget.lt-gray
|
|
(pixmap-make "/usr/include/X11/bitmaps/light_gray"))
|
|
(: widget.black
|
|
(pixmap-make "/usr/include/X11/bitmaps/black"))
|
|
(: widget.font (font-make "widget"))
|
|
(: widget.Bfont (font-make "widgetBold"))
|
|
|
|
;(: widget.font (font-make "*clean-medium*--10*c-60*"))
|
|
;(: widget.Bfont (font-make "*clean-bold*--10*c-60*"))
|
|
|
|
|
|
;PROGRAMMING
|
|
;===========
|
|
|
|
|
|
(defun widget:message message
|
|
;; put "who what when why" into property for this widget
|
|
(with (output (+ "(" ;who
|
|
(or (# 'name message) (# 'name wob-property) "widget")
|
|
" " ;what
|
|
(itoa (current-event-code))
|
|
" " ;when
|
|
(itoa (current-event-modifier))
|
|
" " ;why
|
|
(or (# 'message message) (# 0 message) "no-message")
|
|
")"
|
|
))
|
|
(set-x-property (or (# 'widget message) (# 'widget wob-property))
|
|
output)
|
|
))
|
|
|
|
|
|
(: widget:scrollbar-fsm
|
|
(fsm-make
|
|
(: inactive
|
|
(state-make
|
|
(on (buttonpress 1 any)
|
|
(wob-cursor widget.scroll-up-cursor)
|
|
active)
|
|
(on (buttonpress 2 any)
|
|
(wob-cursor widget.scroll-index-cursor)
|
|
active)
|
|
(on (buttonpress 3 any)
|
|
(wob-cursor widget.scroll-down-cursor)
|
|
active)
|
|
))
|
|
(: active
|
|
(state-make
|
|
(on (buttonrelease any any)
|
|
(progn
|
|
(wob-cursor widget.scroll-cursor)
|
|
(widget:message
|
|
(itoa (/ (* 100 (current-event-relative-y))
|
|
(height wob)))))
|
|
inactive)
|
|
))
|
|
))
|
|
|
|
(: widget:scrollbar-make
|
|
(with (fsm widget:scrollbar-fsm
|
|
borderwidth 1
|
|
tile widget.weave
|
|
cursor widget.scroll-cursor
|
|
property (list 'widget "scrollbar" 'name "leftside")
|
|
bar-min-width 14)
|
|
(bar-make)))
|
|
|
|
(: widget:Dmenu-fsm
|
|
(fsm-make
|
|
(: menu-off
|
|
(state-make
|
|
(on enter-window
|
|
(wob-tile (# 'on-pix wob-property)))
|
|
(on leave-window
|
|
(wob-tile (# 'off-pix wob-property)))
|
|
(on (buttonpress menu-button any)
|
|
(progn
|
|
(wob-tile (# 'off-pix wob-property))
|
|
(if wob-menu
|
|
(pop-menu))
|
|
))
|
|
(on (buttonpress any any)
|
|
(wob-invert)
|
|
menu-on)
|
|
))
|
|
(: menu-on
|
|
(state-make
|
|
(on (buttonrelease any any)
|
|
(progn
|
|
(wob-invert)
|
|
(eval (# 'action wob-property)))
|
|
menu-off)
|
|
(on leave-window
|
|
(progn
|
|
(wob-invert)
|
|
(wob-tile (# 'off-pix wob-property)))
|
|
menu-off)
|
|
))
|
|
))
|
|
|
|
(: widget:Dmenubar-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(wob-tile widget.gray))
|
|
(on (user-event 'focus-out)
|
|
(wob-tile widget.lt-gray))
|
|
standard-title-behavior)))
|
|
|
|
(defun widget:Dmenubar-make (menulist)
|
|
(with (fsm widget:Dmenubar-fsm
|
|
tile widget.gray
|
|
plug-separator 8
|
|
borderwidth 0
|
|
cursor widget.bar-cursor
|
|
bar-min-width 2
|
|
bar-max-width 24)
|
|
(apply 'bar-make menulist)
|
|
))
|
|
|
|
|
|
|
|
(defun widget:Dmenu-make (args)
|
|
;; Make a plug that drops a menu.
|
|
;; ARGS is '(name (item ... item))
|
|
;; item is ("label" action)
|
|
;; action is "(elisp-function args)" or (wool-function args)
|
|
(with (name (# 0 args)
|
|
widget "Dmenu"
|
|
item-list (# 1 args)
|
|
action (widget:action (# 1 (# 0 item-list)))
|
|
menu (widget:menu-make item-list)
|
|
fsm widget:Dmenu-fsm
|
|
borderwidth 1
|
|
cursor widget.menu-cursor
|
|
property (list 'widget widget
|
|
'name name
|
|
'action action
|
|
'off-pix (label-make name widget.font)
|
|
'on-pix (label-make name widget.Bfont))
|
|
)
|
|
(plug-make (# 'off-pix property))))
|
|
|
|
|
|
(defun widget:menu-make (item-list)
|
|
(menu-make-from-list
|
|
(mapfor item item-list
|
|
(list 'item-make
|
|
(# 0 item)
|
|
(widget:action (# 1 item)))
|
|
)))
|
|
|
|
|
|
; action is "(elisp-function args)" or (wool-function args)
|
|
(defun widget:action (action)
|
|
(cond ((eq 'string (type action))
|
|
(list 'widget:message ''message action))
|
|
((eq 'list (type action))
|
|
action)
|
|
(t (progn (? "Invalid widget:action - ")
|
|
(? action)))
|
|
))
|
|
|
|
|
|
|
|
|
|
(: widget:Pmenu-fsm
|
|
(fsm-make
|
|
(setq initial (state-make
|
|
(on enter-window-not-from-grab ; init menu colors
|
|
(: invert-color (bitwise-xor pop-item.foreground
|
|
pop-item.background))
|
|
realized ; then go in normal mode
|
|
)
|
|
(on (buttonrelease any any) ; ButRel before menu appeared
|
|
(progn ; then call default action
|
|
(with (calling-wob wob-parent Menu wob)
|
|
(setq std-popups.action
|
|
(# 'action wob-property))
|
|
(wob wob-parent)
|
|
(send-user-event 'depop Menu t)
|
|
(wob calling-wob)
|
|
(eval std-popups.action))
|
|
)
|
|
waiting-for-enter-window ; must trap the actual menu map
|
|
)
|
|
(on (user-event 'depop) (unpop-menu) initial)
|
|
))
|
|
(setq realized (state-make
|
|
(on (buttonrelease any any) ; ButRel outside of menu
|
|
(progn
|
|
(with (quit (# 'quit wob-property))
|
|
(if quit (eval quit)))
|
|
(unpop-menu)
|
|
)
|
|
initial)
|
|
(on (user-event 'depop) (unpop-menu) initial)
|
|
))
|
|
(setq waiting-for-enter-window (state-make
|
|
(on enter-window-not-from-grab () initial)
|
|
))
|
|
))
|
|
|
|
|
|
(defun widget:Pmenu-make spec
|
|
;; Make a pop-up menu that returns index of selection
|
|
(with (fsm widget:Pmenu-fsm
|
|
item-list (# 0 spec)
|
|
property (list 'widget "Pmenu"
|
|
'name "Pmenu"
|
|
'quit '(widget:message 'message "nil" 'widget 'Pmenu)
|
|
'action '(widget:message 'message 0 'widget 'Pmenu)
|
|
)
|
|
index -1 ; starts at 0, pre-incremented
|
|
)
|
|
(eval
|
|
(+ '(menu-make)
|
|
(mapfor item item-list
|
|
(list 'item-make
|
|
item
|
|
(list 'widget:message
|
|
''message (itoa (: index (+ index 1)))
|
|
''widget "Pmenu")
|
|
))))
|
|
))
|
|
|
|
|
|
|
|
|
|
;; for convenience in defining Dmenus
|
|
(defunq Dmenu: (Dmenu.name arglist)
|
|
;; assign DMENU.NAME equal to the Dmenu created using ARGLIST.
|
|
(set Dmenu.name (eval (list 'widget:Dmenu-make arglist))))
|
|
|
|
|
|
|