GNOME.org
 

[sawfish/edge-actions] added edge-actions final preparative tasks in hot-spots, infinite-desktop and edge-flip

commit f5498efa0c9375fb9f71242f4a2f86a7c70c77cd
Author: Christopher Roy Bratusek <zanghar freenet de>
Date:   Tue Nov 2 20:30:02 2010 +0100

    added edge-actions
    final preparative tasks in hot-spots, infinite-desktop and edge-flip

 lisp/sawfish/wm/custom.jl                |    1 +
 lisp/sawfish/wm/edge/actions.jl          |  109 ++++++++++++++++++++++++++++++
 lisp/sawfish/wm/edge/flip.jl             |   10 +---
 lisp/sawfish/wm/edge/hot-spots.jl        |   92 ++++++++++++--------------
 lisp/sawfish/wm/edge/infinite-desktop.jl |   67 ++++++++----------
 lisp/sawfish/wm/edge/util.jl             |    8 +--
 6 files changed, 185 insertions(+), 102 deletions(-)
---
diff --git a/lisp/sawfish/wm/custom.jl b/lisp/sawfish/wm/custom.jl
index e04994c..2ff7e73 100644
--- a/lisp/sawfish/wm/custom.jl
+++ b/lisp/sawfish/wm/custom.jl
@@ -497,6 +497,7 @@ the user."
   (defgroup placement "Placement" :group misc)
   (defgroup stacking "Stacking" :group misc)
   (defgroup workspace "Workspaces")
+  (defgroup edge-actions "Edge Actions")
 
 ;;; loading user's customisations
 
