Hi list,
Here's some patches that improve the float-group in stumpwm. Some of
them are already in the float branch of the repo but I think it can be
incorporated in master. The very last patch creates a focus/unfocus
color scheme for float-group only (yipeee! hours of configuration fun to
come).
>From 3db9702958ea757fbcce02855ca0de2bffed9203 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel.gir...@univ-nantes.fr>
Date: Fri, 26 Nov 2010 14:30:05 +0100
Subject: [PATCH 1/6] Saner default for floating policy in floating-group.
---
floating-group.lisp | 2 +-
1 files changed, 1 insertions(+), 1 deletions(-)
diff --git a/floating-group.lisp b/floating-group.lisp
index 49ad1aa..f72aed2 100644
--- a/floating-group.lisp
+++ b/floating-group.lisp
@@ -249,7 +249,7 @@
(setf (window-x window) (xlib:drawable-x (window-parent window))
(window-y window) (xlib:drawable-y (window-parent window)))))))
(t
- (when (eq *mouse-focus-policy* :click)
+ (unless (eq *mouse-focus-policy* :sloppy)
(focus-window window))))))
(defmethod group-button-press ((group float-group) x y where)
--
1.7.6
>From 452c4c2699080004a8c0322e9400f7416614f374 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel.gir...@univ-nantes.fr>
Date: Fri, 26 Nov 2010 17:34:09 +0100
Subject: [PATCH 2/6] focus everywhere in the window
---
floating-group.lisp | 37 ++++++++++++++++++-------------------
1 files changed, 18 insertions(+), 19 deletions(-)
diff --git a/floating-group.lisp b/floating-group.lisp
index f72aed2..c1566ac 100644
--- a/floating-group.lisp
+++ b/floating-group.lisp
@@ -189,21 +189,23 @@
(defmethod group-button-press ((group float-group) x y (window float-window))
(let ((screen (group-screen group)))
- (cond
- ((or (< x (xlib:drawable-x (window-xwin window)))
- (> x (+ (xlib:drawable-width (window-xwin window))
- (xlib:drawable-x (window-xwin window))))
- (< y (xlib:drawable-y (window-xwin window)))
- (> y (+ (xlib:drawable-height (window-xwin window))
- (xlib:drawable-y (window-xwin window)))))
- (multiple-value-bind (relx rely same-screen-p child state-mask)
- (xlib:query-pointer (window-parent window))
- (declare (ignore same-screen-p child))
- (let ((initial-width (xlib:drawable-width (slot-value window 'parent)))
- (initial-height (xlib:drawable-height (slot-value window 'parent))))
- (labels ((move-window-event-handler (&rest event-slots &key event-key &allow-other-keys)
- (case event-key
- (:button-release
+ (unless (eq *mouse-focus-policy* :sloppy)
+ (focus-window window))
+ (when (or (< x (xlib:drawable-x (window-xwin window)))
+ (> x (+ (xlib:drawable-width (window-xwin window))
+ (xlib:drawable-x (window-xwin window))))
+ (< y (xlib:drawable-y (window-xwin window)))
+ (> y (+ (xlib:drawable-height (window-xwin window))
+ (xlib:drawable-y (window-xwin window)))))
+ (multiple-value-bind (relx rely same-screen-p child state-mask)
+ (xlib:query-pointer (window-parent window))
+ (declare (ignore same-screen-p child))
+ (let ((initial-width (xlib:drawable-width (slot-value window 'parent)))
+ (initial-height (xlib:drawable-height (slot-value window 'parent))))
+ (labels ((move-window-event-handler
+ (&rest event-slots &key event-key &allow-other-keys)
+ (case event-key
+ (:button-release
:done)
(:motion-notify
(with-slots (parent) window
@@ -247,10 +249,7 @@
(update-configuration window)
;; don't forget to update the cache
(setf (window-x window) (xlib:drawable-x (window-parent window))
- (window-y window) (xlib:drawable-y (window-parent window)))))))
- (t
- (unless (eq *mouse-focus-policy* :sloppy)
- (focus-window window))))))
+ (window-y window) (xlib:drawable-y (window-parent window)))))))))
(defmethod group-button-press ((group float-group) x y where)
(declare (ignore x y where))
--
1.7.6
>From 6ff4874acb46a574aa9ff2b27603255e70b678d4 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel.gir...@univ-nantes.fr>
Date: Wed, 1 Dec 2010 10:17:12 +0100
Subject: [PATCH 3/6] warp pointer in right corner when resizing in float
group
---
floating-group.lisp | 121 ++++++++++++++++++++++++++++-----------------------
1 files changed, 67 insertions(+), 54 deletions(-)
diff --git a/floating-group.lisp b/floating-group.lisp
index c1566ac..e28c5db 100644
--- a/floating-group.lisp
+++ b/floating-group.lisp
@@ -147,7 +147,7 @@
(xlib:window-background parent) (xlib:alloc-color (xlib:screen-default-colormap (screen-number (window-screen window)))
"Orange")))
(xlib:clear-area (window-parent window))))
-
+
(defmethod group-resize-request ((group float-group) window width height)
(float-window-move-resize window :width width :height height))
@@ -188,77 +188,90 @@
)
(defmethod group-button-press ((group float-group) x y (window float-window))
- (let ((screen (group-screen group)))
+ (let ((screen (group-screen group))
+ (initial-width (xlib:drawable-width (window-parent window)))
+ (initial-height (xlib:drawable-height (window-parent window))))
+
+ ;; Focus wherever is the click
(unless (eq *mouse-focus-policy* :sloppy)
(focus-window window))
+
+ ;; When in border
(when (or (< x (xlib:drawable-x (window-xwin window)))
(> x (+ (xlib:drawable-width (window-xwin window))
(xlib:drawable-x (window-xwin window))))
(< y (xlib:drawable-y (window-xwin window)))
(> y (+ (xlib:drawable-height (window-xwin window))
(xlib:drawable-y (window-xwin window)))))
+
+ ;; When resizing warp pointer to left-right corner
+ (multiple-value-bind (relx rely same-screen-p child state-mask)
+ (xlib:query-pointer (window-parent window))
+ (declare (ignore relx rely same-screen-p child))
+ (when (find :button-3 (xlib:make-state-keys state-mask))
+ (xlib:warp-pointer (window-parent window) initial-width initial-height)))
+
(multiple-value-bind (relx rely same-screen-p child state-mask)
(xlib:query-pointer (window-parent window))
(declare (ignore same-screen-p child))
- (let ((initial-width (xlib:drawable-width (slot-value window 'parent)))
- (initial-height (xlib:drawable-height (slot-value window 'parent))))
- (labels ((move-window-event-handler
- (&rest event-slots &key event-key &allow-other-keys)
- (case event-key
- (:button-release
- :done)
- (:motion-notify
- (with-slots (parent) window
- (xlib:with-state (parent)
- ;; Either move or resize the window
- (cond
- ((find :button-1 (xlib:make-state-keys state-mask))
- (setf (xlib:drawable-x parent) (- (getf event-slots :x) relx)
- (xlib:drawable-y parent) (- (getf event-slots :y) rely)))
- ((find :button-3 (xlib:make-state-keys state-mask))
- (let ((w (+ initial-width
- (- (getf event-slots :x)
- relx
- (xlib:drawable-x parent))))
- (h (+ initial-height
- (- (getf event-slots :y)
- rely
- (xlib:drawable-y parent)
- *float-window-title-height*))))
- ;; Don't let the window become too small
- (float-window-move-resize window
- :width (max w *min-frame-width*)
- :height (max h *min-frame-height*)))))))
- t)
- ;; We need to eat these events or they'll ALL
- ;; come blasting in later. Also things start
- ;; lagging hard if we don't (on clisp anyway).
- (:configure-notify t)
- (:exposure t)
- (t
- nil))))
- (xlib:grab-pointer (screen-root screen) '(:button-release :pointer-motion))
- (unwind-protect
- ;; Wait until the mouse button is released
- (loop for ev = (xlib:process-event *display*
- :handler #'move-window-event-handler
- :timeout nil
- :discard-p t)
- until (eq ev :done))
- (ungrab-pointer))
- (update-configuration window)
- ;; don't forget to update the cache
- (setf (window-x window) (xlib:drawable-x (window-parent window))
- (window-y window) (xlib:drawable-y (window-parent window)))))))))
+ (labels ((move-window-event-handler
+ (&rest event-slots &key event-key &allow-other-keys)
+ (case event-key
+ (:button-release
+ ;; Reset pointer to initial position when done
+ (xlib:warp-pointer (window-parent window) x y)
+ :done)
+ (:motion-notify
+ (with-slots (parent) window
+ (xlib:with-state (parent)
+ ;; Either move or resize the window
+ (cond
+ ((find :button-1 (xlib:make-state-keys state-mask))
+ (setf (xlib:drawable-x parent) (- (getf event-slots :x) relx)
+ (xlib:drawable-y parent) (- (getf event-slots :y) rely)))
+ ((find :button-3 (xlib:make-state-keys state-mask))
+ (let ((w (+ initial-width
+ (- (getf event-slots :x)
+ relx
+ (xlib:drawable-x parent))))
+ (h (+ initial-height
+ (- (getf event-slots :y)
+ rely
+ (xlib:drawable-y parent)
+ *float-window-title-height*))))
+ ;; Don't let the window become too small
+ (float-window-move-resize window
+ :width (max w *min-frame-width*)
+ :height (max h *min-frame-height*)))))))
+ t)
+ ;; We need to eat these events or they'll ALL
+ ;; come blasting in later. Also things start
+ ;; lagging hard if we don't (on clisp anyway).
+ (:configure-notify t)
+ (:exposure t)
+ (t nil))))
+ (xlib:grab-pointer (screen-root screen) '(:button-release :pointer-motion))
+ (unwind-protect
+ ;; Wait until the mouse button is released
+ (loop for ev = (xlib:process-event *display*
+ :handler #'move-window-event-handler
+ :timeout nil
+ :discard-p t)
+ until (eq ev :done))
+ (ungrab-pointer))
+ (update-configuration window)
+ ;; don't forget to update the cache
+ (setf (window-x window) (xlib:drawable-x (window-parent window))
+ (window-y window) (xlib:drawable-y (window-parent window))))))))
(defmethod group-button-press ((group float-group) x y where)
(declare (ignore x y where))
)
(defcommand gnew-float (name) ((:rest "Group Name: "))
-"Create a floating window group with the specified name and switch to it."
+ "Create a floating window group with the specified name and switch to it."
(add-group (current-screen) name :type 'float-group))
(defcommand gnewbg-float (name) ((:rest "Group Name: "))
-"Create a floating window group with the specified name, but do not switch to it."
+ "Create a floating window group with the specified name, but do not switch to it."
(add-group (current-screen) name :background t :type 'float-group))
--
1.7.6
>From 9f570f635ed1e745d93ef17e8733c997b3a38fa7 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel.gir...@univ-nantes.fr>
Date: Wed, 19 Jan 2011 18:22:56 +0100
Subject: [PATCH 4/6] Focus/unfocus colors already exist. Use them in
float-group instead of hardcoded colors.
---
floating-group.lisp | 7 +++----
1 files changed, 3 insertions(+), 4 deletions(-)
diff --git a/floating-group.lisp b/floating-group.lisp
index e28c5db..d7df9ef 100644
--- a/floating-group.lisp
+++ b/floating-group.lisp
@@ -55,10 +55,9 @@
(defmethod update-decoration ((window float-window))
(let ((group (window-group window)))
(setf (xlib:window-background (window-parent window))
- (xlib:alloc-color (xlib:screen-default-colormap (screen-number (window-screen window)))
- (if (eq (group-current-window group) window)
- "Orange"
- "SteelBlue4")))
+ (if (eq (group-current-window group) window)
+ (screen-focus-color (window-screen window))
+ (screen-unfocus-color (window-screen window))))
(xlib:clear-area (window-parent window))))
(defmethod window-sync ((window float-window) hint)
--
1.7.6
>From 6e240ff4abc98944c72dfee3a1d38b60377ea3ef Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel.gir...@univ-nantes.fr>
Date: Fri, 28 Jan 2011 11:14:43 +0100
Subject: [PATCH 5/6] Use float-window-move-resize instead of a raw setf to
move.
---
floating-group.lisp | 5 +++--
1 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/floating-group.lisp b/floating-group.lisp
index d7df9ef..2715edc 100644
--- a/floating-group.lisp
+++ b/floating-group.lisp
@@ -226,8 +226,9 @@
;; Either move or resize the window
(cond
((find :button-1 (xlib:make-state-keys state-mask))
- (setf (xlib:drawable-x parent) (- (getf event-slots :x) relx)
- (xlib:drawable-y parent) (- (getf event-slots :y) rely)))
+ (let ((newx (- (getf event-slots :x) relx))
+ (newy (- (getf event-slots :y) rely)))
+ (float-window-move-resize window :x newx :y newy)))
((find :button-3 (xlib:make-state-keys state-mask))
(let ((w (+ initial-width
(- (getf event-slots :x)
--
1.7.6
>From fbdcaad56109592e10d0f20b1b62c1bd334447b8 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel.gir...@univ-nantes.fr>
Date: Wed, 17 Aug 2011 15:13:50 +0200
Subject: [PATCH 6/6] Create focus/unfocus color stuff for float-group. Self
update :-)
---
AUTHORS | 2 +-
floating-group.lisp | 4 ++--
primitives.lisp | 4 ++++
screen.lisp | 14 ++++++++++++++
stumpwm.texi.in | 2 ++
5 files changed, 23 insertions(+), 3 deletions(-)
diff --git a/AUTHORS b/AUTHORS
index 19e241b..aa2dd7c 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -3,7 +3,7 @@ The Stump Window Manager Authors
Shawn Betts sabetts at gmail com
Ryan M. Golbeck rmgolbeck at uwaterloo ca
-Manuel Giraud manuel.giraud at cetp ipsl fr
+Manuel Giraud manuel.giraud at univ-nantes fr
Andreas Scholta andreas.scholta at gmail com
Philippe Brochard hocwp at free fr
Matthew Kennedy mkennedy at gentoo org
diff --git a/floating-group.lisp b/floating-group.lisp
index 2715edc..a501068 100644
--- a/floating-group.lisp
+++ b/floating-group.lisp
@@ -56,8 +56,8 @@
(let ((group (window-group window)))
(setf (xlib:window-background (window-parent window))
(if (eq (group-current-window group) window)
- (screen-focus-color (window-screen window))
- (screen-unfocus-color (window-screen window))))
+ (screen-float-focus-color (window-screen window))
+ (screen-float-unfocus-color (window-screen window))))
(xlib:clear-area (window-parent window))))
(defmethod window-sync ((window float-window) hint)
diff --git a/primitives.lisp b/primitives.lisp
index 005236e..6bc3d94 100644
--- a/primitives.lisp
+++ b/primitives.lisp
@@ -357,6 +357,8 @@ are valid values.
(defparameter +default-font-name+ "9x15bold")
(defparameter +default-focus-color+ "White")
(defparameter +default-unfocus-color+ "Black")
+(defparameter +default-float-focus-color+ "Orange")
+(defparameter +default-float-unfocus-color+ "SteelBlue4")
(defparameter +default-frame-outline-width+ 2)
;; Don't set these variables directly, use set-<var name> instead
@@ -419,6 +421,8 @@ Use the window's resource name.
(win-bg-color :initform nil :accessor screen-win-bg-color)
(focus-color :initform nil :accessor screen-focus-color)
(unfocus-color :initform nil :accessor screen-unfocus-color)
+ (float-focus-color :initform nil :accessor screen-float-focus-color)
+ (float-unfocus-color :initform nil :accessor screen-float-unfocus-color)
(msg-border-width :initform nil :accessor screen-msg-border-width)
(frame-outline-width :initform nil :accessor screen-frame-outline-width)
(font :initform nil :accessor screen-font)
diff --git a/screen.lisp b/screen.lisp
index 92782e2..97560fd 100644
--- a/screen.lisp
+++ b/screen.lisp
@@ -34,6 +34,8 @@
set-win-bg-color
set-focus-color
set-unfocus-color
+ set-float-focus-color
+ set-float-unfocus-color
set-msg-border-width
set-frame-outline-width
set-font))
@@ -287,6 +289,14 @@ there is more than one frame."
there is more than one frame."
(set-any-color screen-unfocus-color color))
+(defun set-float-focus-color (color)
+ "Set the border color for focused windows in a float group."
+ (set-any-color screen-float-focus-color color))
+
+(defun set-float-unfocus-color (color)
+ "Set the border color for windows without focus in a float group."
+ (set-any-color screen-float-unfocus-color color))
+
(defun set-msg-border-width (width)
"Set the border width for the message bar and input
bar."
@@ -392,6 +402,8 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
(border (ac +default-border-color+))
(focus (ac +default-focus-color+))
(unfocus (ac +default-unfocus-color+))
+ (float-focus (ac +default-float-focus-color+))
+ (float-unfocus (ac +default-float-unfocus-color+))
(win-bg (ac +default-window-background-color+))
(input-window (xlib:create-window :parent (xlib:screen-root screen-number)
:x 0 :y 0 :width 20 :height 20
@@ -447,6 +459,8 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
(screen-border-color screen) border
(screen-focus-color screen) focus
(screen-unfocus-color screen) unfocus
+ (screen-float-focus-color screen) float-focus
+ (screen-float-unfocus-color screen) float-unfocus
(screen-msg-border-width screen) 1
(screen-frame-outline-width screen) +default-frame-outline-width+
(screen-input-window screen) input-window
diff --git a/stumpwm.texi.in b/stumpwm.texi.in
index 4b6cdd1..1661a90 100644
--- a/stumpwm.texi.in
+++ b/stumpwm.texi.in
@@ -862,6 +862,8 @@ list. Some commands operate only on marked windows.
@@@ set-win-bg-color
@@@ set-focus-color
@@@ set-unfocus-color
+@@@ set-float-focus-color
+@@@ set-float-unfocus-color
@@@ set-normal-gravity
@@@ set-maxsize-gravity
@@@ set-transient-gravity
--
1.7.6
Best regards,
--
Manuel Giraud
_______________________________________________
Stumpwm-devel mailing list
Stumpwm-devel@nongnu.org
https://lists.nongnu.org/mailman/listinfo/stumpwm-devel
