home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / mon-keys.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  9KB  |  257 lines
  1. ; =====================================================================
  2. ; Mike Newton's (newton@gumby.cs.caltech.edu) keys
  3. ; =====================================================================
  4.  
  5. ;; Mike Newton <newton@gumby.cs.caltech.edu> code to add gwm functions to
  6. ;; function keys.  Another step in "No More Mice" (just why didn't they
  7. ;; call the 'rats'?  Their tails sure look more like a rats tail....)
  8.  
  9. ;; 92.02.28 -- remove mouse button remmapings 
  10. ;              Doug Bogia <bogia@cs.uiuc.edu>
  11. ;; 91.01.3  -- add in more changes from colas@mirsa.inria.fr, add
  12. ;;             new functions (F5 - forced raise), clean up code, 
  13. ;;             fixed comments, fix mon-relocate, added button back
  14. ;;             in so everything is one place
  15. ;;
  16. ;; 91.01.02 -- colas@mirsa.inria.fr, extracted Fkey code from MON's
  17. ;;           .profile.gwm into a separate file "mon-keys.gwm"
  18. ;;             mapped also F11 and F12 to F9 & F10 for keyboards with only 
  19. ;;            10 Fkeys
  20. ;; 90.12.28 -- newton@gumby.cs.caltech.edu, updated to 1.7b.  Added more Fkeys 
  21. ;; 90.12.7  -- newton@gumby.cs.caltech.edu, original hacks.
  22.  
  23.  
  24.  
  25. ;; Current Keys:
  26. ;;             F1 (alone)                 : choose next window
  27. ;;             F2 (alone)                 : choose previous
  28. ;;             F1 (w/ alt)                : circulate down (no focus change)
  29. ;;             F2 (w/ alt)                : circulate up (no focus change)
  30. ;;             F3 (alone)                 : open / close
  31. ;;             F4 (various)               : change window sizes (not Emacs!)
  32. ;;             F5 (alone)          : raise 
  33. ;;             F11 or F9 (alone, in root) : emergency -- map everything
  34. ;;             F12 or F10 (alone)         : exec cut buffer, printing results
  35. ;;           
  36.  
  37. ;; 
  38.  
  39. ; ===================
  40. ;  Utility Functions
  41. ; ===================
  42.  
  43.  
  44. ;;; mon-execute-string : 
  45. ;; given N items, print N results, not just the last one:
  46.  
  47. (defun mon-execute-string ()
  48.   (print "\n")
  49.   (print (execute-string
  50.        (+ "(mapfor v (list "
  51.           (cut-buffer)
  52.           ") (print v) (print \"\\n\"))" )))
  53.   (print "\n"))
  54.  
  55.  
  56. ;;; mon-window-chooser :
  57. ;; pick a next window, raise it and such.
  58.  
  59. ;; WARNING: fails in a minor way if epoch "auto-raise-screen" is t !!!!!
  60. ;; From colas@mirsa.inria.fr:
  61. ;; 1) user presses F1
  62. ;; 2) X server establishes a grab on press, to the benefit of the client having
  63. ;;    grabbed F1, i.e. gwm
  64. ;; 3) so epoch sees the cursor "leaving" its window into the "grab" realm
  65. ;; 4) user releases key,  code below (on (keyrelease F1... ))) gets activated
  66. ;; 5) your code move the cursor & focus, but epoch sees nothing
  67. ;; 6) the grab is released, by the X server
  68. ;; 7) epoch sees the cursor as coming back to its window from "grab" state
  69. ;; 8)... but doesnt check the event queue to see that it immediately leaves it!
  70. ;; 9) so it re-raises it screen
  71. ;; 10) now it sees that cursor has left, but it's too late
  72. ;; So, add the GWM_EXECUTE string...
  73.  
  74. (de mon-window-chooser (n)
  75.   (with (cur-win (window)
  76.          all-win (list-of-windows 'mapped))
  77.     (with (num-wins (length all-win)
  78.        cur-num (if (= window root-window) 0 (member cur-win all-win)))
  79.       ;; due to (% -1 4) == -1, we add in an extra num-wins:
  80.       (with (next (% (+ n num-wins cur-num) num-wins))
  81.         ;; From colas@mirsa.inria.fr to keep Epoch, with auto-raise-screen
  82.         ;; from re-raising the window -- see comments above
  83.         (if (and (= window-status 'window)
  84.          (match "^epoch" window-client-name))
  85.       (progn
  86.         (window root-window)
  87.         (set-x-property 
  88.           "GWM_EXECUTE"
  89.           (+ "(with (wob " (itoa (# next all-win)) ") (raise-window))" ))))
  90.     (window (# next all-win))
  91.     (if (= window-status 'icon)
  92.         (window (window-icon))    ;window-icon-window
  93.       (raise-window))
  94.     (set-focus)
  95.     (warp-pointer 10 10 (window))))))    ;this is gross, but i like it!!
  96.  
  97.  
  98. ;;; mon-relocate :
  99. ;; move a window, preferably onto the screen with a little room at the bottom
  100. ;; for icons.
  101.  
  102. ;; explanation of the '36' (and 16) constants: we want the window to be
  103. ;; just slightly off the bottom so that it does not overlap any of the
  104. ;; icons (thin ones!) that i put there.  thus, if we are running programs
  105. ;; with lots of output in the window, they dont have to do clipping as
  106. ;; the windows dont overlap.  This speeds things considerably in old X11R3
  107. ;; servers!
  108.  
  109. (de mon-relocate ()
  110.     (with (dx (- screen-width  (+ window-x window-client-width 16))
  111.            dy (- screen-height (+ window-y window-client-height 36)))
  112.      (if ( or (< dx 0) (< dy 0))
  113.          (move-window (min window-x (+ dx window-x))
  114.               (min window-y (+ dy window-y))))))
  115.  
  116.  
  117. ;;; mon-change-size :
  118. ;; Change size of current window.  note: emacs lies and returns 
  119. ;; (76 64) for (window-size) when it really is 80 cols, 79 non-cont, 
  120. ;; and 65 lines of text (one window) plus banner.
  121.  
  122.  
  123. (de mon-change-size ()
  124.     (with (x (# 0 window-size)
  125.        y (# 1 window-size)
  126.        w (window))                ;needed for warp-pointer
  127.       (cond
  128.        ((not (member 'Emacs window-client-class))
  129.     (progn
  130.       (cond
  131.          ((= y 65) (window-size '(80 40)))
  132.          ((= y 40) (window-size '(80 24)))
  133.          ((= y 24) (window-size '(80 65)))
  134.          (t (window-size '(80 65))))
  135.       (mon-relocate)
  136.       (warp-pointer 10 10 w)))        ;this is gross, but i like it!!
  137.        ((member "Minibuffer" window-name)    ;minibuffer
  138.       ;;(window-size (list 76 (% (+ y 1) 8))) ;resize minibuffer
  139.       (warp-pointer 10 10 w))        ;this is gross, but i like it!!
  140.        (t                    ;emacs (epoch) window
  141.     (progn
  142.       (window-size '(76 64))        ;emacs should be like this
  143.       (mon-relocate)
  144.       (warp-pointer 10 10 w))))))        ;this is gross, but i like it!!
  145.  
  146.  
  147. ;;; mon-map-all :
  148. ;; in emergency, put up everything:
  149.  
  150. (de mon-map-all ()
  151.     (for x (+ (list-of-windows 'window) (list-of-windows 'icon))
  152.      (map-window x)
  153.      (raise-window x)))
  154.  
  155.  
  156.  
  157. ;;; mon-anti-window-state :
  158. ;; close or open as appropriate
  159.  
  160. (de mon-anti-window-state ()
  161.     (progn
  162.       (iconify-window)
  163.       (map-window)
  164.       (raise-window)
  165.       (warp-pointer 10 10 (window))))        ;this is gross, but i like it!!
  166.  
  167. ;; 
  168.  
  169. ; ===========
  170. ;  Behaviors
  171. ; ===========
  172.  
  173. (: root-behavior
  174.   (state-make
  175.     ;; press or release -- both seem to work
  176.     (on (keypress (key-make "F1") alone) (mon-window-chooser 1))
  177.     (on (keyrelease (key-make "F2") alone) (mon-window-chooser -1))
  178.     (on (keyrelease (key-make "F9") alone) (mon-map-all))
  179.     (on (keyrelease (key-make "F11") alone) (mon-map-all))
  180.     (on (keyrelease (key-make "F10") alone) (mon-execute-string))
  181.     (on (keyrelease (key-make "F12") alone) (mon-execute-string))
  182.     root-behavior))
  183.  
  184. (setq root-grabs
  185.       (+ root-grabs
  186.      ;; keypress??? not key ?? keyrelease?
  187.      (list (keypress (key-make "F1") alone))
  188.      (list (keypress (key-make "F2") alone))
  189.      (list (keypress (key-make "F9") alone))
  190.      (list (keypress (key-make "F10") alone))
  191.      (list (keypress (key-make "F11") alone))
  192.      (list (keypress (key-make "F12") alone))))
  193.  
  194.  
  195. (: standard-behavior
  196.    (state-make
  197.     ;; i had keyreleases's here, but it works better with 'key'
  198.     (on (key (key-make "F1") with-alt) (circulate-windows-down))
  199.     (on (key (key-make "F2") with-alt) (circulate-windows-up))
  200.     (on (key (key-make "F1") alone) (mon-window-chooser 1))
  201.     (on (key (key-make "F2") alone) (mon-window-chooser -1))
  202.     (on (keyrelease  "F3" alone) (mon-anti-window-state))
  203.     (on (keyrelease (key-make "F4") alone) (mon-change-size))
  204.     (on (keyrelease "F5" alone) (raise-window))
  205.     (on (keyrelease (key-make "F9") alone) (mon-map-all))
  206.     (on (keyrelease (key-make "F11") alone) (mon-map-all))
  207.     (on (keyrelease (key-make "F12") alone) (mon-execute-string))
  208.     (on (keyrelease (key-make "F10") alone) (mon-execute-string))
  209.     standard-behavior))            ; normal behavior
  210.  
  211. (setq icon-grabs
  212.       (+ icon-grabs
  213.      (list (keypress (key-make "F1") alone))
  214.      (list (keypress (key-make "F2") alone))
  215.      (list (keypress (key-make "F3") alone))
  216.      (list (keypress (key-make "F9") alone))
  217.      (list (keypress (key-make "F10") alone))
  218.      (list (keypress (key-make "F11") alone))
  219.      (list (keypress (key-make "F12") alone))))
  220.  
  221.  
  222. (setq window-grabs            ; to trap the event for the windows
  223.       (+ window-grabs 
  224.      (list (buttonpress 3 (together with-alt with-control)))
  225.      (list (keypress (key-make "F1") alone))
  226.      (list (keypress (key-make "F2") alone))
  227.      (list (keypress (key-make "F3") alone))
  228.      (list (keypress (key-make "F4") alone))
  229.      (list (keypress (key-make "F5") alone))
  230.      (list (keypress (key-make "F1") with-alt))
  231.      (list (keypress (key-make "F2") with-alt))
  232.      (list (keypress (key-make "F9") alone))
  233.      (list (keypress (key-make "F10") alone))
  234.      (list (keypress (key-make "F11") alone))
  235.      (list (keypress (key-make "F12") alone))))
  236.  
  237.  
  238. ;; An alternate method of key naming:
  239.  
  240. ;; (: CtrlAltF1 (key "F1" (together with-alt with-control))) ;
  241. ;; (: standard-behavior (state-make
  242. ;;     standard-behavior
  243. ;;     (on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))))
  244.  
  245.  
  246. ;; An alternate way of doing multiple assignments:
  247.  
  248. ;; (: grabs (: root-grabs (: window-grabs (: icon-grabs
  249. ;;     (+ visibility-grabs grabs)))))
  250.  
  251.  
  252.  
  253.  
  254. (reparse-standard-behaviors)        ; register these changes
  255.  
  256. (provide 'mon-keys)
  257.