home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / vscreen.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  12KB  |  380 lines
  1. ;; 
  2. ;; Virtual Screen code my Emanuel Jay Berkenbilt, MIT
  3. ;;
  4. ;; Parameters
  5. ;;
  6. ;; vscreen.right, left, up, down are amounts to move windows in 
  7. ;; the respective directions.
  8. ;;
  9. ;; vscreen.nailed-windows is a list of windowspecs that are immune from 
  10. ;; the virtual screen code
  11. ;;
  12.  
  13. ;; Colas' note: this neat vtwm-like package is included as sent to me by
  14. ;; Jay Berkenbilt, MIT <qjb@ATHENA.MIT.EDU>
  15.  
  16. ;; The vscreen code that I am going to include here is not the most
  17. ;; "cleaned up" possible code.  It isn't that bad, though.  All
  18. ;; globals start with "vscreen.".  The only hard-coded values that
  19. ;; are not set to constants are indices into lists.  I have a list
  20. ;; called "params".  I freely refer to (# 0 params) intead of
  21. ;; assigning this a name.  I do this also with a point: (# 0
  22. ;; vscreen.pos) is the x coordinate.....  In addition, I have some
  23. ;; things in vscreen.gwm that really should be in .profile.gwm, but
  24. ;; this will probably be obvious when you look at the code.
  25. ;; 
  26. ;; I am not sure that my handling the "show-windows" code is
  27. ;; correct.  I display a map of the windows on the screen by
  28. ;; creating a pixmap and making a one-bar menu out of it.  I then
  29. ;; use place-menu to show the window and delete-menu to get rid of
  30. ;; it. 
  31. ;; 
  32. ;; Anyway, here is the code.  After the code, I will mention a few
  33. ;; of the ways that I use it.
  34. ;; 
  35. ;; The main interesting functions are
  36. ;; vscreen.move-windows-{left,up,down,right}, vscreen.restore and
  37. ;; vscreen.show-windows.  The vscreen.move-windows routines move
  38. ;; all windows (except for the "nailed" ones) and keep vscreen.pos
  39. ;; consistent.  vcsreen.restore puts the virtual screen back where
  40. ;; it belongs.  vscreen.show-windows draws a map of the windows
  41. ;; putting an X on the spot where the physical origin of the screen
  42. ;; is. 
  43. ;; 
  44. ;; I have key bindings (CTRL-SHIFT arrows) for the move functions
  45. ;; and other key bindings for restore and show-windows.
  46. ;; 
  47. ;; This code as presented works fine with the standard profile. (I
  48. ;; tested it with the aid of "Exec Cut" :-) .
  49. ;; 
  50. ;; I use it elsewhere in my code as well, however.  There is a
  51. ;; function vscreen.make-window-visible that moves the virtual
  52. ;; screen enough to make the current window visible.  I use this
  53. ;; along with raise-window in my de-iconfication code.  In
  54. ;; addition, I have some functions that bring a window of a given
  55. ;; name to the top, map the window and deiconify it if necessary,
  56. ;; and warp the mouse pointer to the window.  That code now also
  57. ;; moves the vscreen appropriately as well.  The vscreen motion is
  58. ;; occasionally a little off -- sometimes it moves one notch too
  59. ;; far.  This is a border condition that happens because I have a
  60. ;; lot of windows flush against the edge of the screen.  In any
  61. ;; case, the window is always at least partially on the screen...
  62. ;; 
  63. ;; Finally, I load the vscreen code by doing
  64. ;; (set-window Gwm.Gwm.Vscreen vscreen) in my .profile.  This is
  65. ;; the window that vscreen.show-windows creates.
  66.  
  67. ;; User-redefinable defaults
  68. ;;==========================
  69.  
  70. (defaults-to                ; user-settable resources
  71.   vscreen.menupos 6            ; position in root menu
  72.   vscreen.windowmenupos 4        ; position in window menu
  73.   vscreen.modifiers (together with-control with-alt) ; modifs for arrow keys
  74.   vscreen.no-bindings ()        ; t for not binding arrow keys
  75.  
  76.   vscreen.right-left (/ screen-width 2)    ; amount to move by keys
  77.   vscreen.down-up (/ screen-height 2)
  78.  
  79.   vscreen.nailed-windows        ; fixed windows
  80.       (list
  81.        (list 'client-class "Zwgc" 'client-name "zwgc")
  82.        (list 'client-class "XScreensaver")
  83.        (list 'client-class "Console" 'client-name "console")
  84.        (list 'client-class "XTerm" 'client-name "local" 'window-name "safe")
  85. )))
  86.  
  87. ;; ============================================================================
  88.  
  89. ;;
  90. ;; Our position.  This is the real coordinates of the virtual origin
  91. ;;
  92.  
  93. (setq vscreen.pos (list 0 0))
  94.  
  95.  
  96. (defun vscreen.nailed ()
  97.   ;;
  98.   ;; Determine whether the current window is nailed or not
  99.   ;; caches the result in 'nailed property on main window (not icon)
  100.   ;;
  101.   (if (setq tmp (# 'nailed window-window))
  102.     (if (= 'no tmp) ()
  103.       t
  104.     )
  105.     (tag vscreen.match-windowspec
  106.       (for spec vscreen.nailed-windows 
  107.     (if (match-windowspec spec)
  108.       (progn
  109.         (vscreen.nail)
  110.         (exit vscreen.match-windowspec t)
  111.       ))
  112.     (vscreen.un-nail)
  113.     ()
  114. )))))
  115.  
  116. (defun vscreen.nail ()
  117.   ;; nail down a window
  118.   (## 'nailed window-window t)
  119. )
  120.  
  121. (defun vscreen.un-nail ()
  122.   ;; un-nail a window
  123.   (## 'nailed window-window 'no)
  124. )
  125.  
  126. (defun vscreen.movable ()
  127.   ;;
  128.   ;; Returns a list of movable windows
  129.   ;;
  130.   (with (movable nil savewindow nil spec nil)
  131.     (setq savewindow window)
  132.     (for window (list-of-windows 'window)
  133.          (if (not (vscreen.nailed))
  134.          (setq movable (+ movable (list window)))))
  135.     movable))
  136.  
  137. (defun vscreen.move-windows (deltax deltay)
  138.   ;;
  139.   ;; Moves a window by deltax and deltay adjusting vscreen.pos 
  140.   ;; appropriately
  141.   ;;
  142.   (for window (vscreen.movable)
  143.        (move-window (+ window-x deltax) (+ window-y deltay)))
  144.   (with (x (# 0 vscreen.pos) y (# 1 vscreen.pos))
  145.     (setq vscreen.pos (list (+ x deltax) (+ y deltay)))))
  146.  
  147. (defun vscreen.move-windows-right ()
  148.   (vscreen.move-windows vscreen.right-left 0))
  149.  
  150. (defun vscreen.move-windows-left ()
  151.   (vscreen.move-windows (- vscreen.right-left) 0))
  152.  
  153. (defun vscreen.move-windows-down ()
  154.   (vscreen.move-windows 0 vscreen.down-up))
  155.  
  156. (defun vscreen.move-windows-up ()
  157.   (vscreen.move-windows 0 (- vscreen.down-up)))
  158.  
  159. (defun vscreen.restore ()
  160.   (vscreen.move-windows (- (# 0 vscreen.pos)) (- (# 1 vscreen.pos))))
  161.  
  162. (defun vscreen.make-window-visible ()
  163.   ;;
  164.   ;; Here we move the virtual screen around so that as much of the
  165.   ;; current window is visible as possible.  For example, if the top
  166.   ;; of the window is lower than the bottom of the screen, move so
  167.   ;; that the BOTTOM of that window is above the bottom of the screen.
  168.   ;; The other transformations are analagous.
  169.   ;;
  170.   ;; dx and dy start of being the number of increments we will
  171.   ;; move.  We then scale them to pixels.
  172.   ;;
  173.   (if (not (vscreen.nailed))
  174.       (with (dx 0 dy 0 
  175.         window-top window-y
  176.         window-bot (+ window-y window-height)
  177.         window-left window-x
  178.         window-right (+ window-x window-width)
  179.         screen-top 0
  180.         screen-bot screen-height
  181.         screen-left 0
  182.         screen-right screen-width)
  183.         (if (le window-right screen-left)
  184.         (setq dx (ceildiv (- screen-left window-left) 
  185.                   vscreen.right-left)))
  186.         (if (ge window-left screen-right)
  187.         (setq dx (- (ceildiv (- window-right screen-right) 
  188.                      vscreen.right-left))))
  189.         (if (le window-bot screen-top)
  190.         (setq dy (ceildiv (- screen-top window-top)
  191.                   vscreen.down-up)))
  192.         (if (ge window-top screen-bot)
  193.         (setq dy (- (ceildiv (- window-bot screen-bot)
  194.                      vscreen.down-up))))
  195.         (setq dx (* dx vscreen.right-left))
  196.         (setq dy (* dy vscreen.down-up))
  197.         (vscreen.move-windows dx dy))))
  198.  
  199.  
  200.  
  201. (setq vscreen.pixsize 300)
  202.  
  203. (defun vscreen.min (x y)
  204.   (if (< x y) 
  205.       x
  206.     y))
  207.  
  208. (defun vscreen.max (x y)
  209.   (if (> x y) 
  210.       x
  211.     y))
  212.  
  213. (defun vscreen.calc-params ()
  214.   ;; 
  215.   ;; Return a list that contains scale factor, x position of origin,
  216.   ;; and y position of origin
  217.   ;;
  218.  
  219.   ;;
  220.   ;; First, we find x and y extremes.  Initialize so that the current
  221.   ;; will  always be visible.
  222.   ;;
  223.   
  224.   (with (minx 0 miny 0 maxx screen-width maxy screen-height
  225.           xcenter nil ycenter nil
  226.           range nil scale nil x0 nil y0 nil
  227.           low (list-of-windows 'window 'mapped))
  228.     (for window (list-of-windows 'window 'mapped)
  229.          (setq minx (vscreen.min minx window-x))
  230.          (setq miny (vscreen.min miny window-y))
  231.          (setq maxx (vscreen.max maxx (+ window-x window-width)))
  232.          (setq maxy (vscreen.max maxy (+ window-y window-height))))
  233.     
  234.     ;; 
  235.     ;; Next, figure out the number of pixels to display. 
  236.     ;;
  237.  
  238.     (setq range (vscreen.max (- maxy miny) (- maxx minx)))
  239.     
  240.     (setq xcenter (/ (+ minx maxx) 2))
  241.     (setq ycenter (/ (+ miny maxy) 2))
  242.  
  243.     ;; 
  244.     ;; Our scale factor is a simple quotient.  We divide by .9
  245.     ;; times the number of pixels to leave some inner border in
  246.     ;; our map window.  To get the origin, figure out where 0,0
  247.     ;; would be given that the center of the current screen should
  248.     ;; be in the center.
  249.     ;;
  250.  
  251.     (setq scale (/ range (* 9 (/ vscreen.pixsize 10))))
  252.     (setq x0 (/ vscreen.pixsize 2))
  253.     (setq y0 (/ vscreen.pixsize 2))
  254.     (setq x0 (- x0 (/ xcenter scale)))
  255.     (setq y0 (- y0 (/ ycenter scale)))
  256.     (list scale x0 y0)))
  257.  
  258. (defun vscreen.draw-windows (pix params)
  259.   (with (foreground black)
  260.     (draw-line vscreen.pix (- (# 1 params) 5) (- (# 2 params) 5)
  261.            (+ (# 1 params) 5) (+ (# 2 params) 5))
  262.     (draw-line vscreen.pix (- (# 1 params) 5) (+ (# 2 params) 5)
  263.            (+ (# 1 params) 5) (- (# 2 params) 5))
  264.     (for window (list-of-windows 'window 'mapped)
  265.          (with (tlx (+ (/ window-x (# 0 params)) (# 1 params))
  266.             tly (+ (/ window-y (# 0 params)) (# 2 params))
  267.             trx (+ tlx (/ window-width (# 0 params)))
  268.             try tly
  269.             blx tlx
  270.             bly (+ tly (/ window-height (# 0 params)))
  271.             brx trx
  272.             bry bly)
  273.            (draw-line pix tlx tly trx try)
  274.            (draw-line pix trx try brx bry)
  275.            (draw-line pix brx bry blx bly)
  276.            (draw-line pix blx bly tlx tly)
  277.            ))))
  278.  
  279.  
  280. (defun vscreen.show-windows ()
  281.   (with (params (vscreen.calc-params))
  282.     (with (bar-max-width vscreen.pixsize
  283.     fsm vscreen-fsm)
  284.       (with (foreground white)
  285.     (setq vscreen.pix (pixmap-make 300 300)))
  286.       (vscreen.draw-windows vscreen.pix params)
  287.       (setq vscreen.pixmenu
  288.     (menu-make (bar-make (plug-make vscreen.pix))))
  289.       (place-menu "Vscreen" vscreen.pixmenu))))
  290.  
  291. ;; Colas: here is a sample code to bind it to control-alt-arrows
  292. ;; define vscreen.no-bindings if you don't want these bindings before loading
  293. ;; vscreen
  294.  
  295. (if (not vscreen.no-bindings)
  296.   (progn
  297.     
  298.     (setq vscreen-behavior (state-make
  299.     (on (keypress "Left" vscreen.modifiers)
  300.       (vscreen.move-windows-right)
  301.     )
  302.     (on (setq a (keypress "Right" vscreen.modifiers))
  303.       (vscreen.move-windows-left)
  304.     )
  305.     (on (keypress "Up" vscreen.modifiers)
  306.       (vscreen.move-windows-down)
  307.     )
  308.     (on (keypress "Down" vscreen.modifiers)
  309.       (vscreen.move-windows-up)
  310.     )
  311.     ))
  312.  
  313.     (setq standard-behavior (state-make
  314.     standard-behavior
  315.     vscreen-behavior
  316.     ))
  317.     (setq root-behavior (state-make
  318.     root-behavior
  319.     vscreen-behavior
  320.     ))
  321.     
  322.     (setq vscreen-grabs (list
  323.     (key "Left" vscreen.modifiers)
  324.     (key "Right" vscreen.modifiers)
  325.     (key "Up" vscreen.modifiers)
  326.     (key "Down" vscreen.modifiers)
  327.     ))
  328.     (setq root-grabs (+ root-grabs vscreen-grabs))
  329.     (setq window-grabs (+ window-grabs vscreen-grabs))
  330.     (setq icon-grabs (+ icon-grabs vscreen-grabs))
  331.     (reparse-standard-behaviors)
  332. ))
  333.  
  334. (setq vscreen-fsm 
  335.   (fsm-make
  336.     (state-make
  337.       (on (buttonrelease 1 alone) (delete-window))
  338.       (on (buttonrelease 2 alone) (delete-window))
  339.       (on (buttonrelease 3 alone) (delete-window))
  340.       window-behavior
  341.       standard-behavior
  342. )))
  343.  
  344. (setq vscreen-grabs (+ grabs (list (button any alone))))
  345.       
  346.  
  347. (setq vscreen
  348.   (with (fsm vscreen-fsm menu 'window-pop
  349.       borderpixel black
  350.       borderwidth 3
  351.       property (+ property '(nailed t))
  352.       grabs vscreen-grabs)
  353.     (window-make () () () () ())))
  354.  
  355. ;; add entries in the root & window menus
  356.  
  357. (if (not (boundp 'vscreen.menu-added)) (progn
  358.     (setq vscreen.menu-added t)
  359.     
  360.     (insert-at '(multi-item-make
  361.     "VS" ()
  362.     ("Show" (vscreen.show-windows))
  363.     ("Restore" (vscreen.restore))
  364.       )
  365.       root-pop-items
  366.       vscreen.menupos
  367.     )
  368.     
  369.     (insert-at '(multi-item-make
  370.     "VS"
  371.     ()
  372.     ("Un" (vscreen.un-nail))
  373.     ("Nail" (vscreen.nail))
  374.     ()
  375.       )
  376.       window-pop-items
  377.       vscreen.windowmenupos
  378.     )
  379. ))
  380.