home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / vb-term.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  10KB  |  432 lines
  1. ; ======================================================================
  2. ;             XTERM WINDOW PACKAGE
  3. ; ======================================================================
  4.  
  5. (require 'vb-bar 'vb-button 'simple-ed-win)
  6.  
  7. ; ================================
  8. ; Function to execute applications
  9. ; ================================
  10.  
  11. (de exec.sh (command)
  12.     (! "/bin/sh" "-c" command))
  13.  
  14. ; Context:
  15. ;       exec.machine
  16. ;
  17. (de exec.xload ()
  18.     (if (boundp 'exec.machine)
  19.     (exec.sh (+ "rx " exec.machine " xload "))
  20.     (? "\nexec.xload: ERROR no described exec.machine\n")))
  21.  
  22.  
  23. ; Context:
  24. ;   exec.machine
  25. ;   exec.font-name
  26. ; 
  27. (de exec.xterm ()
  28.     (if (boundp 'exec.machine)
  29.     (with (
  30.            font-arg (if (boundp 'exec.font-name)
  31.                 (+ " -fn " exec.font-name)
  32.                 "")
  33.           )
  34.           (exec.sh (+ "rx " exec.machine " xterm -ls" font-arg)))
  35.     (? "\nexec.xterm: ERROR no described exec.machine\n")))
  36.  
  37. ; Logo plug
  38. ; ---------
  39.  
  40. (: vbterm.logo-plug
  41.   (with (vbterm.logo-pixmap
  42.       (if (boundp 'logo-pixmap) logo-pixmap
  43.     (boundp 'icon-pixmap) icon-pixmap
  44.     ))
  45.     (if vbterm.logo-pixmap
  46.     (with (
  47.            background white
  48.            borderwidth 1
  49.            borderpixel white
  50.            fsm ()
  51.           )
  52.           (plug-make vbterm.logo-pixmap))))
  53. )
  54.  
  55. ; plug with label dynamically changed
  56. ; -----------------------------------
  57.  
  58. (de vbterm.dynamic-plug-make ()
  59.     (with (
  60.        context (list
  61.             'foreground foreground
  62.             'background background
  63.             'font font
  64.             'label-horizontal-margin label-horizontal-margin
  65.             'label-vertical-margin label-vertical-margin
  66.            )
  67.        property (list 'context context)
  68.       )
  69.       (plug-make vbterm.dynamic-default-pixmap)))
  70.  
  71. (de vbterm.dynamic-plug-update (text)
  72.     (with-eval (# 'context wob-property)
  73.     (wob-tile (active-label-make text))))
  74.  
  75. (setq vbterm.dynamic-default-pixmap (label-make ""))
  76.  
  77.  
  78.  
  79. ; Name plug
  80. ; ---------
  81.  
  82. (: vbterm.current-machine-fsm 
  83.     (fsm-make
  84.     (state-make
  85.         (on (user-event 'machine-change)
  86.         (progn
  87.               (vbterm.dynamic-plug-update vbterm.current-machine)
  88.         ))
  89.     )))  
  90.  
  91. ; Context:     (just as label-make)
  92. ; 
  93. (de vbterm.current-machine-plug-make ()
  94.     (with (
  95.        fsm vbterm.current-machine-fsm
  96.       )
  97.       (vbterm.dynamic-plug-make)))
  98.  
  99. (setq vbterm.current-machine-small-plug
  100.     (with (
  101.        borderwidth 1
  102.        borderpixel black
  103.        font small-font
  104.       )
  105.       (vbterm.current-machine-plug-make)))
  106.  
  107. (setq vbterm.current-machine-big-plug
  108.     (with (
  109.        borderwidth 1
  110.        borderpixel black
  111.        foreground black
  112.        background white
  113.        font name-font
  114.       )
  115.       (vbterm.current-machine-plug-make)))
  116.  
  117.  
  118. ; Directory plug
  119. ; --------------
  120.  
  121. (: vbterm.current-directory-fsm 
  122.     (fsm-make
  123.     (state-make
  124.         (on (user-event 'directory-change)
  125.         (progn
  126.               (vbterm.dynamic-plug-update vbterm.current-directory)
  127.         ))
  128.     )))  
  129.  
  130. (: vbterm.current-directory-plug 
  131.     (with (
  132.        borderwidth 1
  133.        borderpixel black
  134.        font small-font
  135.        fsm vbterm.current-directory-fsm
  136.       )
  137.       (vbterm.dynamic-plug-make)))
  138.  
  139.  
  140.  
  141. ; Editable plug
  142. ; -------------
  143.  
  144. (: vbterm.edit-fsm  
  145.   (fsm-make 
  146.     (state-make
  147.       (on (keypress 0xff08 any)
  148.     (progn
  149.       (wob-property 
  150.         (: s (match "\\(.*\\)."
  151.         (wob-property) 1)))
  152.       (if (= s "")
  153.         (wob-property (: s " ")))
  154.       (wob-tile (active-label-make s name-font))
  155.       (send-user-event 'get-s (window-icon))
  156.       ))
  157.       (on (keypress 0xffff any)
  158.     (progn
  159.       (wob-property (: s "  "))
  160.       (wob-tile (active-label-make s name-font))
  161.       (send-user-event 'get-s (window-icon))
  162.       ))
  163.       (on (keypress any any)
  164.     (progn
  165.       (wob-property 
  166.         (: s (+ (wob-property) (last-key))))
  167.       (wob-tile (active-label-make s name-font))
  168.       (send-user-event 'get-s (window-icon))
  169.       ))
  170.       (on (user-event 'initialize) 
  171.     (progn
  172.       (wob-property (: s window-name))
  173.       (wob-tile (active-label-make s name-font))
  174.       (send-user-event 'get-s (window-icon))
  175.       ))
  176.       (on (user-event 'name-change) 
  177.     (progn
  178.       (wob-property (: s window-name))
  179.       (wob-tile (active-label-make s name-font))
  180.       (send-user-event 'get-s (window-icon))
  181.       ))
  182.       (on enter-window (set-focus ()))
  183.       (on leave-window (set-focus))
  184.       standard-title-behavior
  185.       standard-behavior
  186. )))
  187.  
  188.  
  189. ;(: vbterm.editable-plug2
  190. ;    ''(with (
  191. ;         borderwidth 1 
  192. ;         background white 
  193. ;         font name-font
  194. ;         property window-name 
  195. ;         fsm vbterm.edit-fsm)
  196. ;        (plug-make (label-make window-name))))
  197.  
  198. (: vbterm.editable-plug2
  199.     (with (
  200.        borderwidth 1 
  201.        background white 
  202.        font name-font
  203.        property "foo" ;window-name 
  204.        fsm vbterm.edit-fsm)
  205.       (plug-make (label-make ""))))
  206.  
  207.  
  208.  
  209. ; Window fsm
  210. ; ----------
  211.  
  212. (de vbterm.get-current-directory ()
  213.     (with (name window-name)
  214.       (if (match ".*:.*" name)
  215.           (with (res (match "\\([^:]*:\\)\\(.*\\)" name 2))
  216.             (if res res " "))
  217.           " ")))
  218.  
  219. (de vbterm.get-current-machine ()
  220.     (match "\\([^:]*\\)" window-name 1))
  221.  
  222.  
  223. (de vbterm.notify-name-change ()
  224.     (setq vbterm.current-directory (vbterm.get-current-directory))
  225.     (send-user-event 'directory-change)
  226.     
  227.     (setq vbterm.current-machine (vbterm.get-current-machine))
  228.     (send-user-event 'machine-change)
  229.     
  230.     ;  (set-x-property "WM_ICON_NAME" (vbterm.get-current-machine))
  231.     (setq xterm.icon-name (vbterm.get-current-machine))
  232.     (send-user-event 'icon-name-change (window-icon))
  233. )  
  234.  
  235. (setq xterm-behavior
  236.     (state-make
  237.     (on (user-event 'name-change) (vbterm.notify-name-change))
  238.     (on (user-event 'initialize)  (vbterm.notify-name-change))
  239.     ))
  240.  
  241.  
  242.  
  243. (if (and (boundp 'emacs-mouse-loaded) emacs-mouse-loaded)
  244.   (progn 
  245.     (: vbterm.sed-window-fsm 
  246.       (fsm-make 
  247.     (state-make
  248.       (on focus-in 
  249.         (progn
  250.           (if autoraise (raise-window))
  251.           (send-user-event 'focus-in)
  252.           (wob-borderpixel black)))
  253.       (on focus-out 
  254.         (progn (send-user-event 'focus-out)
  255.           (wob-borderpixel white)))
  256.       (on (button 1 with-shift) (emacs-click 1))
  257.       (on (button 2 with-shift) (emacs-click 2))
  258.       (on (buttonpress 3 with-shift) (pop-menu emacs-pop))
  259.       xterm-behavior
  260.       window-behavior
  261.       standard-behavior
  262.     )))
  263.     (: vbterm.inner-grabs (list (button any with-shift)))
  264.   )
  265.   (progn
  266.     (: vbterm.sed-window-fsm 
  267.       (fsm-make 
  268.     (state-make 
  269.       (on focus-in 
  270.         (progn
  271.           (if autoraise (raise-window))
  272.           (send-user-event 'focus-in)
  273.           (wob-borderpixel black)))
  274.       (on focus-out 
  275.         (progn (send-user-event 'focus-out)
  276.           (wob-borderpixel white)))
  277.       xterm-behavior
  278.       window-behavior
  279.       standard-behavior
  280.     )))
  281.     (: vbterm.inner-grabs ())))
  282.  
  283.  
  284.  
  285.  
  286. ; Some examples of bar context variable:
  287. ; -------------------------------------
  288. ; 
  289. ;       bar-min-width 20
  290. ;       bar-max-width 20
  291. ;       bar.focus-sensitive ()
  292. ;       bar.borderwidth 5
  293. ;       borderpixel black
  294. ;       bar.thickness 24
  295. ;       bar.thickness 30
  296. ;       bar.size-adjust-on 'pixmap
  297. ;       bar.appearance-make bar.color-appearance-make
  298. ;       bar.normal-color foreground
  299. ;       bar.active-color background
  300. ;      font (font-make "screen.r.7")
  301. ;      normal-pixmap0 (label-make "1")
  302. ;      normal-pixmap1 (label-make "gwm")
  303. ;      normal-pixmap2 (label-make "2")
  304. ;      active-pixmap0 ()
  305. ;      active-pixmap1 ()
  306. ;      active-pixmap2 ()
  307. ;      dummy (with (
  308. ;               tmp foreground
  309. ;               foreground background
  310. ;               background tmp
  311. ;              )
  312. ;          (setq active-pixmap0 (label-make "1"))
  313. ;          (setq active-pixmap1 (label-make "gwm"))
  314. ;          (setq active-pixmap2 (label-make "2")))
  315. ;      bar.normal-pixmap-list (list 
  316. ;                   normal-pixmap0 
  317. ;                   normal-pixmap1
  318. ;                   normal-pixmap2)
  319. ;      bar.active-pixmap-list (list 
  320. ;                   active-pixmap0 
  321. ;                   active-pixmap1
  322. ;                   active-pixmap2)
  323. ;      bar.appearance-make bar.pixmap-appearance-make
  324. ;      bar.appearance-make bar.3-pixmaps-appearance-make
  325. ;      bar.appearance-make bar.3-pixmap-files-appearance-make
  326. ;      bar.active-pixmap-file-name "barA"
  327. ;      bar.plugs (+ my-buttons (list vbterm.editable-plug2)); OK
  328. ;       property '(a 3)
  329. ;      bar.normal-pixmap-file-name "barN"
  330. ;      bar.active-pixmap-file-name "barGWM"
  331. ;      bar.normal-pixmap-file-name "closeStore"
  332. ;      bar.active-pixmap-file-name "barN"
  333. ;       borderwidth 1 
  334. ;       fsm vbterm.titlebar-fsm
  335. ;       borderpixel black
  336. ;       bar-min-width 16 bar-max-width 26
  337. ;          bar.normal-pixmap-file-name "barN"
  338. ;          bar.active-pixmap-file-name "barA2"
  339.  
  340.  
  341.  
  342. ; Bars definition
  343. ; ---------------
  344.  
  345. (de resize-0 ()
  346.     (with (
  347.        button.action '(window-size '(80 66))
  348.        button.stencil-label "66"
  349.       )
  350.           (button.make)))
  351.  
  352. (de resize-1 ()
  353.     (with (
  354.        button.action '(window-size '(80 58))
  355.        button.stencil-label "58"
  356.       )
  357.           (button.make)))
  358.  
  359. (de resize-2 ()
  360.     (with (
  361.        button.action '(window-size '(80 30))
  362.        button.stencil-label "30"
  363.       )
  364.           (button.make)))
  365.  
  366. (de vbterm.title-bar-make ()
  367.   (with (
  368.       bar.appearance-make bar.3-paxmap-files-appearance-make
  369.       bar.normal-pixmap-file-name "barA2"
  370.       bar.focus-sensitive ()
  371.       plug-separator 10
  372.       button.minimum-width 24
  373.       button.minimum-height 24
  374.       background grey
  375.       bar.plugs (list 
  376.     vbterm.logo-plug
  377.     (button.iconify)
  378.     (button.kill)
  379.     (button.lower)
  380.     (button.raise)
  381.     (button.xload)
  382.     (with (button.mode 'english) (button.xterm))
  383.     (resize-0)
  384.     (resize-1)
  385.     (resize-2)
  386.     ()
  387.     (with (background white) vbterm.current-machine-big-plug)
  388.       )
  389.     )
  390.     (bar.make)))
  391.  
  392. (de vbterm.bottom-bar-make ()    
  393.     (with (
  394.        bar.appearance-make bar.3-paxmap-files-appearance-make
  395.        bar.normal-pixmap-file-name "barA2"
  396.        bar.focus-sensitive ()
  397.        bar.plugs (list
  398.               vbterm.current-machine-small-plug
  399.               vbterm.current-directory-plug
  400.              )
  401.       )
  402.       (bar.make)))))))
  403.      
  404. (setq vbterm.colored-bar
  405.     (with (
  406.        bar.borderwidth 1
  407.        bar-min-width 4
  408.        bar.normal-color background
  409.        bar.active-color foreground
  410.       )
  411.       (bar.make)))
  412.      
  413.     
  414.  
  415. (de vb-term ()
  416.     (with (
  417.            opening (+ opening '((send-user-event 'initialize)))
  418.        inner-borderwidth (default vbterm.borderwidth 0)
  419.        fsm vbterm.sed-window-fsm 
  420.        borderwidth (default vbterm.borderwidth 0)
  421.        borderpixel white
  422.        grabs (+ grabs vbterm.inner-grabs)
  423.        my-deco (window-make 
  424.            (vbterm.title-bar-make)
  425.            vbterm.colored-bar 
  426.            vbterm.colored-bar
  427.            (vbterm.bottom-bar-make)
  428.            ()))
  429.       my-deco))
  430.  
  431.     
  432.