home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / bind-key.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  2KB  |  65 lines
  1. ;; bind-key.gwm --- Bind keys or buttons to actions dynamically
  2. ;;
  3. ;; Author: Anders Holst  (aho@sans.kth.se)  
  4. ;; Copyright (C) 1995  Anders Holst
  5. ;; Last change: 9/2
  6. ;;
  7. ;; This file is copyrighted under the same terms as the rest of GWM
  8. ;; (see the X Inc license for details). There is no warranty that it
  9. ;; works. 
  10. ;;
  11. ;; --------------------------------------------------------------------- 
  12. ;;
  13. ;; The function 'bind-key' can be used to globally (ie in all windows
  14. ;; and in the root) bind a key or button to some WOOL code action.
  15. ;; The binding takes effect immediately after the call.
  16. ;;
  17. ;; The first argument to 'bind-key' can be an event (constructed with
  18. ;; key, keypress, keyrelease, button, buttonpress or buttonrelease), a
  19. ;; string denoting a key (like "a" or "F1" or "Insert"), or a number
  20. ;; denoting a mouse button. It may also be a list where the first element
  21. ;; is a string or number and the second element specifies which modifiers
  22. ;; to use (with-shift, with-alt etc).
  23. ;;
  24. ;; The second argument is the WOOL code to run. To unbind a key or  
  25. ;; button, use () as the second argument.
  26. ;;
  27. ;; For example:
  28. ;;   (bind-key "F1" '(? "Silly action\n"))  ; Bind F1.
  29. ;;   (bind-key "F1" ())                    ; Unbind it again.
  30. ;;   
  31.  
  32. (defun bind-interpret-event (event)
  33.   (if (= (type event) 'event)
  34.         event
  35.       (= (type event) 'string)
  36.         (keypress (key-make event) alone)
  37.       (= (type event) 'number)
  38.         (buttonbress event alone)
  39.       (and (= (type event) 'list)
  40.            (= (type (# 0 event)) 'string))
  41.         (keypress (key-make (# 0 event)) 
  42.                   (eval (+ '(together) (sublist 1 (length event) event))))
  43.       (and (= (type event) 'list)
  44.            (= (type (# 0 event)) 'number))
  45.         (buttonpress (# 0 event)
  46.                      (eval (+ '(together) (sublist 1 (length event) event))))))
  47.  
  48. (defun bind-root-behavior (event action)
  49.   (if (boundp 'root-behavior)
  50.       (with (wob root-window
  51.              behavior (eval (list 'on event action))
  52.              grab (eval event))
  53.         (setq root-behavior (state-make behavior root-behavior))
  54.         (setq root-fsm (fsm-make root-behavior))
  55.         (wob-fsm root-fsm)
  56.         (if action
  57.             (set-grabs grab)
  58.           (unset-grabs grab)))))
  59.  
  60. (defun bind-key (event action)
  61.   (with (event (bind-interpret-event event))
  62.     (if event
  63.         (bind-root-behavior event action))))
  64.  
  65.