[sawfish/edge-actions] customizable edge-actions for while-moving-hook

[Christopher Bratusek <chrisb src gnome org>]

commit 7e3b91e25870ad42345af8631ef1f7b4aa91e044
Author: Christopher Roy Bratusek <zanghar freenet de>
Date:   Sat Nov 6 09:29:35 2010 +0100

    customizable edge-actions for while-moving-hook

 lisp/sawfish/wm/edge/actions.jl |   51 +++++++++++++++++++++++++++++++++++---
 1 files changed, 47 insertions(+), 4 deletions(-)
---
diff --git a/lisp/sawfish/wm/edge/actions.jl b/lisp/sawfish/wm/edge/actions.jl
index 5c7e01d..6bd1bd4 100644
--- a/lisp/sawfish/wm/edge/actions.jl
+++ b/lisp/sawfish/wm/edge/actions.jl
@@ -54,21 +54,41 @@
     :group edge-actions
     :type (choice hot-spot viewport-drag flip-workspace flip-viewport none))
 
+  (defcustom left-edge-move-func 'none
+    "Action for the left screen-edge while moving a window."
+    :group edge-actions
+    :type  (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+
   (defcustom top-edge-func 'none
     "Action for the top screen-edge."
     :group edge-actions
     :type (choice hot-spot viewport-drag flip-workspace flip-viewport none))
 
+  (defcustom top-edge-move-func 'none
+    "Action for the top screen-edge while moving."
+    :group edge-actions
+    :type  (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+
   (defcustom right-edge-func 'none
     "Action for the right screen-edge."
     :group edge-actions
     :type (choice hot-spot viewport-drag flip-workspace flip-viewport none))
 
+  (defcustom right-edge-move-func 'none
+    "Action for the right screen-edge."
+    :group edge-actions
+    :type  (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+
   (defcustom bottom-edge-func 'none
     "Action for the bottom screen-edge."
     :group edge-actions
     :type (choice hot-spot viewport-drag flip-workspace flip-viewport none))
 
+  (defcustom bottom-edge-move-func 'none
+    "Action for the bottom screen-edge while moving."
+    :group edge-actions
+    :type  (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+
   (define (edge-action-call func edge)
     (case func
       ((hot-spot)
@@ -103,16 +123,39 @@
 		  (quotient edge-actions-delay 1000)
 		  (mod edge-actions-delay 1000)))))))
 
+  (define (edge-action-move-init)
+    (let ((corner (get-active-corner))
+	  (edge (get-active-edge)))
+      (if corner
+	  (hot-spot-activate corner)
+	(setq func nil)
+	(cond ((eq edge 'left)
+	       (make-timer (lambda () (edge-action-call left-edge-move-func edge))
+		  (quotient edge-actions-delay 1000)
+		  (mod edge-actions-delay 1000)))
+	      ((eq edge 'right)
+               (make-timer (lambda () (edge-action-call right-edge-move-func edge))
+		  (quotient edge-actions-delay 1000)
+		  (mod edge-actions-delay 1000)))
+	      ((eq edge 'top)
+	       (make-timer (lambda () (edge-action-call top-edge-move-func edge))
+		  (quotient edge-actions-delay 1000)
+		  (mod edge-actions-delay 1000)))
+	      ((eq edge 'bottom)
+	       (make-timer (lambda () (edge-action-call bottom-edge-move-func edge))
+		  (quotient edge-actions-delay 1000)
+		  (mod edge-actions-delay 1000)))))))
+
   (define (edges-activate)
     (if edge-actions-enabled
 	(progn
 	  (flippers-activate t)
 	  (unless (in-hook-p 'enter-flipper-hook edge-action-init)
 	      (add-hook 'enter-flipper-hook edge-action-init))
-	  (unless (in-hook-p 'while-moving-hook edge-action-init)
-	      (add-hook 'while-moving-hook edge-action-init)))
+	  (unless (in-hook-p 'while-moving-hook edge-action-move-init)
+	      (add-hook 'while-moving-hook edge-action-move-init)))
       (flippers-activate nil)
       (if (in-hook-p 'enter-flipper-hook edge-action-init)
 	  (remove-hook 'enter-flipper-hook edge-action-init))
-      (if (in-hook-p 'while-moving-hook edge-action-init)
-	  (remove-hook 'while-moving-hook edge-action-init)))))
+      (if (in-hook-p 'while-moving-hook edge-action-move-init)
+	  (remove-hook 'while-moving-hook edge-action-move-init)))))