[patch] Edge proposal

[Teika Kazura <teika lavabit com>]

Hi. Let me send a patch which does some clean-up in edge. It touches
actions, flip, hot-spot and viewport-drag.

------------------------------------------------------------------------
* Renaming:
  + "activate", "call", "init" confusion is busted.
    Now "activate" is only used in "edges-activate" (and
    "flippers-activate".)
    viewport-drag-activate -> viewport-drag-invoke
    edge-flip-activate -> edge-flip-invoke
    hot-spot-activate -> hot-spot-invoke
  + actions defcustom "left-right-edge-func" -> "*-edge-action"
  + Hot spot variables
    *-edge/corner-program -> ***-function
  + Internal functions
    edge-action-init -> edge-action-hook-func and so on.

* "*-edge-action" choice change
  "none" and "hot-spot" are merged to "none/hot-spot"
  When a user wants to use hot-spots, then they don't have to
  set these variables. (If the previous choices remain and they're
  set to "none" or "hot-spot", it doesn't harm. none/hot-spot is
  a fallback.)

* Delay
  The delay option is split into edge-flip-delay and hot-spot-delay.
  and the code is moved from actions.jl to hot-spot.jl and flip.jl.

* Deleted unused internal variables:
  actions.jl: "func", "no-enter"
  flip.jl: ef-current-page

* Code cleanup in hot-spot. Default empty lambdas are not necessary
  any more.

* Corrected copyright of infinite-desktop. David McWherter released it
  as public domain. (It's ok to protect it with GPL. I doubt that logic,
  though.)

* Some doc.
* Indent fix.
------------------------------------------------------------------------
Sorry for mixing all into one. If you don't like some part, I'll
re-create the patch. I think it's better to let you know earlier.
No changelog yet.

With best regards,
Teika (Teika kazura)

