Fix and optimize position setting methods for frames

In set-position, instead of delegating to the frame-x and frame-y
setters, calculate the values in the method and call set-position
again. This reduces method calls overall, especially to clients.
+ Fix (setf (frame-x tree-frame)) and (setf (frame-y tree-frame)) so
  that they translate their children in the correct direction

lisp/tree/frame.lisp

@@ -70,7 +70,32 @@
       frame
     (let ((diff (- old-x new-x)))
       (dolist (child children)
-	(setf (frame-x child) (+ diff (frame-x child)))))))
+	(setf (frame-x child) (- (frame-x child) diff))))))
+
+(defmethod (setf frame-y) :before (new-y (frame tree-frame))
+  "Translate the child frames so that geometry is preserved"
+  (with-accessors ((children tree-children)
+		   (old-y frame-y))
+      frame
+    (let ((diff (- old-y new-y)))
+      (dolist (child children)
+	(setf (frame-y child) (- (frame-y child) diff))))))
+
+(defmethod set-position ((frame frame) x y)
+  ;; Set slots directly to avoid calling the setf methods:
+  (setf (slot-value frame 'x) x
+	(slot-value frame 'y) y))
+
+(defmethod set-position :before ((frame tree-frame) new-x new-y)
+  (when (or (not (= (frame-x frame) new-x)) (not (= (frame-y frame) new-y)))
+    (with-accessors ((children tree-children)
+		     (old-x frame-x)
+		     (old-y frame-y))
+	frame
+      (let ((x-diff (- old-x new-x))
+	    (y-diff (- old-y new-y)))
+	(dolist (child children)
+	  (set-position child (- (frame-x child) x-diff) (- (frame-y child) y-diff)))))))
 
 (defmethod (setf frame-height) :before (new-height (frame tree-frame))
   "Scale and shift the children so that geometry is preserved"
@@ -86,23 +111,10 @@
 	  (setf (frame-y child) new-y)
 	  (setf shift (+ adjusted-height shift)))))))
 
-(defmethod (setf frame-y) :before (new-y (frame tree-frame))
-  "Translate the child frames so that geometry is preserved"
-  (with-accessors ((children tree-children)
-		   (old-y frame-y))
-      frame
-    (let ((diff (- old-y new-y)))
-      (dolist (child children)
-	(setf (frame-y child) (+ diff (frame-y child)))))))
-
 (defmethod set-dimensions ((frame frame) width height)
   (setf (frame-width frame) width
 	(frame-height frame) height))
 
-(defmethod set-position ((frame frame) x y)
-  (setf (frame-x frame) x
-	(frame-y frame) y))
-
 (defmethod split-frame-h :before ((frame frame) &key ratio direction)
   (declare (ignore frame direction))
   (when ratio

mahogany-test.asd

@@ -12,6 +12,7 @@ This file is a part of mahogany.
 	       #:fiasco)
   :pathname "test/"
   :components ((:test-file "tree-tests")
+	       (:file "tree-tests-2")
 	       (:file "keyboard-tests")
 	       (:file "log-tests"))
   :description "Test System for mahogany."

test/tree-tests-2.lisp

@@ -0,0 +1,66 @@
+(fiasco:define-test-package #:mahogany-tests/tree-2
+  (:use #:mahogany/tree #:mahogany/wm-interface))
+
+(in-package #:mahogany-tests/tree-2)
+
+(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)))
+    (setf (frame-parent frame) container)
+    (setf (root-tree container) frame)
+    (values frame container)))
+
+(defun make-tree-frame (children &key (x 0) (y 0) (width 100) (height 100))
+  (let ((parent (make-instance  'tree-frame :x 0 :y 0 :width 100 :height 100)))
+    (dolist (c children)
+      (setf (frame-parent c) parent))
+    (setf (tree-children parent) children)
+    parent))
+
+(fiasco:deftest set-position-view-frame ()
+  (let ((tree (make-basic-tree :x 0 :y 0)))
+    (set-position tree 100 200)
+    (is (= (frame-x tree) 100))
+    (is (= (frame-y tree) 200))))
+
+(fiasco:deftest set-position-tree-frame ()
+  (let* ((child-1 (make-instance 'view-frame :x 0 :y 0 :width 50 :height 100))
+	 (child-2 (make-instance 'view-frame :x 51 :y 0 :width 50 :height 100))
+	 (parent (make-tree-frame (list child-1 child-2))))
+    (set-position parent 100 200)
+    (is (= (frame-x child-1) 100))
+    (is (= (frame-y child-1) 200))
+    (is (= (frame-x child-2) 151))
+    (is (= (frame-y child-2) 200))))
+
+(fiasco:deftest setf-frame-x-view-frame-sets-value ()
+  (let ((tree (make-basic-tree :x 0 :y 0)))
+    (setf (frame-x tree) 100)
+    (is (= 100 (frame-x tree)))))
+
+(fiasco:deftest setf-frame-y-view-frame-sets-value ()
+  (let ((tree (make-basic-tree :x 0 :y 0)))
+    (setf (frame-y tree) 223)
+    (is (= (frame-y tree) 223))))
+
+(fiasco:deftest setf-frame-y-tree-frame ()
+  (let* ((child-1 (make-instance 'view-frame :x 0 :y 0 :width 50 :height 100))
+	 (child-2 (make-instance 'view-frame :x 51 :y 0 :width 50 :height 100))
+	 (parent (make-tree-frame (list child-1 child-2))))
+    (setf (frame-y parent) 100)
+    (is (= (frame-x parent) 0))
+    (is (= (frame-y parent) 100))
+    (is (= (frame-x child-1) 0))
+    (is (= (frame-y child-2) 100))
+    (is (= (frame-x child-2) 51))))
+
+(fiasco:deftest setf-frame-x-tree-frame ()
+  (let* ((child-1 (make-instance 'view-frame :x 0 :y 0 :width 50 :height 100))
+	 (child-2 (make-instance 'view-frame :x 51 :y 0 :width 50 :height 100))
+	 (parent (make-tree-frame (list child-1 child-2))))
+    (setf (frame-x parent) 100)
+    (is (= (frame-x parent) 100))
+    (is (= (frame-y parent) 0))
+    (is (= (frame-x child-1) 100))
+    (is (= (frame-y child-2) 0))
+    (is (= (frame-x child-2) 151))))