Generic_Window_Manager/data/vb-term.gwm

432 lines
9.9 KiB
Plaintext

; ======================================================================
; XTERM WINDOW PACKAGE
; ======================================================================
(require 'vb-bar 'vb-button 'simple-ed-win)
; ================================
; Function to execute applications
; ================================
(de exec.sh (command)
(! "/bin/sh" "-c" command))
; Context:
; exec.machine
;
(de exec.xload ()
(if (boundp 'exec.machine)
(exec.sh (+ "rx " exec.machine " xload "))
(? "\nexec.xload: ERROR no described exec.machine\n")))
; Context:
; exec.machine
; exec.font-name
;
(de exec.xterm ()
(if (boundp 'exec.machine)
(with (
font-arg (if (boundp 'exec.font-name)
(+ " -fn " exec.font-name)
"")
)
(exec.sh (+ "rx " exec.machine " xterm -ls" font-arg)))
(? "\nexec.xterm: ERROR no described exec.machine\n")))
; Logo plug
; ---------
(: vbterm.logo-plug
(with (vbterm.logo-pixmap
(if (boundp 'logo-pixmap) logo-pixmap
(boundp 'icon-pixmap) icon-pixmap
))
(if vbterm.logo-pixmap
(with (
background white
borderwidth 1
borderpixel white
fsm ()
)
(plug-make vbterm.logo-pixmap))))
)
; plug with label dynamically changed
; -----------------------------------
(de vbterm.dynamic-plug-make ()
(with (
context (list
'foreground foreground
'background background
'font font
'label-horizontal-margin label-horizontal-margin
'label-vertical-margin label-vertical-margin
)
property (list 'context context)
)
(plug-make vbterm.dynamic-default-pixmap)))
(de vbterm.dynamic-plug-update (text)
(with-eval (# 'context wob-property)
(wob-tile (active-label-make text))))
(setq vbterm.dynamic-default-pixmap (label-make ""))
; Name plug
; ---------
(: vbterm.current-machine-fsm
(fsm-make
(state-make
(on (user-event 'machine-change)
(progn
(vbterm.dynamic-plug-update vbterm.current-machine)
))
)))
; Context: (just as label-make)
;
(de vbterm.current-machine-plug-make ()
(with (
fsm vbterm.current-machine-fsm
)
(vbterm.dynamic-plug-make)))
(setq vbterm.current-machine-small-plug
(with (
borderwidth 1
borderpixel black
font small-font
)
(vbterm.current-machine-plug-make)))
(setq vbterm.current-machine-big-plug
(with (
borderwidth 1
borderpixel black
foreground black
background white
font name-font
)
(vbterm.current-machine-plug-make)))
; Directory plug
; --------------
(: vbterm.current-directory-fsm
(fsm-make
(state-make
(on (user-event 'directory-change)
(progn
(vbterm.dynamic-plug-update vbterm.current-directory)
))
)))
(: vbterm.current-directory-plug
(with (
borderwidth 1
borderpixel black
font small-font
fsm vbterm.current-directory-fsm
)
(vbterm.dynamic-plug-make)))
; Editable plug
; -------------
(: vbterm.edit-fsm
(fsm-make
(state-make
(on (keypress 0xff08 any)
(progn
(wob-property
(: s (match "\\(.*\\)."
(wob-property) 1)))
(if (= s "")
(wob-property (: s " ")))
(wob-tile (active-label-make s name-font))
(send-user-event 'get-s (window-icon))
))
(on (keypress 0xffff any)
(progn
(wob-property (: s " "))
(wob-tile (active-label-make s name-font))
(send-user-event 'get-s (window-icon))
))
(on (keypress any any)
(progn
(wob-property
(: s (+ (wob-property) (last-key))))
(wob-tile (active-label-make s name-font))
(send-user-event 'get-s (window-icon))
))
(on (user-event 'initialize)
(progn
(wob-property (: s window-name))
(wob-tile (active-label-make s name-font))
(send-user-event 'get-s (window-icon))
))
(on (user-event 'name-change)
(progn
(wob-property (: s window-name))
(wob-tile (active-label-make s name-font))
(send-user-event 'get-s (window-icon))
))
(on enter-window (set-focus ()))
(on leave-window (set-focus))
standard-title-behavior
standard-behavior
)))
;(: vbterm.editable-plug2
; ''(with (
; borderwidth 1
; background white
; font name-font
; property window-name
; fsm vbterm.edit-fsm)
; (plug-make (label-make window-name))))
(: vbterm.editable-plug2
(with (
borderwidth 1
background white
font name-font
property "foo" ;window-name
fsm vbterm.edit-fsm)
(plug-make (label-make ""))))
; Window fsm
; ----------
(de vbterm.get-current-directory ()
(with (name window-name)
(if (match ".*:.*" name)
(with (res (match "\\([^:]*:\\)\\(.*\\)" name 2))
(if res res " "))
" ")))
(de vbterm.get-current-machine ()
(match "\\([^:]*\\)" window-name 1))
(de vbterm.notify-name-change ()
(setq vbterm.current-directory (vbterm.get-current-directory))
(send-user-event 'directory-change)
(setq vbterm.current-machine (vbterm.get-current-machine))
(send-user-event 'machine-change)
; (set-x-property "WM_ICON_NAME" (vbterm.get-current-machine))
(setq xterm.icon-name (vbterm.get-current-machine))
(send-user-event 'icon-name-change (window-icon))
)
(setq xterm-behavior
(state-make
(on (user-event 'name-change) (vbterm.notify-name-change))
(on (user-event 'initialize) (vbterm.notify-name-change))
))
(if (and (boundp 'emacs-mouse-loaded) emacs-mouse-loaded)
(progn
(: vbterm.sed-window-fsm
(fsm-make
(state-make
(on focus-in
(progn
(if autoraise (raise-window))
(send-user-event 'focus-in)
(wob-borderpixel black)))
(on focus-out
(progn (send-user-event 'focus-out)
(wob-borderpixel white)))
(on (button 1 with-shift) (emacs-click 1))
(on (button 2 with-shift) (emacs-click 2))
(on (buttonpress 3 with-shift) (pop-menu emacs-pop))
xterm-behavior
window-behavior
standard-behavior
)))
(: vbterm.inner-grabs (list (button any with-shift)))
)
(progn
(: vbterm.sed-window-fsm
(fsm-make
(state-make
(on focus-in
(progn
(if autoraise (raise-window))
(send-user-event 'focus-in)
(wob-borderpixel black)))
(on focus-out
(progn (send-user-event 'focus-out)
(wob-borderpixel white)))
xterm-behavior
window-behavior
standard-behavior
)))
(: vbterm.inner-grabs ())))
; Some examples of bar context variable:
; -------------------------------------
;
; bar-min-width 20
; bar-max-width 20
; bar.focus-sensitive ()
; bar.borderwidth 5
; borderpixel black
; bar.thickness 24
; bar.thickness 30
; bar.size-adjust-on 'pixmap
; bar.appearance-make bar.color-appearance-make
; bar.normal-color foreground
; bar.active-color background
; font (font-make "screen.r.7")
; normal-pixmap0 (label-make "1")
; normal-pixmap1 (label-make "gwm")
; normal-pixmap2 (label-make "2")
; active-pixmap0 ()
; active-pixmap1 ()
; active-pixmap2 ()
; dummy (with (
; tmp foreground
; foreground background
; background tmp
; )
; (setq active-pixmap0 (label-make "1"))
; (setq active-pixmap1 (label-make "gwm"))
; (setq active-pixmap2 (label-make "2")))
; bar.normal-pixmap-list (list
; normal-pixmap0
; normal-pixmap1
; normal-pixmap2)
; bar.active-pixmap-list (list
; active-pixmap0
; active-pixmap1
; active-pixmap2)
; bar.appearance-make bar.pixmap-appearance-make
; bar.appearance-make bar.3-pixmaps-appearance-make
; bar.appearance-make bar.3-pixmap-files-appearance-make
; bar.active-pixmap-file-name "barA"
; bar.plugs (+ my-buttons (list vbterm.editable-plug2)); OK
; property '(a 3)
; bar.normal-pixmap-file-name "barN"
; bar.active-pixmap-file-name "barGWM"
; bar.normal-pixmap-file-name "closeStore"
; bar.active-pixmap-file-name "barN"
; borderwidth 1
; fsm vbterm.titlebar-fsm
; borderpixel black
; bar-min-width 16 bar-max-width 26
; bar.normal-pixmap-file-name "barN"
; bar.active-pixmap-file-name "barA2"
; Bars definition
; ---------------
(de resize-0 ()
(with (
button.action '(window-size '(80 66))
button.stencil-label "66"
)
(button.make)))
(de resize-1 ()
(with (
button.action '(window-size '(80 58))
button.stencil-label "58"
)
(button.make)))
(de resize-2 ()
(with (
button.action '(window-size '(80 30))
button.stencil-label "30"
)
(button.make)))
(de vbterm.title-bar-make ()
(with (
bar.appearance-make bar.3-paxmap-files-appearance-make
bar.normal-pixmap-file-name "barA2"
bar.focus-sensitive ()
plug-separator 10
button.minimum-width 24
button.minimum-height 24
background grey
bar.plugs (list
vbterm.logo-plug
(button.iconify)
(button.kill)
(button.lower)
(button.raise)
(button.xload)
(with (button.mode 'english) (button.xterm))
(resize-0)
(resize-1)
(resize-2)
()
(with (background white) vbterm.current-machine-big-plug)
)
)
(bar.make)))
(de vbterm.bottom-bar-make ()
(with (
bar.appearance-make bar.3-paxmap-files-appearance-make
bar.normal-pixmap-file-name "barA2"
bar.focus-sensitive ()
bar.plugs (list
vbterm.current-machine-small-plug
vbterm.current-directory-plug
)
)
(bar.make)))))))
(setq vbterm.colored-bar
(with (
bar.borderwidth 1
bar-min-width 4
bar.normal-color background
bar.active-color foreground
)
(bar.make)))
(de vb-term ()
(with (
opening (+ opening '((send-user-event 'initialize)))
inner-borderwidth (default vbterm.borderwidth 0)
fsm vbterm.sed-window-fsm
borderwidth (default vbterm.borderwidth 0)
borderpixel white
grabs (+ grabs vbterm.inner-grabs)
my-deco (window-make
(vbterm.title-bar-make)
vbterm.colored-bar
vbterm.colored-bar
(vbterm.bottom-bar-make)
()))
my-deco))