From c03d0dbc06b684a18e20d5bfe8a75713e1286e7b Mon Sep 17 00:00:00 2001
From: Henrik Lissner <henrik@lissner.net>
Date: Tue, 9 Jan 2018 16:43:07 -0500
Subject: [PATCH] feature/popup: add +popup-display-buffer action #337

This is experimental and disabled by default. It uses a slightly more
primitive backend that will stack popups away from the edge of the
frame. This will need more work to take window-slot into account.

To use it:

  (remove-hook '+popup-display-buffer-actions 'display-buffer-in-side-window)
  (add-hook '+popup-display-buffer-actions #'+popup-display-buffer t)
---
 modules/feature/popup/autoload.el | 41 +++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

diff --git a/modules/feature/popup/autoload.el b/modules/feature/popup/autoload.el
index 7acc9a00e..0e75e4183 100644
--- a/modules/feature/popup/autoload.el
+++ b/modules/feature/popup/autoload.el
@@ -408,3 +408,44 @@ prevent the popup(s) from messing up the UI (or vice versa)."
   "Sets aside all popups before executing the original function, usually to
 prevent the popup(s) from messing up the UI (or vice versa)."
   (save-popups! (apply orig-fn args)))
+
+
+;;
+;; Popup actions
+;;
+
+(defun +popup--dimension (side)
+  (if (memq side '(left right))
+      'window-width
+    'window-height))
+
+(defun +popup--side (side)
+  (pcase side (`bottom 'below) (`top 'above) (_ side)))
+
+(defun +popup--frame-splittable-p (frame)
+  (when (and (window--frame-usable-p frame)
+             (not (frame-parameter frame 'unsplittable)))
+    frame))
+
+(defun +popup--splittable-frame ()
+  (let ((selected-frame (selected-frame))
+        (last-non-minibuffer-frame (last-nonminibuffer-frame)))
+    (or (+popup--frame-splittable-p selected-frame)
+        (+popup--frame-splittable-p last-non-minibuffer-frame))))
+
+;;;###autoload
+(defun +popup-display-buffer (buf alist)
+  "Highly experimental!"
+  (when-let* ((frame (+popup--splittable-frame)))
+    (let* ((-side (or (alist-get 'side alist) 'bottom))
+           (side (+popup--side -side))
+           (size (alist-get (+popup--dimension -side) alist))
+           (old-size (window-size (frame-root-window frame)
+                                  (memq -side '(left right))))
+           (new-size
+            (when (numberp size)
+              (round (if (>= size 1)
+                         (- old-size size)
+                       (* (- 1 size) old-size)))))
+           (window (split-window (frame-root-window frame) new-size side)))
+      (window--display-buffer buf window 'window alist t))))