Introduce the idea of a current frame and frame focus

Add `current-frame` slot to mahogany-group to represent the currently
focused frame, and ensure that a frame is focused when an output is
present.

+ Add various tree traversal and extraction methods to the tree
  package so we can pull views from it.

lisp/group.lisp

@@ -1,16 +1,30 @@
 (in-package #:mahogany)
 
+(defun group-focus-frame (group frame)
+  (with-accessors ((current-frame mahogany-group-current-frame)) group
+    (when current-frame
+      (group-unfocus-frame group current-frame))
+    (tree:mark-frame-focused frame)
+    (setf current-frame frame)))
 
+(defun group-unfocus-frame (group frame)
+  (with-accessors ((current-frame mahogany-group-current-frame)) group
+    (tree:unmark-frame-focused frame)
+    (setf current-frame nil)))
 
 (defun group-add-output (group output)
   (declare (type mahogany-output output)
 	   (type mahogany-group group))
-  (with-accessors ((output-map mahogany-group-output-map)) group
+  (with-accessors ((output-map mahogany-group-output-map)
+		   (current-frame mahogany-group-current-frame))
+      group
     (multiple-value-bind (x y) (hrt:output-position (mahogany-output-hrt-output output))
       (multiple-value-bind (width height) (hrt:output-resolution (mahogany-output-hrt-output output))
-	(setf (gethash (mahogany-output-full-name output) output-map)
-	      (tree:make-basic-tree :x x :y y :width width :height height))
-	(log-string :trace "Group map: ~S" output-map)))))
+	(let ((new-tree (tree:make-basic-tree :x x :y y :width width :height height)))
+	(setf (gethash (mahogany-output-full-name output) output-map) new-tree)
+	(when (not current-frame)
+	  (group-focus-frame group (tree:find-first-leaf new-tree))))))
+    (log-string :trace "Group map: ~S" output-map)))
 
 (defun group-reconfigure-outputs (group outputs)
   "Re-examine where the outputs are and adjust the trees that are associated with them
@@ -26,10 +40,27 @@ to match."
 		 (multiple-value-bind (width height) (hrt:output-resolution hrt-output)
 		   (set-dimensions (tree:root-tree tree) width height)))))))
 
