diff --git a/workgroups-morph.el b/workgroups-morph.el
new file mode 100644
index 0000000000000000000000000000000000000000..5099d4e150a5a94c838e2b0c0613a808f534fc8a
--- /dev/null
+++ b/workgroups-morph.el
@@ -0,0 +1,133 @@
+;;; morph
+;;
+;; TODO: Add upward and left morphing.  And once it's been added, add selection
+;;       of a random morph direction.
+;;
+
+(defun wg-morph-p ()
+  "Return t when it's ok to morph, nil otherwise."
+  (and after-init-time wg-morph-on))
+
+(defun wg-morph-step-edges (w1 w2)
+  "Step W1's edges toward W2's by `wg-morph-hsteps' and `wg-morph-vsteps'."
+  (wg-step-edges (wg-w-edges w1) (wg-w-edges w2)
+                 wg-morph-hsteps wg-morph-vsteps))
+
+(defun wg-morph-determine-steps (gui-steps &optional term-steps)
+  (max 1 (if (and (not window-system) term-steps) term-steps gui-steps)))
+
+(defun wg-morph-match-wlist (wt1 wt2)
+  "Return a wlist by matching WT1's wlist to WT2's.
+When wlist1's and wlist2's lengths are equal, return wlist1.
+When wlist1 is shorter than wlist2, add a window at the front of wlist1.
+When wlist1 is longer than wlist2, package up wlist1's excess windows
+into a wtree, so it's the same length as wlist2."
+  (let* ((wl1 (wg-wtree-wlist wt1))
+         (l1 (length wl1))
+         (d1 (wg-wtree-dir wt1))
+         (wl2 (wg-wtree-wlist wt2))
+         (l2 (length wl2)))
+    (cond ((= l1 l2) wl1)
+          ((< l1 l2)
+           (cons (wg-minified-copy-of-last-win (wg-rnth (1+ l1) wl2))
+                 (if (< (wg-w-size (car wl1) d1)
+                        (* 2 (wg-actual-min-size d1)))
+                     wl1
+                   (cons (wg-w-edge-operation (car wl1) wg-min-edges #'-)
+                         (cdr wl1)))))
+          ((> l1 l2)
+           (append (wg-take wl1 (1- l2))
+                   (list (wg-make-wtree
+                          :dir d1
+                          :edges wg-null-edges
+                          :wlist (nthcdr (1- l2) wl1))))))))
+
+(defun wg-morph-win-to-win (w1 w2 &optional swap)
+  "Return a copy of W1 with its edges stepped once toward W2.
+When SWAP is non-nil, return a copy of W2 instead."
+  (wg-set-edges (wg-copy-win (if swap w2 w1)) (wg-morph-step-edges w1 w2)))
+
+(defun wg-morph-win-to-wtree (win wtree)
+  "Return a new wtree with WIN's edges and WTREE's last two windows."
+  (wg-make-wtree
+   :dir (wg-wtree-dir wtree)
+   :edges (wg-morph-step-edges win wtree)
+   :wlist (let ((wg-morph-hsteps 2) (wg-morph-vsteps 2))
+            (wg-docar (w (wg-leave (wg-wtree-wlist wtree) 2))
+              (wg-morph-win-to-win (wg-minified-copy-of-last-win w) w)))))
+
+(defun wg-morph-wtree-to-win (wtree win &optional noswap)
+  "Grow the first window of WTREE and its subtrees one step toward WIN.
+This eventually wipes WTREE's components, leaving only a window.
+Swap WTREE's first actual window for WIN, unless NOSWAP is non-nil."
+  (if (wg-win-p wtree) (wg-morph-win-to-win wtree win (not noswap))
+    (wg-make-wtree
+     :dir (wg-wtree-dir wtree)
+     :edges (wg-morph-step-edges wtree win)
+     :wlist (wg-dbind (fwin . wins) (wg-wtree-wlist wtree)
+              (cons (wg-morph-wtree-to-win fwin win noswap)
+                    (wg-docar (sw wins)
+                      (if (wg-win-p sw) sw
+                        (wg-morph-wtree-to-win sw win t))))))))
+
+(defun wg-morph-wtree-to-wtree (wt1 wt2)
+  "Return a new wtree morphed one step toward WT2 from WT1.
+Mutually recursive with `wg-morph-dispatch' to traverse the
+structures of WT1 and WT2 looking for discrepancies."
+  (let ((d1 (wg-wtree-dir wt1)) (d2 (wg-wtree-dir wt2)))
+    (wg-make-wtree
+     :dir d2
+     :edges (wg-morph-step-edges wt1 wt2)
+     :wlist (if (not (eq (wg-wtree-dir wt1) (wg-wtree-dir wt2)))
+                (list (wg-minified-copy-of-last-win wt2) wt1)
+              (mapcar* #'wg-morph-dispatch
+                       (wg-morph-match-wlist wt1 wt2)
+                       (wg-wtree-wlist wt2))))))
+
+(defun wg-morph-dispatch (w1 w2)
+  "Return a wtree morphed one step toward W2 from W1.
+Dispatches on each possible combination of types."
+  (cond ((and (wg-win-p w1) (wg-win-p w2))
+         (wg-morph-win-to-win w1 w2 t))
+        ((and (wg-wtree-p w1) (wg-wtree-p w2))
+         (wg-morph-wtree-to-wtree w1 w2))
+        ((and (wg-win-p w1) (wg-wtree-p w2))
+         (wg-morph-win-to-wtree w1 w2))
+        ((and (wg-wtree-p w1) (wg-win-p w2))
+         (wg-morph-wtree-to-win w1 w2))))
+
+(defun wg-morph (to &optional from)
+  "Morph from wtree FROM to wtree TO.
+Assumes both FROM and TO fit in `selected-frame'."
+  (let ((from (or from (wg-window-tree-to-wtree (window-tree))))
+        (wg-morph-hsteps
+         (wg-morph-determine-steps wg-morph-hsteps wg-morph-terminal-hsteps))
+        (wg-morph-vsteps
+         (wg-morph-determine-steps wg-morph-vsteps wg-morph-terminal-vsteps))
+        (truncate-partial-width-windows wg-morph-truncate-partial-width-windows)
+        (wg-record-incorrectly-restored-bufs nil)
+        (wg-restore-scroll-bars nil)
+        (wg-restore-fringes nil)
+        (wg-restore-margins nil)
+        (wg-restore-point nil)
+        (wg-restore-mark nil)
+        (watchdog 0))
+    (wg-until (wg-equal-wtrees from to)
+      (condition-case err
+          (if (> (incf watchdog) wg-morph-max-steps)
+              (error "`wg-morph-max-steps' exceeded")
+            (setq from (wg-normalize-wtree (wg-morph-dispatch from to)))
+            (wg-restore-window-tree from)
+            (redisplay))
+        (error (wg-dbind (sym data) err
+                 (unless (and (stringp data)
+                              (string-match "too small" data))
+                   (signal sym data))))))
+    to))
+
+
+(provide 'workgroups-morph)
+
+
+
+