Added Xinerama Support

NEWS

@@ -5,6 +5,8 @@ This file documents user visible changes between versions of StumpWM
 * Changes since 0.0.6
 These changes are probably incomplete
 
+** Xinerama support
+
 ** support hidden groups
 
 ** added frame save and restore

core.lisp

@@ -260,16 +260,16 @@ Groups are known as \"virtual desktops\" in the NETWM standard."
   (check-type name string)
   (unless (or (equal name "") (equal name "."))
     (or (find-group screen name)
-	  (let* ((initial-frame (make-initial-frame screen))
-		 (ng (make-tile-group
-		      :frame-tree initial-frame
-		      :current-frame initial-frame
-		      :screen screen
-		      :number (find-free-group-number screen (if (equal (elt name 0) #\.) -1 0))
-		      :name name)))
-	    (setf (screen-groups screen) (append (screen-groups screen) (list ng)))
-	    (netwm-set-group-properties screen)
-	    ng))))
+	(let* ((heads (make-heads screen))
+	       (ng (make-tile-group
+		    :frame-tree heads
+		    :current-frame (first heads)
+		    :screen screen
+		    :number (find-free-group-number screen (if (equal (elt name 0) #\.) -1 0))
+		    :name name)))
+	  (setf (screen-groups screen) (append (screen-groups screen) (list ng)))
+	  (netwm-set-group-properties screen)
+	  ng))))
 
 (defun find-group (screen name)
   "Return the group with the name, NAME. Or NIL if none exists."
@@ -1169,8 +1169,8 @@ function expects to be wrapped in a with-state for win."
   (xlib:with-state ((screen-root screen))
     (let ((w (xlib:drawable-width win))
           (h (xlib:drawable-height win))
-          (screen-width (xlib:drawable-width (screen-root screen)))
-          (screen-height (xlib:drawable-height (screen-root screen))))
+			 (screen-width (head-width))
+			 (screen-height (head-height)))
       (let ((x (case gravity
                  ((:top-left :bottom-left) 0)
                  (:center (truncate (- screen-width w (* (xlib:drawable-border-width win) 2)) 2))
@@ -1179,8 +1179,8 @@ function expects to be wrapped in a with-state for win."
                  ((:bottom-right :bottom-left) (- screen-height h (* (xlib:drawable-border-width win) 2)))
                  (:center (truncate (- screen-height h (* (xlib:drawable-border-width win) 2)) 2))
                  (t 0))))
-        (setf (xlib:drawable-y win) (max 0 y)
-              (xlib:drawable-x win) (max 0 x))))))
+		       (setf (xlib:drawable-y win) (max (head-y) (+ (head-y) y))
+			     (xlib:drawable-x win) (max (head-x) (+ (head-x) x)))))))
 
 (defun setup-message-window (screen l)
   (let ((height (* (length l)
@@ -1244,15 +1244,6 @@ T (default) then also focus the frame."
   (remove-if-not (lambda (w) (eq (window-frame w) f))
 		 (sort-windows group)))
 
-(defun make-initial-frame (screen)
-  "Used to create an initial frame hash for a screen."
-  (make-frame :number 0
-              :x (screen-x screen)
-              :y (screen-y screen)
-              :width (screen-width screen)
-              :height (screen-height screen)
-              :window nil))
-
 (defun copy-frame-tree (group)
   "Return a copy of the frame tree."
   (labels ((copy (tree)
@@ -1567,24 +1558,30 @@ either :width or :height"
       ;; normalize amount
       (let* ((max (ecase dim
                     (:width
+				(if (>= (frame-width frame) (frame-width (frame-head group frame)))
+				    0
                      (if (eq split-type :column)
                          (max-amount parent frame *min-frame-width* 'tree-width)
-                         (max-amount gparent parent *min-frame-width* 'tree-width)))
+				    (max-amount gparent parent *min-frame-width* 'tree-width))))
                     (:height
+				(if (>= (frame-height frame) (frame-height (frame-head group frame)))
+				    0
                      (if (eq split-type :row)
                          (max-amount parent frame *min-frame-height* 'tree-height)
-                         (max-amount gparent parent *min-frame-height* 'tree-height)))))
+				    (max-amount gparent parent *min-frame-height* 'tree-height))))))
              (min (ecase dim
-                    ;; Frames taking up the entire screen in one
+			       ;; Frames taking up the entire HEAD in one
                     ;; dimension can't be resized in that dimension.
                     (:width
                      (if (and (eq split-type :row)
-                              (null gparent))
+					 (or (null gparent)
+					     (>= (frame-width frame) (frame-width (frame-head group frame)))))
                          0
                          (- *min-frame-width* (frame-width frame))))
                     (:height
                      (if (and (eq split-type :column)
-                              (null gparent))
+					 (or (null gparent)
+					     (>= (frame-height frame) (frame-height (frame-head group frame)))))
                          0
                          (- *min-frame-height* (frame-height frame)))))))
         (setf amount (max (min amount max) min))
@@ -1641,7 +1638,8 @@ depending on the tree's split direction."
 (defun split-frame (group how)
   "split the current frame into 2 frames. return T if it succeeded. NIL otherwise."
   (check-type how (member :row :column))
-  (let* ((frame (tile-group-current-frame group)))
+  (let* ((frame (tile-group-current-frame group))
+		 (head (frame-head group frame)))
     ;; don't create frames smaller than the minimum size
     (when (or (and (eq how :row)
                    (>= (frame-height frame) (* *min-frame-height* 2)))
@@ -1651,10 +1649,10 @@ depending on the tree's split direction."
                                                 'split-frame-h
                                                 'split-frame-v)
                                             group frame)
-        (setf (tile-group-frame-tree group)
-              (if (atom (tile-group-frame-tree group))
+        (setf (tile-group-frame-head group head)
+              (if (atom (tile-group-frame-head group head))
                   (list f1 f2)
-                  (funcall-on-node (tile-group-frame-tree group)
+                  (funcall-on-node (tile-group-frame-head group head)
                                    (lambda (tree)
                                      (if (eq (tree-split-type tree) how)
                                          (list-splice-replace frame tree f1 f2)
@@ -1739,10 +1737,7 @@ windows used to draw the numbers in. The caller must destroy them."
 
 (defun sort-screens ()
   "Return the list of screen sorted by ID."
-  (sort1 *screen-list*
-	 (lambda (a b)
-	   (< (screen-id a)
-	      (screen-id b)))))
+  (sort1 *screen-list* #'< :key #'screen-id))
 
 (defun next-screen (&optional (list (sort-screens)))
   (let ((matches (member (current-screen) list)))
@@ -2094,11 +2089,79 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
 				     :subwindow-mode :include-inferiors
 				     :foreground  (xlib:alloc-color (xlib:screen-default-colormap screen-number) +default-foreground-color+)
 				     :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))
+    (setf (screen-heads screen) (make-heads screen)
+	  (tile-group-frame-tree group) (make-heads screen)
+	  (tile-group-current-frame group) (first (tile-group-frame-tree group)))
     (netwm-set-properties screen focus-window)
     screen))
 
+
+;;; Head functions
+
+(defun head-width ()
+  (frame-width (current-head)))
+
+(defun head-height ()
+  (frame-height (current-head)))
+
+(defun head-x ()
+  (frame-x (current-head)))
+
+(defun head-y ()
+  (frame-y (current-head)))
+
+;; Use xdpyinfo to query the xinerama extension, if it's enabled.
+(defun make-heads (screen)
+  (if (screen-heads screen)
+      (mapcar #'copy-frame (screen-heads screen))
+    (if (xlib:query-extension *display* "XINERAMA")
+	(let ((*package* (find-package :stumpwm)))
+	  (read-from-string
+	   (let ((*screen-list* (list screen)))
+	     (run-prog-collect-output "/bin/sh" "-c" "echo -n '\('; xdpyinfo -ext XINERAMA | sed -n 's/^\\s\\+head #\\([[:digit:]]\\):\\s\\+\\([[:digit:]]\\+\\)x\\([[:digit:]]\\+\\)\\s*@\\s*\\([[:digit:]]\\+\\),\\([[:digit:]]\\+\\).*$/#S(frame :number \\1 :width \\2 :height \\3 :x \\4 :y \\5)/p'; echo -n '\)'"))))
+      (list (make-frame :number 0
+			:x (screen-x screen)
+			:y (screen-y screen)
+			:width (screen-width screen)
+			:height (screen-height screen)
+			:window nil)))))
+
+;; Determining a frame's head based on position probably won't
+;; work with overlapping heads. Would it be better to walk
+;; up the frame tree?
+(defun frame-head (group frame)
+  (dolist (head (screen-heads (group-screen group)))
+    (when (and
+	   (>= (frame-x frame) (frame-x head))
+	   (>= (frame-y frame) (frame-y head))
+	   (<= (+ (frame-x frame) (frame-width frame))
+	       (+ (frame-x head) (frame-width head)))
+	   (<= (+ (frame-y frame) (frame-height frame))
+	       (+ (frame-y head) (frame-height head))))
+      (return head))))
+
+(defun group-heads (group)
+  (screen-heads (group-screen group)))
+
+(defun tile-group-frame-head (group head)
+  (elt (tile-group-frame-tree group) (position head (group-heads group))))
+
+(defun (setf tile-group-frame-head) (frame group head)
+  (setf (elt (tile-group-frame-tree group) (position head (group-heads group))) frame))
+
+(defun current-head (&optional (group (current-group)))
+  (frame-head group (tile-group-current-frame group)))
+
+(defun head-windows (group head)
+  "Returns a list of windows on HEAD of GROUP"
+  (remove-if-not
+   (lambda (w)
+     (eq head (frame-head group (window-frame w))))
+   (group-windows group)))
+
+(defun frame-is-head (group frame)
+  (< (frame-number frame) (length (group-heads group))))
+
 
 ;;; keyboard helper functions
 

primitives.lisp

@@ -241,6 +241,8 @@ name. :title, :resource-name, :class are valid values.")
   id
   host
   number
+  ;; heads of screen
+  heads
   ;; the list of groups available on this screen
   groups
   current-group

stumpwm.clisp

@@ -10,7 +10,7 @@
 ;; environment variable.
 
 ;; specify where asdf.lisp is.
-(load "/path/to/asdf.lisp")
+(load "/usr/share/common-lisp/source/asdf/asdf.lisp")
 (push (merge-pathnames  #p".asdf-system/" (user-homedir-pathname)) asdf:*central-registry*)
 
 ;; Note: The first time stumpwm is loaded it will be compiled. This

stumpwm.texi

@@ -1011,7 +1011,7 @@ frame taking up its space.
 @end deffn
 
 @deffn {Command} only
-Delete all the frames but the current one and grow it to take up the entire screen.
+Delete all the frames but the current one and grow it to take up the entire head.
 @end deffn
 
 @deffn {Command} curframe
@@ -1319,8 +1319,13 @@ Go to the last screen.
 
 @node Xinerama, Programming With Screens, Screens, Screens
 @section Xinerama
-Currently StumpWM doesn't explicitly handle Xinerama. Though, it
-shouldn't break StumpWM.
+StumpWM will attempt to detect Xinerama heads at startup (and at no other
+time.) Heads are logically contained by screens. In a dual-monitor Xinerama
+configuration, there will be one screen with two heads. Non-rectangular layouts
+are supported (frames will not be created in the 'dead zone'.) And message
+windows will be displayed on the current head--that is, the head to which the
+currently focused frame belongs. The mode line is not currently Xinerama-aware.
+
 
 @node Programming With Screens,  , Xinerama, Screens
 @section Programming With Screens
@@ -1402,7 +1407,7 @@ section.
 
 
 @deffn {Command} banish
-Warp the mouse the lower right corner.
+Warp the mouse the lower right corner of the current head.
 @end deffn
 
 @deffn {Command} ratwarp @var{x} @var{y}

user.lisp

@@ -266,11 +266,13 @@ frame."
   (kill-current-window))
 
 (defun banish-pointer ()
-  "Move the pointer to the lower right corner of the screen"
+  "Move the pointer to the lower right corner of the head"
   (let ((group (current-group)))
     (warp-pointer (group-screen group)
-		  (1- (screen-width (current-screen)))
-		  (1- (screen-true-height (current-screen))))))
+		  (1- (+ (head-x) (head-width)))
+		  (1- (+ (head-y) (head-height))))))
+					;		  (1- (screen-width (current-screen)))
+					;		  (1- (screen-true-height (current-screen))))))
 
 (define-stumpwm-command "banish" ()
   (banish-pointer))
@@ -545,9 +547,15 @@ returns..which could be forever if you're not careful."
                            (lambda (&rest siblings)
                              (car siblings))
                            #'identity)))
+
+    (if (frame-is-head group l)
+	(message "No more frames!")
+      (progn
     ;; Only remove the current frame if it has a sibling
     (dformat 3 "~S~%" s)
     (when s
+	  (when (frame-is-head group (tile-group-current-frame group))
+	    (setf (frame-number l) (frame-number (tile-group-current-frame group))))
       (dformat 3 "~S~%" l)
       ;; Move the windows from the removed frame to its sibling
       (migrate-frame-windows group (tile-group-current-frame group) l)
@@ -568,24 +576,29 @@ returns..which could be forever if you're not careful."
       (frame-raise-window group l (frame-window l))
       (when (frame-window l)
 	(update-window-border (frame-window l)))
-      (show-frame-indicator group))))
+	  (show-frame-indicator group))))))
 
 (define-stumpwm-command "remove" ()
   (remove-split (current-group)))
 
+
 (define-stumpwm-command "only" ()
   (let* ((screen (current-screen))
 	 (group (screen-current-group screen))
-	 (frame (make-initial-frame screen))
-	 (win (frame-window (tile-group-current-frame group))))
+	 (win (frame-window (tile-group-current-frame group)))
+	 (head (current-head group))
+	 (frame (copy-frame head)))
     (mapc (lambda (w)
 	    ;; windows in other frames disappear
 	    (unless (eq (window-frame w) (tile-group-current-frame group))
 	      (hide-window w))
 	    (setf (window-frame w) frame))
-	  (group-windows group))
+	  (head-windows group head))
+
     (setf (frame-window frame) win
-	  (tile-group-frame-tree group) frame)
+	  (tile-group-frame-head group head) frame 
+	  (tile-group-current-frame group) frame)
+
     (focus-frame group frame)
     (when (frame-window frame)
       (update-window-border (frame-window frame)))
@@ -661,12 +674,13 @@ select one. Returns the selected frame or nil if aborted."
 
 (define-stumpwm-command "resize" ((w :number "+ Width: ")
 				  (h :number "+ Height: "))
-  (if (atom (tile-group-frame-tree (current-group)))
-      (message "There's only 1 frame!")
       (let* ((group (current-group))
              (f (tile-group-current-frame group)))  
+    (if (atom (tile-group-frame-tree group))
+	(message "No more frames!")
+      (progn
         (resize-frame group f w :width)
-        (resize-frame group f h :height))))
+	(resize-frame group f h :height)))))
 
 (defun eval-line (cmd)
   (handler-case 
@@ -1231,13 +1245,14 @@ be found, select it.  Otherwise simply run cmd."
 	  m)))
 
 (define-stumpwm-command "iresize" ()
-  (if (atom (tile-group-frame-tree (current-group)))
+  (let ((frame (tile-group-current-frame (current-group))))
+    (if	(atom (tile-group-frame-head (current-group) (frame-head (current-group) frame)))
       (message "There's only 1 frame!")
       (progn
 	(message "Resize Frame")
 	(push-top-map *resize-map*))
       ;;   (setf *resize-backup* (copy-frame-tree (current-group)))
-      ))
+      )))
 
 (define-stumpwm-command "abort-iresize" ()
   (message "Abort resize")