+(defun %first-hash-table-value (table)
+  (declare (type hash-table table)
+	   (optimize (speed 3) (safety 0)))
+  (with-hash-table-iterator (iter table)
+    (multiple-value-bind (found key value) (iter)
+      (declare (ignore found key))
+      value)))
+
 (defun group-remove-output (group output)
   (declare (type mahogany-output output)
 	   (type mahogany-group group))
-  (remhash (mahogany-output-full-name output) (mahogany-group-output-map group)))
+  (with-accessors ((output-map mahogany-group-output-map)) group
+    (let* ((output-name (mahogany-output-full-name output))
+	   (tree-container (gethash output-name output-map)))
+      (remhash output-name output-map)
+      (when (equalp tree-container (tree:find-frame-container (mahogany-group-current-frame group)))
+	(group-unfocus-frame group (mahogany-group-current-frame group))
+	(alexandria:when-let ((other-container (%first-hash-table-value output-map)))
+	  (group-focus-frame group (tree:find-first-leaf other-container))))
+      (when (and (mahogany-group-current-frame group) (= 0 (hash-table-count output-map)))
+	(group-unfocus-frame group (mahogany-group-current-frame group))))))
 
 (defun group-add-view (group view)
   (declare (type mahogany-group group)
@@ -38,17 +69,30 @@ to match."
 		   (outputs mahogany-group-output-map))
       group
     (push view (mahogany-group-views group))
-    ;; (with-hash-table-iterator (iter outputs)
-    (loop for tree being the hash-values of outputs
-	  do (when-let ((empty (tree:find-empty-frame tree)))
-	       (log-string :trace "Found frame for view")
-	       (tree:put-view-in-frame view empty)
-	       (log-string :trace "Current tree: ~S" (tree:root-tree tree))
-	       (return-from group-add-view)))
-    ;; TODO: get algorithm to place new views so they can be seen:
-    (log-string :error "Could not find frame for new view")))
+    (alexandria:when-let ((current-frame (mahogany-group-current-frame group)))
+      (setf (tree:frame-view current-frame) view))))
 
 (defun group-remove-view (group view)
   (declare (type mahogany-group group))
-  (with-accessors ((view-list mahogany-group-views)) group
+  (with-accessors ((view-list mahogany-group-views)
+		   (output-map mahogany-group-output-map))
+      group
+    (maphash (lambda (key container)
+	       (declare (ignore key))
+	       ;; OPTIMIZE ME: get-pouplated frames builds a list, we could use an iterator instead.
+	       (dolist (f (mahogany/tree:get-populated-frames (mahogany/tree:root-tree container)))
+		 (when (equalp (tree:frame-view f) view)
+		   (log-string :trace "Removing view from frame")
+		   (setf (tree:frame-view f) nil))))
+	     output-map)
     (setf view-list (remove view view-list :test #'equalp))))
+
+(defmethod tree:find-empty-frame ((group mahogany-group))
+  (with-hash-table-iterator (iter (mahogany-group-output-map group))
+    (tagbody
+     :top (multiple-value-bind (found name frame) (iter)
+	    (declare (ignore name))
+	    (when found
+	      (alexandria:if-let ((view-frame (tree:find-empty-frame frame)))
+		(return-from tree:find-empty-frame view-frame)
+		(go :top)))))))

lisp/objects.lisp

@@ -8,6 +8,7 @@
   (name "" :type string)
   (number 1 :type fixnum :read-only t)
   (output-map (make-hash-table :test 'equal) :type hash-table :read-only t)
+  (current-frame nil :type (or tree:frame null))
   (views nil :type list))
 
 (defclass mahogany-state ()

lisp/state.lisp

@@ -74,3 +74,6 @@
 	(group-remove-view (mahogany-current-group state) view)
 	(remhash (cffi:pointer-address view-ptr) views))
       (log-string :error "Could not find mahogany view associated with pointer ~S" view-ptr))))
+
+(defun mahogany-current-frame (state)
+  (mahogany-group-current-frame (mahogany-current-group state)))

lisp/tree/frame.lisp

@@ -507,6 +507,12 @@ REMOVE-FUNC is called with one argument: the view that was removed."
 (defmethod find-empty-frame ((root tree-container))
   (find-empty-frame (root-tree root)))
 
+(defun find-first-leaf (container)
+  (declare (type tree-container container))
+  ;; TODO: you don't need the generator to do this:
+  (iter (for (frame) snakes:in-generator (leafs-in (root-tree container)))
+	(return-from find-first-leaf frame)))
+
 (defmethod get-empty-frames ((root frame))
   (let ((empties nil))
     (iter (for (frame) snakes:in-generator (leafs-in root))

lisp/tree/package.lisp

@@ -32,8 +32,11 @@
 	   #:get-empty-frames
 	   #:get-populated-frames
 	   #:root-frame-p
+	   #:find-frame-container
+	   #:find-first-leaf
+	   #:mark-frame-focused
+	   #:unmark-frame-focused
 	   ;; View-frame functions / objects
 	   #:view-frame
 	   #:frame-view
-	   #:put-view-in-frame
 	   #:leafs-in))

lisp/tree/tree-interface.lisp

@@ -33,7 +33,11 @@ of an already existing frame with the `set-split-frame-type` function")
 	   :accessor frame-height
 	   :type real)
    (parent :initarg :parent
-	   :accessor frame-parent))
+	   :accessor frame-parent)
+   (focused :initarg :focused
+	    :reader frame-focused
+	    :initform nil
+	    :type boolean))
   (:documentation "A frame that is displayed on an output"))
 
 (defclass tree-container ()
@@ -117,12 +121,28 @@ a view assigned to it."))
 (defgeneric frame-at (root x y)
   (:documentation "Get the frame that occupies the specified coordinates."))
 
+(defgeneric mark-frame-focused (frame)
+  (:documentation "Mark the frame as being focused")
+  (:method ((frame frame))
+    (setf (slot-value frame 'focused) t)))
+
+(defgeneric unmark-frame-focused (frame)
+  (:documentation "Mark the frame as being focused")
+  (:method ((frame frame))
+    (setf (slot-value frame 'focused) nil)))
+
 ;; helper functions:
 
 (defun root-frame-p (frame)
   ;; the root frame's parent will be a tree-container:
   (typep (frame-parent frame) 'tree-container))
 
+(defun find-frame-container (frame)
+  "Find the toplevel frame container for this frame"
+  (declare (type frame frame))
+  (do ((cur-frame frame (frame-parent cur-frame)))
+      ((typep cur-frame 'tree-container) cur-frame)))
+
 (defun make-basic-tree (&key (x 0) (y 0) (width 100) (height 100))
   (let ((container (make-instance 'tree-container))
 	(frame (make-instance 'view-frame :x x :y y :width width :height height)))

lisp/tree/view.lisp

@@ -7,16 +7,12 @@
 	 :type (or hrt:view null)
 	 :documentation "The client of the frame")))
 
-(defun fit-view-into-frame (view frame)
-  "Make the view fit in the dimensions of the frame"
-  (set-position view (round (frame-x frame)) (round (frame-y frame)))
-  (set-dimensions view (round (frame-width frame)) (round (frame-height frame))))
-
-(defun put-view-in-frame (view view-frame)
+(defmethod (setf frame-view) :after (view (frame view-frame))
   "Place the view in the frame and make it have the same dimensions
 and position as the frame"
-  (setf (frame-view view-frame) view)
-  (fit-view-into-frame view view-frame))
+  (when view
+    (set-position view (round (frame-x frame)) (round (frame-y frame)))
+    (set-dimensions view (round (frame-width frame)) (round (frame-height frame)))))
 
 (defmethod print-object ((object view-frame) stream)
   (print-unreadable-object (object stream :type t)