diff --git a/lisp/sawfish/wm/edge/actions.jl b/lisp/sawfish/wm/edge/actions.jl
index 893bd1d..1b84e79 100644
--- a/lisp/sawfish/wm/edge/actions.jl
+++ b/lisp/sawfish/wm/edge/actions.jl
@@ -24,7 +24,6 @@
 
     (open rep
 	  rep.system
-	  rep.io.timers
 	  sawfish.wm.misc
 	  sawfish.wm.events
 	  sawfish.wm.custom
@@ -35,100 +34,69 @@
 
   (define-structure-alias edge-actions sawfish.wm.edge.actions)
 
-  (define func nil)
-  (define no-enter nil)
-
-  (defcustom edge-actions-delay 250
-    "Delay (in miliseconds) before the edges are activated.
-hot-spots are activated in half that time, viewport-drag is
-activated immediately, aswell as actions for while-moving a window."
-    :group edge-actions
-    :type number
-    :range (50 . nil))
-
-  (defcustom left-right-edge-func 'none
+  (defcustom left-right-edge-action 'none/hot-spot
     "Action for the left and right screen-edge."
     :group edge-actions
-    :type (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+    :type (choice none/hot-spot viewport-drag flip-workspace flip-viewport))
 
-  (defcustom left-right-edge-move-func 'none
+  (defcustom left-right-edge-move-action 'none/hot-spot
     "Action for the left and right screen-edge while moving a window."
     :group edge-actions
-    :type  (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+    :type  (choice none/hot-spot viewport-drag flip-workspace flip-viewport))
 
-  (defcustom top-bottom-edge-func 'none
+  (defcustom top-bottom-edge-action 'none/hot-spot
     "Action for the top and bottom screen-edge."
     :group edge-actions
-    :type (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+    :type (choice none/hot-spot viewport-drag flip-workspace flip-viewport))
 
-  (defcustom top-bottom-edge-move-func 'none
+  (defcustom top-bottom-edge-move-action 'none/hot-spot
     "Action for the top and bottom screen-edge while moving."
     :group edge-actions
-    :type  (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+    :type  (choice none/hot-spot viewport-drag flip-workspace flip-viewport))
 
   (define (edge-action-call func edge)
     (case func
-      ((hot-spot)
-       ;; halve the edge delay for hot-spots
-       (make-timer (lambda ()
-           (hot-spot-activate edge))
-	 (quotient edge-actions-delay 2000)
-	 (mod edge-actions-delay 2000)))
       ((viewport-drag)
-       ;; no delay for viewport-drag
-       (viewport-drag-activate edge))
-      ;; full delay for flipping
+       (viewport-drag-invoke edge))
       ((flip-workspace)
-       (make-timer (lambda ()
-	   (edge-flip-activate edge 'workspace))
-	 (quotient edge-actions-delay 1000)
-	 (mod edge-actions-delay 1000)))
+       (edge-flip-invoke edge 'workspace))
       ((flip-viewport)
-       (make-timer (lambda ()
-           (edge-flip-activate edge 'viewport))
-	 (quotient edge-actions-delay 1000)
-	 (mod edge-actions-delay 1000)))))
-
-  (define (edge-action-init)
-    (unless no-enter
-      (let ((corner (get-active-corner))
-	    (edge (get-active-edge)))
-	  (if corner
-	      ;; halve the delay for hot-spots
-	      (make-timer (lambda ()
-		  (hot-spot-activate corner))
-		(quotient edge-actions-delay 2000)
-		(mod edge-actions-delay 2000))
-	    (setq func nil)
-	    (cond ((or (eq edge 'left)
-		       (eq edge 'right))
-	           (edge-action-call left-right-edge-func edge))
-		  ((or (eq edge 'top)
-		       (eq edge 'bottom))
-		   (edge-action-call top-bottom-edge-func edge)))))))
-
-  (define (edge-action-move-init)
-    (setq func nil)
-    (setq no-enter t)
+       (edge-flip-invoke edge 'viewport))
+      (t (hot-spot-invoke edge))))
+
+  ;; Entry point without dragging 
+  (define (edge-action-hook-func)
+    (let ((corner (get-active-corner))
+	  (edge (get-active-edge)))
+      (if corner
+	  (hot-spot-invoke corner)
+	(cond ((or (eq edge 'left)
+		   (eq edge 'right))
+	       (edge-action-call left-right-edge-action edge))
+	      ((or (eq edge 'top)
+		   (eq edge 'bottom))
+	       (edge-action-call top-bottom-edge-action edge))))))
+
+  ;; Entry point for window dragging
+  (define (edge-action-move-hook-func)
     (let ((edge (get-active-edge)))
       (cond ((or (eq edge 'left)
 		 (eq edge 'right))
-	     (edge-action-call left-right-edge-move-func edge))
+	     (edge-action-call left-right-edge-move-action edge))
 	    ((or (eq edge 'top)
 		 (eq edge 'bottom))
-	     (edge-action-call top-bottom-edge-move-func edge))))
-    (setq no-enter nil))
+	     (edge-action-call top-bottom-edge-move-action edge)))))
 
   (define (edges-activate init)
     (if init
 	(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-move-init)
-	      (add-hook 'while-moving-hook edge-action-move-init)))
+	  (unless (in-hook-p 'enter-flipper-hook edge-action-hook-func)
+	    (add-hook 'enter-flipper-hook edge-action-hook-func))
+	  ;; While the pointer is grabbed, window enter/leave events
+	  ;; are not generated.
+	  (unless (in-hook-p 'while-moving-hook edge-action-move-hook-func)
+	    (add-hook 'while-moving-hook edge-action-move-hook-func)))
       (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-move-init)
-	  (remove-hook 'while-moving-hook edge-action-move-init)))))
+      (remove-hook 'enter-flipper-hook edge-action-hook-func)
+      (remove-hook 'while-moving-hook edge-action-move-hook-func))))
diff --git a/lisp/sawfish/wm/edge/flip.jl b/lisp/sawfish/wm/edge/flip.jl
index 1676ffd..7036442 100644
--- a/lisp/sawfish/wm/edge/flip.jl
+++ b/lisp/sawfish/wm/edge/flip.jl
@@ -21,7 +21,7 @@
 
 (define-structure sawfish.wm.edge.flip
 
-    (export edge-flip-activate)
+    (export edge-flip-invoke)
 
     (open rep
 	  rep.system
@@ -37,9 +37,19 @@
 
   (define-structure-alias edge-flip sawfish.wm.edge.flip)
 
-  (define ef-current-edge nil)
+  (defcustom edge-flip-delay 250
+    "Delay (in milliseconds) of flipping of viewport / workspace."
+    :group edge-actions
+    :type number
+    :range (0 . nil))
 
-  (define (edge-flip-activate edge type)
+  (define (edge-flip-invoke edge type)
+    (make-timer (lambda ()
+		  (flip-core edge type))
+		(quotient edge-flip-delay 1000)
+		(mod edge-flip-delay 1000)))
+
+  (define (flip-core edge type)
     (let ((ptr (query-pointer t)))
       (before-flip)
       (if (eq type 'viewport)
diff --git a/lisp/sawfish/wm/edge/hot-spots.jl b/lisp/sawfish/wm/edge/hot-spots.jl
index 394c602..c84e8ae 100644
--- a/lisp/sawfish/wm/edge/hot-spots.jl
+++ b/lisp/sawfish/wm/edge/hot-spots.jl
@@ -1,4 +1,4 @@
-;; hot-spots.jl 3.0.0 -- perform actions when hitting the screen-edge
+;; hot-spots.jl 3.0.0 -- Invoke user functions when hitting the screen-edge
 
 ;; Copyright (C) 2010 Christopher Roy Bratusek <zanghar freenet de>
 
@@ -20,7 +20,7 @@
 
 (define-structure sawfish.wm.edge.hot-spots
 
-    (export hot-spot-activate)
+    (export hot-spot-invoke)
 
     (open rep
 	  rep.system
@@ -33,45 +33,60 @@
 
   (define-structure-alias hot-spots sawfish.wm.edge.hot-spots)
 
-  (defvar left-edge-program (lambda () t)
-    "The program launched when hitting the left-edge.")
-
-  (defvar top-left-corner-program (lambda () t)
-    "The program launched when hitting the top-left-corner.")
-
-  (defvar top-edge-program (lambda () t)
-    "The program launched when hitting the top-edge.")
-
-  (defvar top-right-corner-program (lambda () t)
-    "The program launched when hitting the top-right-corner.")
-
-  (defvar right-edge-program (lambda () t)
-    "The program launched when hitting the right-edge.")
-
-  (defvar bottom-right-corner-program (lambda () t)
-    "The program launched when hitting the bottom-right-corner.")
-
-  (defvar bottom-edge-program (lambda () t)
-    "The program launched when hitting the bottom-edge.")
-
-  (defvar bottom-left-corner-program (lambda () t)
-    "The program launched when hitting the bottom-left-corner.")
-
-  (define (hot-spot-activate spot)
-    (case spot
-      ((top-left)
-       (funcall top-left-corner-program))
-      ((top-right)
-       (funcall top-right-corner-program))
-      ((bottom-right)
-       (funcall bottom-right-corner-program))
-      ((bottom-left)
-       (funcall bottom-left-corner-program))
-      ((left)
-       (funcall left-edge-program))
-      ((top)
-       (funcall top-edge-program))
-      ((right)
-       (funcall right-edge-program))
-      ((bottom)
-       (funcall bottom-edge-program)))))
+  (defcustom hot-spot-delay 250
+    "Delay (in milliseconds) of hot-spot."
+    :group edge-actions
+    :type number
+    :range (0 . nil))
+
+  (defvar left-edge-function nil
+    "The function launched when hitting the left-edge.")
+
+  (defvar top-left-corner-function nil
+    "The function launched when hitting the top-left-corner.")
+
+  (defvar top-edge-function nil
+    "The function launched when hitting the top-edge.")
+
+  (defvar top-right-corner-function nil
+    "The function launched when hitting the top-right-corner.")
+
+  (defvar right-edge-function nil
+    "The function launched when hitting the right-edge.")
+
+  (defvar bottom-right-corner-function nil
+    "The function launched when hitting the bottom-right-corner.")
+
+  (defvar bottom-edge-function nil
+    "The function launched when hitting the bottom-edge.")
+
+  (defvar bottom-left-corner-function nil
+    "The function launched when hitting the bottom-left-corner.")
+
+  (define (hot-spot-invoke spot)
+    (let ((func (case spot
+		  ((top-left)
+		   top-left-corner-function)
+		  ((top-right)
+		   top-right-corner-function)
+		  ((bottom-right)
+		   bottom-right-corner-function)
+		  ((bottom-left)
+		   bottom-left-corner-function)
+		  ((left)
+		   left-edge-function)
+		  ((top)
+		   top-edge-function)
+		  ((right)
+		   right-edge-function)
+		  ((bottom)
+		   bottom-edge-function))))
+      (if (functionp func)
+	  (make-timer (lambda ()
+			(funcall func))
+		      (quotient hot-spot-delay 1000)
+		      (mod hot-spot-delay 1000))
+	(when func
+	  ;; non-nil, but not a function?
+	  (error "In hot-spot, you configuration of `%s' is wrong; it should be a function." spot))
+	))))
diff --git a/lisp/sawfish/wm/edge/util.jl b/lisp/sawfish/wm/edge/util.jl
index 43d60e8..462f435 100644
--- a/lisp/sawfish/wm/edge/util.jl
+++ b/lisp/sawfish/wm/edge/util.jl
@@ -21,10 +21,10 @@
 (define-structure sawfish.wm.edge.util
 
     (compound-interface
-      (structure-interface sawfish.wm.edge.subrs)
-      (export flippers-activate
-	      get-active-corner
-	      get-active-edge))
+     (structure-interface sawfish.wm.edge.subrs)
+     (export flippers-activate
+	     get-active-corner
+	     get-active-edge))
 
     (open rep
 	  rep.system
@@ -45,9 +45,9 @@
 	    (add-hook 'randr-change-notify-hook recreate-flippers)))
       (disable-flippers)
       (if (in-hook-p 'after-restacking-hook flippers-after-restacking)
-	(remove-hook 'after-restacking-hook flippers-after-restacking))
+	  (remove-hook 'after-restacking-hook flippers-after-restacking))
       (if (in-hook-p 'randr-change-notify-hook recreate-flippers)
-	(remove-hook 'randr-change-notify-hook recreate-flippers))))
+	  (remove-hook 'randr-change-notify-hook recreate-flippers))))
 
   (defcustom hot-spots-area 50
     "Lenght in px (in both x and y direction) wich is used as hot-spots-area."
@@ -55,37 +55,37 @@
     :range (5 . 500)
     :group edge-actions)
 
-   (define (get-active-corner)
+  (define (get-active-corner)
     (let ((cursor-x (car (query-pointer)))
 	  (cursor-y (cdr (query-pointer))))
       (cond ((or (and (< cursor-x hot-spots-area)
-		    (<= cursor-y 1))
+		      (<= cursor-y 1))
 		 (and (<= cursor-x 1)
-		    (< cursor-y hot-spots-area)))
-		   'top-left)
+		      (< cursor-y hot-spots-area)))
+	     'top-left)
 
 	    ((or (and (> cursor-x (- (screen-width) hot-spots-area))
-		    (<= cursor-y 1))
+		      (<= cursor-y 1))
 		 (and (>= cursor-x (- (screen-width) 1))
-		    (< cursor-y hot-spots-area)))
-		   'top-right)
+		      (< cursor-y hot-spots-area)))
+	     'top-right)
 
 	    ((or (and (> cursor-x (- (screen-width) hot-spots-area))
-		    (>= cursor-y (- (screen-height) 1)))
+		      (>= cursor-y (- (screen-height) 1)))
 		 (and (>= cursor-x (- (screen-width) 1))
-		    (> cursor-y (- (screen-height) hot-spots-area))))
-		   'bottom-right)
+		      (> cursor-y (- (screen-height) hot-spots-area))))
+	     'bottom-right)
 
 	    ((or (and (< cursor-x hot-spots-area)
-		    (>= cursor-y (- (screen-height) 1)))
+		      (>= cursor-y (- (screen-height) 1)))
 		 (and (<= cursor-x 1)
-		    (> cursor-y (- (screen-height) hot-spots-area))))
-		   'bottom-left))))
+		      (> cursor-y (- (screen-height) hot-spots-area))))
+	     'bottom-left))))
 
   (define (get-active-edge)
     (let ((cursor (query-pointer)))
       (cond ((zerop (car cursor))
-	      'left)
+	     'left)
 	    ((= (car cursor) (1- (screen-width)))
 	     'right)
 	    ((zerop (cdr cursor))
diff --git a/lisp/sawfish/wm/edge/viewport-drag.jl b/lisp/sawfish/wm/edge/viewport-drag.jl
index 3288c42..c2a34a2 100644
--- a/lisp/sawfish/wm/edge/viewport-drag.jl
+++ b/lisp/sawfish/wm/edge/viewport-drag.jl
@@ -1,6 +1,8 @@
 ;; viewport-drag.jl -- Smooth viewport motion with mouse
 
-;; Copyright (C) 2008 David T. McWherter <udmcwher mcs drexel edu>
+;; Originally written by David T. McWherter <udmcwher mcs drexel edu>
+;; as "dtm-infinite-desktop" as public domain.
+
 ;; Copyright (C) 2010 Christopher Roy Bratusek <zanghar freent de>
 
 ;; This file is part of sawfish.
@@ -21,7 +23,7 @@
 
 (define-structure sawfish.wm.edge.viewport-drag
 
-    (export viewport-drag-activate)
+    (export viewport-drag-invoke)
 
     (open rep
           rep.system
@@ -33,18 +35,19 @@
   (define-structure-alias viewport-drag sawfish.wm.edge.viewport-drag)
 
   (defcustom viewport-drag-distance 64
-    "Amount to drag the viewport when the pointer hits the screen edge."
+    "Amount to drag the viewport (in pixel) each time the pointer hits the
+screen edge."
     :group edge-actions
     :type number
     :range (1 . nil))
 
   (defcustom viewport-drag-cursor-distance 32
-    "Amount to pull back the cursor after dragging the viewport."
+    "Amount to pull back the cursor (in pixer) after dragging the viewport."
     :group edge-actions
     :type number
     :range (1 . nil))
 
-  (define (viewport-drag-right)
+  (define (drag-right)
     "Shifts the viewport `viewport-drag-distance' pixels to the right."
     (let ((dist viewport-drag-distance)
           (cdist viewport-drag-cursor-distance)
@@ -56,7 +59,7 @@
       (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
       (move-cursor (- (min dist cdist)) 0)))
 
-  (define (viewport-drag-left)
+  (define (drag-left)
     "Shifts the viewport `viewport-drag-distance' pixels to the left."
     (let ((dist (- viewport-drag-distance))
           (cdist (- viewport-drag-cursor-distance))
@@ -68,7 +71,7 @@
       (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
       (move-cursor (- (max dist cdist)) 0)))
 
-  (define (viewport-drag-top)
+  (define (drag-up)
     "Shifts the viewport `viewport-drag-distance' pixels up."
     (let ((dist (- viewport-drag-distance))
           (cdist (- viewport-drag-cursor-distance))
@@ -80,7 +83,7 @@
       (set-viewport viewport-x-offset (+ viewport-y-offset dist))
       (move-cursor 0 (- (max dist cdist)))))
 
-  (define (viewport-drag-bottom)
+  (define (drag-down)
     "Shifts the viewport `viewport-drag-distance' pixels down."
     (let ((dist viewport-drag-distance)
           (cdist viewport-drag-cursor-distance)
@@ -92,10 +95,9 @@
       (set-viewport viewport-x-offset (+ viewport-y-offset dist))
       (move-cursor 0 (- (min dist cdist)))))
 
-  (define (viewport-drag-activate edge)
-    "Called when a desktop flipper is triggered to shift the visible desktop."
+  (define (viewport-drag-invoke edge)
     (case edge
-      ((left) (viewport-drag-left))
-      ((top) (viewport-drag-top))
-      ((right) (viewport-drag-right))
-      ((bottom) (viewport-drag-bottom)))))
+      ((left) (drag-left))
+      ((top) (drag-up))
+      ((right) (drag-right))
+      ((bottom) (drag-down)))))