;;; keydrag.jl --- Functions for moving windows from the keyboard. ;; Copyright 1999,2000,2002 by Dave Pearson ;; $Revision: 1.7 $ ;; keydrag.jl is free software distributed under the terms of the GNU ;; General Public Licence, version 2. For details see the file COPYING. ;;; Commentary: ;; ;; keydrag.jl provides a set of functions that allow you to drag windows ;; around using only the keyboard. To use these functions simply add this: ;; ;; (require 'keydrag) ;; ;; to your ~/.sawfishrc file and then use the sawfish keyboard bindings ;; dialog to bind the various dragging functions to keys. ;; ;; The impatient user might like to skip the above binding step and instead ;; add this: ;; ;; (keydrag-keypad-bindings) ;; ;; to their ~/.sawfishrc after the above `require'. This will result in a ;; set of numeric keypad based bindings. The various keypad keys in ;; conjunction with ALT will quickly move the window in that direction (the ;; keydrag-*-step variables control the defintion of "quickly"). ;; ;; The keypad keys in conjunction with CTRL-ALT will move the window slowly, ;; allowing fine control of the position of the window. ;; ;; See the documentation for `keydrag-keypad-bindings' for more information. ;;; Thanks: ;; ;; Ryan Pavlik for pointing out that some people need the cursor to track ;; the movement of the window (which inspired the addition of the hooks). ;;; Code: ;; Things we need: (require 'sawfish.wm.placement) ;; Customise options. (defgroup keydrag "Keyboard window dragging") (defcustom keydrag-horizontal-step 10 "Number of pixels to step horizontally." :group keydrag :type number :allow-nil nil) (defcustom keydrag-vertical-step 10 "Number of pixels to step vertically." :group keydrag :type number :allow-nil nil) ;; Hook variables. (defvar keydrag-before-move-hook nil "Evaluated before a window is moved. Each function in the hook will be passed three parameters: W is the window that will be moved. H is an indication horizontal movement. V is an indication of vertical movement.") (defvar keydrag-after-move-hook nil "Evaluated after a window is moved. Each function in the hook will be passed three parameters: W is the window that has been moved. H is an indication horizontal movement. V is an indication of vertical movement.") (defvar keydrag-before-center-hook nil "Evaluated before a window is centered. Each function in the hook will be passed the handle of the window that is about the be centered.") (defvar keydrag-after-center-hook nil "Evaluated after a window is centered. Each function in the hook will be passed the handle of the window that has just been centered.") ;; Main code. (defun keydrag-move-window (w h v) "Reposition window W moving in the direction indicated by H and V." (call-hook 'keydrag-before-move-hook (list w h v)) (let ((pos (window-position w))) (move-window-to w (+ (car pos) (* h keydrag-horizontal-step)) (+ (cdr pos) (* v keydrag-vertical-step)))) (call-hook 'keydrag-after-move-hook (list w h v))) (defmacro keydrag-make-movement-command (v h slow) "Create a keyboard dragging command. V should be UP, DOWN or NIL. H should be LEFT, RIGHT or NIL. When SLOW is non-nil the resulting command will move the window by a single point." `(defun ,(intern (format nil "keydrag-%s%s%s" (or v "") (or h "") (if slow "-slowly" ""))) (w) ,(format nil "%sove the current window %s." (if slow "Slowly m" "M") (if (and v h) (format nil "%s and to the %s" v h) (format nil "%s" (or v h)))) (interactive "%W") (let ,(when slow '((keydrag-horizontal-step 1) (keydrag-vertical-step 1))) (keydrag-move-window w ,(case h ((left) -1) ((right) 1) (t 0)) ,(case v ((up) -1) ((down) 1) (t 0)))))) ;; Create all the different keydragging commands. (let ((h '(up down ())) (v '(left right ()))) (mapc (lambda (x) (mapc (lambda (y) (when (or x y) ;; This eval feels wrong but I can't call the above ;; macro with variable arguments without doing this. I ;; guess I'm missing something in the above macro. (eval `(progn (keydrag-make-movement-command ,x ,y ()) (keydrag-make-movement-command ,x ,y t))))) v)) h)) (defun keydrag-center (w) "Move the current window to the center of the display." (interactive "%W") (call-hook 'keydrag-before-center-hook (list w)) ((placement-mode 'centered) w) (call-hook 'keydrag-after-center-hook (list w))) (defun keydrag-keypad-bindings (#!optional keymap prefix slow-prefix) "Bind the dragging functions to keypad keys. KEYMAP is the keymap to bind to keys in, if not supplied `window-keymap' is used. PREFIX is the key prefix to use. If not supplied \"A\" (alt) is used. SLOW-PREFIX is the key prefix to use for slow movement. If not supplied \"C-A\" (control alt) is used." (mapc (lambda (binding) (bind-keys (or keymap window-keymap) (format nil "%s-KP_%s" (or prefix "A") (car binding)) (intern (format nil "keydrag-%S" (cdr binding))) (format nil "%s-KP_%s" (or slow-prefix "C-A") (car binding)) (intern (format nil "keydrag-%S-slowly" (cdr binding))))) '(("7" . upleft) ("4" . left) ("1" . downleft) ("2" . down) ("3" . downright) ("6" . right) ("9" . upright) ("8" . up))) ;; There is no center-slowly, do center on its own. (bind-keys (or keymap window-keymap) (format nil "%s-KP_5" (or prefix "A")) 'keydrag-center)) (provide 'keydrag) ;;; keydrag.jl ends here