Generic_Window_Manager/data/mon-keys.gwm

257 lines
8.9 KiB
Plaintext

; =====================================================================
; Mike Newton's (newton@gumby.cs.caltech.edu) keys
; =====================================================================
;; Mike Newton <newton@gumby.cs.caltech.edu> code to add gwm functions to
;; function keys. Another step in "No More Mice" (just why didn't they
;; call the 'rats'? Their tails sure look more like a rats tail....)
;; 92.02.28 -- remove mouse button remmapings
; Doug Bogia <bogia@cs.uiuc.edu>
;; 91.01.3 -- add in more changes from colas@mirsa.inria.fr, add
;; new functions (F5 - forced raise), clean up code,
;; fixed comments, fix mon-relocate, added button back
;; in so everything is one place
;;
;; 91.01.02 -- colas@mirsa.inria.fr, extracted Fkey code from MON's
;; .profile.gwm into a separate file "mon-keys.gwm"
;; mapped also F11 and F12 to F9 & F10 for keyboards with only
;; 10 Fkeys
;; 90.12.28 -- newton@gumby.cs.caltech.edu, updated to 1.7b. Added more Fkeys
;; 90.12.7 -- newton@gumby.cs.caltech.edu, original hacks.
;; Current Keys:
;; F1 (alone) : choose next window
;; F2 (alone) : choose previous
;; F1 (w/ alt) : circulate down (no focus change)
;; F2 (w/ alt) : circulate up (no focus change)
;; F3 (alone) : open / close
;; F4 (various) : change window sizes (not Emacs!)
;; F5 (alone) : raise
;; F11 or F9 (alone, in root) : emergency -- map everything
;; F12 or F10 (alone) : exec cut buffer, printing results
;;
;;
; ===================
; Utility Functions
; ===================
;;; mon-execute-string :
;; given N items, print N results, not just the last one:
(defun mon-execute-string ()
(print "\n")
(print (execute-string
(+ "(mapfor v (list "
(cut-buffer)
") (print v) (print \"\\n\"))" )))
(print "\n"))
;;; mon-window-chooser :
;; pick a next window, raise it and such.
;; WARNING: fails in a minor way if epoch "auto-raise-screen" is t !!!!!
;; From colas@mirsa.inria.fr:
;; 1) user presses F1
;; 2) X server establishes a grab on press, to the benefit of the client having
;; grabbed F1, i.e. gwm
;; 3) so epoch sees the cursor "leaving" its window into the "grab" realm
;; 4) user releases key, code below (on (keyrelease F1... ))) gets activated
;; 5) your code move the cursor & focus, but epoch sees nothing
;; 6) the grab is released, by the X server
;; 7) epoch sees the cursor as coming back to its window from "grab" state
;; 8)... but doesnt check the event queue to see that it immediately leaves it!
;; 9) so it re-raises it screen
;; 10) now it sees that cursor has left, but it's too late
;; So, add the GWM_EXECUTE string...
(de mon-window-chooser (n)
(with (cur-win (window)
all-win (list-of-windows 'mapped))
(with (num-wins (length all-win)
cur-num (if (= window root-window) 0 (member cur-win all-win)))
;; due to (% -1 4) == -1, we add in an extra num-wins:
(with (next (% (+ n num-wins cur-num) num-wins))
;; From colas@mirsa.inria.fr to keep Epoch, with auto-raise-screen
;; from re-raising the window -- see comments above
(if (and (= window-status 'window)
(match "^epoch" window-client-name))
(progn
(window root-window)
(set-x-property
"GWM_EXECUTE"
(+ "(with (wob " (itoa (# next all-win)) ") (raise-window))" ))))
(window (# next all-win))
(if (= window-status 'icon)
(window (window-icon)) ;window-icon-window
(raise-window))
(set-focus)
(warp-pointer 10 10 (window)))))) ;this is gross, but i like it!!
;;; mon-relocate :
;; move a window, preferably onto the screen with a little room at the bottom
;; for icons.
;; explanation of the '36' (and 16) constants: we want the window to be
;; just slightly off the bottom so that it does not overlap any of the
;; icons (thin ones!) that i put there. thus, if we are running programs
;; with lots of output in the window, they dont have to do clipping as
;; the windows dont overlap. This speeds things considerably in old X11R3
;; servers!
(de mon-relocate ()
(with (dx (- screen-width (+ window-x window-client-width 16))
dy (- screen-height (+ window-y window-client-height 36)))
(if ( or (< dx 0) (< dy 0))
(move-window (min window-x (+ dx window-x))
(min window-y (+ dy window-y))))))
;;; mon-change-size :
;; Change size of current window. note: emacs lies and returns
;; (76 64) for (window-size) when it really is 80 cols, 79 non-cont,
;; and 65 lines of text (one window) plus banner.
(de mon-change-size ()
(with (x (# 0 window-size)
y (# 1 window-size)
w (window)) ;needed for warp-pointer
(cond
((not (member 'Emacs window-client-class))
(progn
(cond
((= y 65) (window-size '(80 40)))
((= y 40) (window-size '(80 24)))
((= y 24) (window-size '(80 65)))
(t (window-size '(80 65))))
(mon-relocate)
(warp-pointer 10 10 w))) ;this is gross, but i like it!!
((member "Minibuffer" window-name) ;minibuffer
;;(window-size (list 76 (% (+ y 1) 8))) ;resize minibuffer
(warp-pointer 10 10 w)) ;this is gross, but i like it!!
(t ;emacs (epoch) window
(progn
(window-size '(76 64)) ;emacs should be like this
(mon-relocate)
(warp-pointer 10 10 w)))))) ;this is gross, but i like it!!
;;; mon-map-all :
;; in emergency, put up everything:
(de mon-map-all ()
(for x (+ (list-of-windows 'window) (list-of-windows 'icon))
(map-window x)
(raise-window x)))
;;; mon-anti-window-state :
;; close or open as appropriate
(de mon-anti-window-state ()
(progn
(iconify-window)
(map-window)
(raise-window)
(warp-pointer 10 10 (window)))) ;this is gross, but i like it!!
;;
; ===========
; Behaviors
; ===========
(: root-behavior
(state-make
;; press or release -- both seem to work
(on (keypress (key-make "F1") alone) (mon-window-chooser 1))
(on (keyrelease (key-make "F2") alone) (mon-window-chooser -1))
(on (keyrelease (key-make "F9") alone) (mon-map-all))
(on (keyrelease (key-make "F11") alone) (mon-map-all))
(on (keyrelease (key-make "F10") alone) (mon-execute-string))
(on (keyrelease (key-make "F12") alone) (mon-execute-string))
root-behavior))
(setq root-grabs
(+ root-grabs
;; keypress??? not key ?? keyrelease?
(list (keypress (key-make "F1") alone))
(list (keypress (key-make "F2") alone))
(list (keypress (key-make "F9") alone))
(list (keypress (key-make "F10") alone))
(list (keypress (key-make "F11") alone))
(list (keypress (key-make "F12") alone))))
(: standard-behavior
(state-make
;; i had keyreleases's here, but it works better with 'key'
(on (key (key-make "F1") with-alt) (circulate-windows-down))
(on (key (key-make "F2") with-alt) (circulate-windows-up))
(on (key (key-make "F1") alone) (mon-window-chooser 1))
(on (key (key-make "F2") alone) (mon-window-chooser -1))
(on (keyrelease "F3" alone) (mon-anti-window-state))
(on (keyrelease (key-make "F4") alone) (mon-change-size))
(on (keyrelease "F5" alone) (raise-window))
(on (keyrelease (key-make "F9") alone) (mon-map-all))
(on (keyrelease (key-make "F11") alone) (mon-map-all))
(on (keyrelease (key-make "F12") alone) (mon-execute-string))
(on (keyrelease (key-make "F10") alone) (mon-execute-string))
standard-behavior)) ; normal behavior
(setq icon-grabs
(+ icon-grabs
(list (keypress (key-make "F1") alone))
(list (keypress (key-make "F2") alone))
(list (keypress (key-make "F3") alone))
(list (keypress (key-make "F9") alone))
(list (keypress (key-make "F10") alone))
(list (keypress (key-make "F11") alone))
(list (keypress (key-make "F12") alone))))
(setq window-grabs ; to trap the event for the windows
(+ window-grabs
(list (buttonpress 3 (together with-alt with-control)))
(list (keypress (key-make "F1") alone))
(list (keypress (key-make "F2") alone))
(list (keypress (key-make "F3") alone))
(list (keypress (key-make "F4") alone))
(list (keypress (key-make "F5") alone))
(list (keypress (key-make "F1") with-alt))
(list (keypress (key-make "F2") with-alt))
(list (keypress (key-make "F9") alone))
(list (keypress (key-make "F10") alone))
(list (keypress (key-make "F11") alone))
(list (keypress (key-make "F12") alone))))
;; An alternate method of key naming:
;; (: CtrlAltF1 (key "F1" (together with-alt with-control))) ;
;; (: standard-behavior (state-make
;; standard-behavior
;; (on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))))
;; An alternate way of doing multiple assignments:
;; (: grabs (: root-grabs (: window-grabs (: icon-grabs
;; (+ visibility-grabs grabs)))))
(reparse-standard-behaviors) ; register these changes
(provide 'mon-keys)