[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[STUMP] Groups are virtual desktops
From: |
Magnus Henoch |
Subject: |
[STUMP] Groups are virtual desktops |
Date: |
Mon, 18 Jun 2007 23:33:06 +0200 |
User-agent: |
Gnus/5.110006 (No Gnus v0.6) Emacs/22.1.50 (berkeley-unix) |
The attached patch makes stumpwm's groups behave like wm-spec's
virtual desktops. In particular, "wmctrl -d" lists the groups,
"wmctrl -s FOO" switches to group FOO (name or number), and "wmctrl -r
WIN -t GROUP" moves window WIN to group GROUP.
wmspec requires virtual desktop numbers to be continuous and start
from 0, so I enforce that on group numbers too.
Magnus
cvs diff: Diffing .
Index: core.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/core.lisp,v
retrieving revision 1.148
diff -u -r1.148 core.lisp
--- core.lisp 13 Jun 2007 06:00:22 -0000 1.148
+++ core.lisp 18 Jun 2007 21:27:20 -0000
@@ -140,7 +140,7 @@
(defun find-free-group-number (screen)
"Return a free window number for GROUP."
- (find-free-number (mapcar 'group-number (screen-groups screen)) 1))
+ (find-free-number (mapcar #'group-number (screen-groups screen)) 0))
(defun group-current-window (group)
(frame-window (tile-group-current-frame group)))
@@ -162,6 +162,9 @@
(setf (screen-focus screen) nil)
(focus-frame new-group (tile-group-current-frame new-group))
(show-frame-indicator new-group)
+ (xlib:change-property (screen-root screen) :_NET_CURRENT_DESKTOP
+ (list (group-number new-group))
+ :cardinal 32)
(run-hook-with-args *focus-group-hook* new-group old-group))))
(defun move-window-to-group (window to-group)
@@ -181,9 +184,12 @@
(when (eq (frame-window old-frame) window)
(setf (frame-window old-frame) (first (frame-windows old-group
old-frame)))
(focus-frame old-group old-frame))
- ;; maybe show the window in it's new frame
+ ;; maybe show the window in its new frame
(when (null (frame-window (window-frame window)))
- (frame-raise-window (window-group window) (window-frame window)
window)))))
+ (frame-raise-window (window-group window) (window-frame window)
window))
+ (xlib:change-property (window-xwin window) :_NET_WM_DESKTOP
+ (list (group-number to-group))
+ :cardinal 32))))
(defun next-group (current &optional (list (screen-groups (group-screen
current))))
(let ((matches (member current list)))
@@ -203,7 +209,22 @@
(when (> (length (screen-groups (group-screen group))) 1)
(let ((screen (group-screen group)))
(merge-groups group to-group)
- (setf (screen-groups screen) (remove group (screen-groups screen))))))
+ (setf (screen-groups screen) (remove group (screen-groups screen)))
+ (renumber-groups screen)
+ (set-group-properties screen))))
+
+(defun renumber-groups (screen)
+ "By the NETWM standard, group numbers are continuous from 0."
+ (let ((sorted-groups (sort-groups screen)))
+ (loop for i from 0
+ for group in sorted-groups
+ do (when (/= i (group-number group))
+ (setf (group-number group) i)
+ ;; group number has changed; update window properties
+ (dolist (w (group-windows group))
+ (xlib:change-property (window-xwin w) :_NET_WM_DESKTOP
+ (list i)
+ :cardinal 32))))))
(defun add-group (screen name)
(check-type screen screen)
@@ -216,8 +237,33 @@
:number (find-free-group-number screen)
:name name)))
(setf (screen-groups screen) (append (screen-groups screen) (list ng)))
+ (set-group-properties screen)
ng))
+(defun set-group-properties (screen)
+ "Set NETWM properties regarding groups of SCREEN.
+Groups are known as \"virtual desktops\" in the NETWM standard."
+ (let ((root (screen-root screen)))
+ ;; _NET_NUMBER_OF_DESKTOPS
+ (xlib:change-property root :_NET_NUMBER_OF_DESKTOPS
+ (list (length (screen-groups screen)))
+ :cardinal 32)
+
+ ;; _NET_CURRENT_DESKTOP
+ (xlib:change-property root :_NET_CURRENT_DESKTOP
+ (list (group-number (screen-current-group screen)))
+ :cardinal 32)
+
+ ;; _NET_DESKTOP_NAMES
+ (xlib:change-property root :_NET_DESKTOP_NAMES
+ (let ((names (mapcan
+ (lambda (group)
+ (list (string-to-utf8 (group-name
group))
+ '(0)))
+ (screen-groups screen))))
+ (apply #'concatenate 'list names))
+ :UTF8_STRING 8)))
+
(defun find-group (screen name)
"Return the group with the name, NAME. Or NIL if none exists."
(find name (screen-groups screen) :key 'group-name :test 'string=))
@@ -698,6 +744,9 @@
(setf (xwin-state xwin) +iconic-state+)
;; put the window at the end of the list
(setf (group-windows group) (append (group-windows group) (list window)))
+ (xlib:change-property xwin :_NET_WM_DESKTOP
+ (list (group-number group))
+ :cardinal 32)
window))
(defun pick-prefered-frame (group)
@@ -807,6 +856,19 @@
(when (window-in-current-group-p window)
;; since the window doesn't exist, it doesn't have focus.
(setf (screen-focus screen) nil))
+ ;; update _NET_CLIENT_LIST
+ (let* ((root-window (xlib:screen-root (screen-number screen)))
+ (client-list (xlib:get-property root-window
+ :_NET_CLIENT_LIST
+ :type :window)))
+ (xlib:change-property root-window
+ :_NET_CLIENT_LIST
+ (remove (xlib:drawable-id (window-xwin window))
+ client-list)
+ :window 32
+ :mode :replace))
+ ;; remove _NET_WM_DESKTOP property
+ (xlib:delete-property (window-xwin window) :_NET_WM_DESKTOP)
;; If the current window was removed, then refocus the frame it
;; was in, since it has a new current window
(when (eq (tile-group-current-frame group) f)
@@ -1786,16 +1848,17 @@
"Return the current screen."
(car *screen-list*))
-(defun net-set-properties (screen-number focus-window)
+(defun net-set-properties (screen focus-window)
"Set NETWM properties on the root window of the specified screen.
FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
- (let ((root (xlib:screen-root screen-number)))
+ (let* ((screen-number (screen-number screen))
+ (root (xlib:screen-root screen-number)))
;; _NET_SUPPORTED
(xlib:change-property root :_NET_SUPPORTED
(mapcar (lambda (a)
(xlib:intern-atom *display* a))
(append +netwm-supported+
- (mapcar 'car +netwm-window-types+)))
+ (mapcar #'car +netwm-window-types+)))
:atom 32)
;; _NET_SUPPORTING_WM_CHECK
@@ -1814,10 +1877,7 @@
() :window 32
:transform #'xlib:drawable-id)
;; TODO: _NET_CLIENT_LIST_STACKING
-
- ;; _NET_NUMBER_OF_DESKTOPS
- (xlib:change-property root :_NET_NUMBER_OF_DESKTOPS (list 1) :cardinal 32)
-
+
;; _NET_DESKTOP_GEOMETRY
(xlib:change-property root :_NET_DESKTOP_GEOMETRY
(list (xlib:screen-width screen-number)
@@ -1827,9 +1887,8 @@
;; _NET_DESKTOP_VIEWPORT
(xlib:change-property root :_NET_DESKTOP_VIEWPORT
(list 0 0) :cardinal 32)
- ;; _NET_CURRENT_DESKTOP
- (xlib:change-property root :_NET_CURRENT_DESKTOP
- (list 0) :cardinal 32)))
+
+ (set-group-properties screen)))
(defun init-screen (screen-number id host)
"Given a screen number, returns a screen structure with initialized members"
@@ -1874,7 +1933,7 @@
(font (xlib:open-font *display* +default-font-name+))
(group (make-tile-group
:screen screen
- :number 1
+ :number 0
:name "Default")))
;; Create our screen structure
;; The focus window is mapped at all times
@@ -1911,7 +1970,7 @@
:background (xlib:alloc-color
(xlib:screen-default-colormap screen-number) +default-background-color+)))
(setf (tile-group-frame-tree group) (make-initial-frame screen)
(tile-group-current-frame group) (tile-group-frame-tree group))
- (net-set-properties screen-number focus-window)
+ (net-set-properties screen focus-window)
screen))
@@ -2295,6 +2348,31 @@
(incf (window-unmap-ignores win)))
(xlib:reparent-window (window-xwin win) (window-parent win) 0 0))))
+(define-stump-event-handler :client-message (window type #|format|# data)
+ (dformat 2 "client message: ~s ~s~%" type data)
+ (case type
+ (:_NET_CURRENT_DESKTOP ;switch desktop
+ (let ((group-number (elt data 0))
+ (screen (find-screen window)))
+ (when screen
+ (let ((group (find group-number (screen-groups screen)
+ :key #'group-number)))
+ (when group
+ (switch-to-group group))))))
+ (:_NET_WM_DESKTOP ;move window to desktop
+ (let* ((group-number (elt data 0))
+ (our-window (find-window window))
+ (screen (when our-window
+ (window-screen our-window)))
+ (group (when screen
+ (find group-number (screen-groups screen)
+ :key #'group-number))))
+ (when (and our-window group)
+ (move-window-to-group our-window group))))
+
+ (t
+ (dformat 2 "ignored message~%"))))
+
(define-stump-event-handler :focus-out (window mode kind)
(dformat 5 "address@hidden ~}~%" window mode kind))
Index: primitives.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/primitives.lisp,v
retrieving revision 1.81
diff -u -r1.81 primitives.lisp
--- primitives.lisp 13 May 2007 04:43:12 -0000 1.81
+++ primitives.lisp 18 Jun 2007 21:27:21 -0000
@@ -720,6 +720,15 @@
#-sbcl
(map 'string #'code-char octets))
+(defun string-to-utf8 (string)
+ "Convert the string to a vector of octets."
+ #+sbcl (sb-ext:string-to-octets
+ string
+ :external-format :utf-8)
+ ;; TODO: handle UTF-8 for other lisps
+ #-sbcl
+ (map 'list #'char-code string))
+
(defvar *startup-message* "Welcome to The Stump Window Manager!"
"StumpWM's startup message. Set to NIL to suppress.")
Index: user.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/user.lisp,v
retrieving revision 1.110
diff -u -r1.110 user.lisp
--- user.lisp 10 May 2007 10:36:14 -0000 1.110
+++ user.lisp 18 Jun 2007 21:27:21 -0000
@@ -1153,6 +1153,7 @@
(define-key m (kbd "'") "gselect")
(define-key m (kbd "m") "gmove")
(define-key m (kbd "k") "gkill")
+ (define-key m (kbd "0") "gselect 0")
(define-key m (kbd "1") "gselect 1")
(define-key m (kbd "2") "gselect 2")
(define-key m (kbd "3") "gselect 3")
@@ -1162,7 +1163,6 @@
(define-key m (kbd "7") "gselect 7")
(define-key m (kbd "8") "gselect 8")
(define-key m (kbd "9") "gselect 9")
- (define-key m (kbd "0") "gselect 10")
m)))
(defun group-forward (current list)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [STUMP] Groups are virtual desktops,
Magnus Henoch <=