diff --git a/lisp/sawfish/wm/edge/actions.jl b/lisp/sawfish/wm/edge/actions.jl
new file mode 100644
index 0000000..0e349bc
--- /dev/null
+++ b/lisp/sawfish/wm/edge/actions.jl
@@ -0,0 +1,109 @@
+;; edge-action.jl -- Edges taken to another dimension
+
+;; Copyright (C) 2010 Christopher Roy Bratusek <zanghar freenet de>
+
+;; This file is part of sawfish.
+
+;; sawfish is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; sawfish is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with sawfish; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.wm.edge.actions
+
+    (export edges-activate)
+
+    (open rep
+	  rep.system
+	  sawfish.wm.misc
+	  sawfish.wm.events
+	  sawfish.wm.custom
+	  sawfish.wm.edge.util
+	  sawfish.wm.edge.flip
+	  sawfish.wm.edge.hot-spots
+	  sawfish.wm.edge.infinite-desktop)
+
+  (define-structure-alias edge-actions sawfish.wm.edge.actions)
+
+  (define func nil)
+
+  (defcustom edge-actions-enabled nil
+    "Activate the screen-edges."
+    :group edge-actions
+    :type boolean
+    :after-set (lambda () edges-activate))
+
+  (defcustom edge-actions-delay 250
+    "Delay (in miliseconds) before the edges are activated."
+    :group edge-actions
+    :type number
+    :range (50 . nil))
+
+  (defcustom left-edge-func 'none
+    "Action for the left screen-edge."
+    :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 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 bottom-edge-func 'none
+    "Action for the bottom screen-edge."
+    :group edge-actions
+    :type (choice hot-spot viewport-drag flip-workspace flip-viewport none))
+
+  (define (edge-action-call func edge)
+    (case func
+      ((hot-spot)
+       (hot-spot-activate edge))
+      ((viewport-drag)
+       (infinite-desktop-activate edge))
+      ((flip-workspace)
+       (edge-flip-activate edge 'workspace))
+      ((flip-viewport)
+       (edge-flip-activate edge 'viewport))))
+
+  (define (edge-action-init)
+    (let ((corner (get-active-corner))
+	  (edge (get-active-edge)))
+      (if corner
+	  (hot-spot-activate corner)
+	(setq func nil)
+	(cond ((eq edge 'left)
+	       (edge-action-call left-edge-func edge))
+	      ((eq edge 'right)
+               (edge-action-call right-edge-func edge))
+	      ((eq edge 'top)
+	       (edge-action-call top-edge-func edge))
+	      ((eq edge 'bottom)
+	       (edge-action-call bottom-edge-func edge))))))
+
+  (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)))
+      (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)))))
\ No newline at end of file
diff --git a/lisp/sawfish/wm/edge/flip.jl b/lisp/sawfish/wm/edge/flip.jl
index 690ba45..32d5521 100644
--- a/lisp/sawfish/wm/edge/flip.jl
+++ b/lisp/sawfish/wm/edge/flip.jl
@@ -32,20 +32,12 @@
 	  sawfish.wm.viewport
 	  sawfish.wm.workspace
 	  sawfish.wm.commands.move-resize
-	  sawfish.wm.ext.workspace-grid
-	  sawfish.wm.edge.flippers
-	  sawfish.wm.edge.util)
+	  sawfish.wm.ext.workspace-grid)
 
   (define-structure-alias edge-flip sawfish.wm.edge.flip)
 
   (define ef-current-edge nil)
 
-  (defvar before-edge-flip-hook '()
-    "Hook called immediately before edge-flipping.")
-
-  (defvar after-edge-flip-hook '()
-    "Hook called immediately after edge-flipping.")
-
   (define (edge-flip-activate edge type)
     (let ((ptr (query-pointer t)))
       (before-flip)
diff --git a/lisp/sawfish/wm/edge/hot-spots.jl b/lisp/sawfish/wm/edge/hot-spots.jl
index e9cd01a..8779900 100644
--- a/lisp/sawfish/wm/edge/hot-spots.jl
+++ b/lisp/sawfish/wm/edge/hot-spots.jl
@@ -29,8 +29,7 @@
 	  sawfish.wm.windows
 	  sawfish.wm.misc
 	  sawfish.wm.events
-	  sawfish.wm.workspace
-	  sawfish.wm.edge.util)
+	  sawfish.wm.workspace)
 
   (define-structure-alias hot-spots sawfish.wm.edge.hot-spots)
 
@@ -58,51 +57,44 @@
   (defvar bottom-left-corner-program nil
     "The program launched when hitting the bottom-left-corner.")
 
-  (define (hot-spot-activate)
-    (cond ((eq (get-active-corner) 'top-left)
-	   (unless (eq top-left-corner-program nil)
-	     (if (functionp top-left-corner-program)
-	         (funcall top-left-corner-program)
-	       (system (concat top-left-corner-program " &")))))
-
-	  ((eq (get-active-corner) 'top-right)
-	   (unless (eq top-right-corner-program nil)
-	     (if (functionp top-right-corner-program)
-	          (funcall top-right-corner-program)
-	        (system (concat top-right-corner-program " &")))))
-
-	  ((eq (get-active-corner) 'bottom-right)
-	   (unless (eq bottom-right-corner-program nil)
-	     (if (functionp bottom-right-corner-program)
-	           (funcall bottom-right-corner-program)
-	         (system (concat bottom-right-corner-program " &")))))
-
-	  ((eq (get-active-corner) 'bottom-left)
-	   (unless (eq bottom-left-corner-program nil)
-	     (if (functionp bottom-left-corner-program)
-	           (funcall bottom-left-corner-program)
-	         (system (concat bottom-left-corner-program " &")))))
-
-	  ((eq (get-active-edge) 'left)
-           (unless (eq left-edge-program nil)
-	     (if (functionp left-edge-program)
-                  (funcall left-edge-program)
-                (system (concat left-edge-program " &")))))
-
-          ((eq (get-active-edge) 'top)
-	   (unless (eq top-edge-program nil)
-             (if (functionp top-edge-program)
-                   (funcall top-edge-program)
-                (system (concat top-edge-program " &")))))
-
-          ((eq (get-active-edge) 'right)
-	   (unless (eq right-edge-program nil)
-             (if (functionp right-edge-program)
-                   (funcall right-edge-program)
-                 (system (concat right-edge-program " &")))))
-
-          ((eq (get-active-edge) 'bottom)
-	   (unless (eq bottom-edge-program nil)
-             (if (functionp bottom-edge-program)
-                   (funcall bottom-edge-program)
-                 (system (concat bottom-edge-program " &"))))))))
+  (define (hot-spot-activate spot)
+    (case spot
+      ((top-left)
+	    (if (functionp top-left-corner-program)
+		(funcall top-left-corner-program)
+	      (system (concat top-left-corner-program " &"))))
+
+      ((top-right)
+	    (if (functionp top-right-corner-program)
+		(funcall top-right-corner-program)
+	      (system (concat top-right-corner-program " &"))))
+
+      ((bottom-right)
+	    (if (functionp bottom-right-corner-program)
+		(funcall bottom-right-corner-program)
+	      (system (concat bottom-right-corner-program " &"))))
+
+      ((bottom-left)
+	    (if (functionp bottom-left-corner-program)
+		(funcall bottom-left-corner-program)
+	      (system (concat bottom-left-corner-program " &"))))
+
+      ((left)
+       (if (functionp left-edge-program)
+	   (funcall left-edge-program)
+	(system (concat left-edge-program " &"))))
+
+      ((top)
+	   (if (functionp top-edge-program)
+	       (funcall top-edge-program)
+	     (system (concat top-edge-program " &"))))
+
+      ((right)
+	   (if (functionp right-edge-program)
+	       (funcall right-edge-program)
+	     (system (concat right-edge-program " &"))))
+
+      ((bottom)
+	   (if (functionp bottom-edge-program)
+	       (funcall bottom-edge-program)
+	     (system (concat bottom-edge-program " &")))))))
\ No newline at end of file
diff --git a/lisp/sawfish/wm/edge/infinite-desktop.jl b/lisp/sawfish/wm/edge/infinite-desktop.jl
index 9535fe3..e7133a3 100644
--- a/lisp/sawfish/wm/edge/infinite-desktop.jl
+++ b/lisp/sawfish/wm/edge/infinite-desktop.jl
@@ -27,32 +27,24 @@
           sawfish.wm.misc
           sawfish.wm.custom
           sawfish.wm.commands.move-cursor
-          sawfish.wm.viewport
-          sawfish.wm.util.prompt
-          sawfish.wm.edge.flippers
-	  sawfish.wm.edge.util)
+          sawfish.wm.viewport)
 
-  (define-structure-alias infinite-desktop sawfish.wm.edge.infinite-desktop)
-
-  (defgroup infinite-desktop "Infinite Desktop" :group workspace)
-
-  (defcustom infinite-desktop-move-distance 64
-    "Amount to move the viewport when the pointer hits the screen edge."
-    :group (workspace infinite-desktop)
+  (defcustom viewport-drag-distance 64
+    "Amount to drag the viewport when the pointer hits the screen edge."
+    :group edge-actions
     :type number
     :range (1 . nil))
 
-  (defcustom infinite-desktop-move-cursor-distance 32
-    "Amount to pull back the cursor after moving the viewport."
-    :group (workspace infinite-desktop)
+  (defcustom viewport-drag-cursor-distance 32
+    "Amount to pull back the cursor after dragging the viewport."
+    :group edge-actions
     :type number
     :range (1 . nil))
 
-  (define (infinite-desktop-move-right)
-    "Shifts the viewport `infinite-desktop-move-distance' pixels to the
-right."
-    (let ((dist infinite-desktop-move-distance)
-          (cdist infinite-desktop-move-cursor-distance)
+  (define (viewport-drag-right)
+    "Shifts the viewport `viewport-drag-distance' pixels to the right."
+    (let ((dist viewport-drag-distance)
+          (cdist viewport-drag-cursor-distance)
           (maxx (* (screen-width) (1- (car viewport-dimensions)))))
       (if
           (and (viewport-honor-workspace-edges)
@@ -61,11 +53,10 @@ right."
       (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
       (move-cursor (- (min dist cdist)) 0)))
 
-  (define (infinite-desktop-move-left)
-    "Shifts the viewport `infinite-desktop-move-distance' pixels to the
-left."
-    (let ((dist (- infinite-desktop-move-distance))
-          (cdist (- infinite-desktop-move-cursor-distance))
+  (define (viewport-drag-left)
+    "Shifts the viewport `viewport-drag-distance' pixels to the left."
+    (let ((dist (- viewport-drag-distance))
+          (cdist (- viewport-drag-cursor-distance))
           (minx 0))
       (if
           (and (viewport-honor-workspace-edges)
@@ -74,10 +65,10 @@ left."
       (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
       (move-cursor (- (max dist cdist)) 0)))
 
-  (define (infinite-desktop-move-top)
-    "Shifts the viewport `infinite-desktop-move-distance' pixels up."
-    (let ((dist (- infinite-desktop-move-distance))
-          (cdist (- infinite-desktop-move-cursor-distance))
+  (define (viewport-drag-top)
+    "Shifts the viewport `viewport-drag-distance' pixels up."
+    (let ((dist (- viewport-drag-distance))
+          (cdist (- viewport-drag-cursor-distance))
           (miny 0))
       (if
           (and (viewport-honor-workspace-edges)
@@ -86,10 +77,10 @@ left."
       (set-viewport viewport-x-offset (+ viewport-y-offset dist))
       (move-cursor 0 (- (max dist cdist)))))
 
-  (define (infinite-desktop-move-bottom)
-    "Shifts the viewport `infinite-desktop-move-distance' pixels down."
-    (let ((dist infinite-desktop-move-distance)
-          (cdist infinite-desktop-move-cursor-distance)
+  (define (viewport-drag-bottom)
+    "Shifts the viewport `viewport-drag-distance' pixels down."
+    (let ((dist viewport-drag-distance)
+          (cdist viewport-drag-cursor-distance)
           (maxy (* (screen-height) (1- (cdr viewport-dimensions)))))
       (if
           (and (viewport-honor-workspace-edges)
@@ -98,10 +89,10 @@ left."
       (set-viewport viewport-x-offset (+ viewport-y-offset dist))
       (move-cursor 0 (- (min dist cdist)))))
 
-  (define (infinite-desktop-activate)
+  (define (infinite-desktop-activate edge)
     "Called when a desktop flipper is triggered to shift the visible desktop."
-    (let ((edge (get-active-edge)))
-      (cond ((eq edge 'right) (infinite-desktop-move-right))
-            ((eq edge 'left) (infinite-desktop-move-left))
-            ((eq edge 'bottom) (infinite-desktop-move-bottom))
-            ((eq edge 'top) (infinite-desktop-move-top))))))
+    (case edge
+      ((left) (viewport-drag-left))
+      ((top) (viewport-drag-top))
+      ((right) (viewport-drag-right))
+      ((bottom) (viewport-drag-bottom)))))
diff --git a/lisp/sawfish/wm/edge/util.jl b/lisp/sawfish/wm/edge/util.jl
index 11c2254..8996baa 100644
--- a/lisp/sawfish/wm/edge/util.jl
+++ b/lisp/sawfish/wm/edge/util.jl
@@ -1,6 +1,6 @@
-;; edge-util.jl -- common utils for EdgeFlip/InfiniteDesktop/HotSpots
+;; edge-util.jl -- common utils for EdgeActions
 
-;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
+;; Copyright (C) 2010 Christopher Roy Bratusek <zanghar freenet de>
 
 ;; This file is part of sawfish.
 
@@ -47,13 +47,11 @@
       (if (in-hook-p 'randr-change-notify-hook recreate-flippers)
 	(remove-hook 'randr-change-notify-hook recreate-flippers))))
 
-  (defgroup hot-spot "Hot Spots" :group workspace)
-
   (defcustom hot-spots-area 50
     "Lenght in px (in both x and y direction) wich is used as hot-spots-area."
     :type number
     :range (5 . 500)
-    :group (workspace hot-spot))
+    :group edge-actions)
 
    (define (get-active-corner)
     (let ((cursor-x (car (query-pointer)))
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]