Permalink
Browse files

WIP: NetWM strut support.

  • Loading branch information...
1 parent 61a7cf2 commit 6b482365f171ef8955f1409c3a4a0db37e94588b @dangerousben committed Jan 9, 2010
Showing with 103 additions and 15 deletions.
  1. +3 −5 events.lisp
  2. +3 −1 primitives.lisp
  3. +90 −0 strut.lisp
  4. +1 −0 stumpwm.asd
  5. +6 −9 window.lisp
View
@@ -141,11 +141,9 @@
;; only absorb it if it's not already managed (it could be iconic)
(cond
(win (dformat 1 "map request for mapped window ~a~%" win))
- ((eq (xwin-type window) :dock)
- (when wwin
- (setf screen (window-screen wwin)))
- (dformat 1 "window is dock-type. attempting to place in mode-line.")
- (place-mode-line-window screen window)
+ ((xwin-strut-p window)
+ (add-strut (if wwin (window-screen wwin) screen) window)
+ (apply-struts-to-heads screen)
;; Some panels are broken and only set the dock type after they map and withdraw.
(when wwin
(setf (screen-withdrawn-windows screen) (delete wwin (screen-withdrawn-windows screen))))
View
@@ -501,7 +501,9 @@ exist, in which case they go into the current group.")
(current-msg :initform nil :accessor screen-current-msg)
(current-msg-highlights :initform nil :accessor screen-current-msg-highlights)
(last-msg :initform nil :accessor screen-last-msg)
- (last-msg-highlights :initform nil :accessor screen-last-msg-highlights)))
+ (last-msg-highlights :initform nil :accessor screen-last-msg-highlights)
+ (struts :initform nil :accessor screen-struts :documentation
+ "A list of xlib:windows that have one of the netwm strut properties set.")))
(defstruct ccontext
win
View
@@ -0,0 +1,90 @@
+;; Copyright (C) 2010 Ben Spencer
+;;
+;; This file is part of stumpwm.
+;;
+;; stumpwm 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.
+
+;; stumpwm 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 this software; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+;; Commentary:
+;;
+;; NetWM strut (panel/dock) support
+;;
+;; Code:
+
+
+; Notes:
+;
+; Add strut:
+; when processing existing windows
+; when a strut window gets a map request
+; when we see a property notify changing struts (if not already a strut)
+;
+; Remove strut:
+; when a strut window is destroyed
+; when a we see a property notify removing strut properties
+;
+; Apply struts:
+; after initially generating heads / processing existing windows
+; when regenerating heads after a configure notify
+; after a strut window is mapped
+; when seeing a property notify changing struts
+; when a strut window is destroyed
+
+(in-package :stumpwm)
+
+(defun xwin-strut-p (win)
+ (or (xlib:get-property win :_NET_WM_STRUT_PARTIAL)
+ (xlib:get-property win :_NET_WM_STRUT)))
+
+(defun find-strut-screen (xwin)
+ (find-if (lambda (screen) (find xwin (screen-struts screen))) *screen-list*))
+
+(defun add-strut (screen xwin)
+ (pushnew xwin (screen-struts screen))
+ (xlib:map-window xwin))
+
+(defun remove-strut (screen xwin)
+ (setf (screen-struts screen)
+ (remove xwin (screen-struts screen))))
+
+(defun apply-struts-to-heads (screen)
+ (flet ((overlaps (s1 e1 s2 e2)
+ (> (- (min s1 s2)
+ (max e1 e2) 0))))
+ (dolist (oh (screen-heads screen))
+ (let* ((xs (head-x oh))
+ (xe (+ xs (head-width oh)))
+ (ys (head-y oh))
+ (ye (+ ys (head-height oh)))
+ (left xs)
+ (right (- (screen-width screen) xe))
+ (top ys)
+ (bottom (- (screen-height screen) ye))
+ (nh (copy-head oh)))
+ (dolist (strut (screen-struts screen))
+ (multiple-value-bind
+ (lo ro to bo ls le rs re ts te bs be)
+ (xwin-strut screen strut)
+ (when (overlaps ls le ys ye) (setf left (max left lo)))
+ (when (overlaps rs re ys ye) (setf right (max right ro)))
+ (when (overlaps ts te xs xe) (setf top (max top to)))
+ (when (overlaps bs be xs xe) (setf bottom (max bottom bo)))
+ (setf (head-x nh) left)
+ (setf (head-width nh) (- (screen-width screen) left right))
+ (setf (head-y nh) top)
+ (setf (head-height nh) (- (screen-height screen) top bottom))
+ (unless (equalp oh nh)
+ (scale-head screen oh nh))))))
+ (mapc 'group-add-head (screen-groups screen))))
View
@@ -42,6 +42,7 @@
(:file "window-placement")
(:file "message-window")
(:file "selection")
+ (:file "strut")
(:file "user")
(:file "iresize")
(:file "bindings")
View
@@ -608,15 +608,12 @@ and bottom_end_x."
;; Don't process override-redirect windows.
(unless (or (eq (xlib:window-override-redirect win) :on)
(internal-window-p screen win))
- (if (eq (xwin-type win) :dock)
- (progn
- (dformat 1 "Window ~S is dock-type. Placing in mode-line.~%" win)
- (place-mode-line-window screen win))
- (if (or (eql map-state :viewable)
- (eql wm-state +iconic-state+))
- (progn
- (dformat 1 "Processing ~S ~S~%" (xwin-name win) win)
- (process-mapped-window screen win))))))))
+ (unless (eq (xwin-type win) :dock)
+ (if (or (eql map-state :viewable)
+ (eql wm-state +iconic-state+))
+ (progn
+ (dformat 1 "Processing ~S ~S~%" (xwin-name win) win)
+ (process-mapped-window screen win))))))))
(dolist (w (screen-windows screen))
(setf (window-state w) +normal-state+)
(xwin-hide w)))

0 comments on commit 6b48236

Please sign in to comment.