feature/popup: use new +popup-display-buffer #337

Adds support for `slot` and `vslot`, allowing for two dimensional
control over where popups may spawn. Highly experimental.

It's upsetting that I have to set `window--sides-inhibit-check`, I'd
like to find a way around that, if possible.

modules/feature/popup/+hacks.el

@@ -146,9 +146,9 @@ the command buffer."
 
 ;; `org'
 (after! org
-  (set! :popup "^\\*\\(?:Agenda Com\\|Org \\(?:Links\\|Export Dispatcher\\|Select\\)\\)"
+  (set! :popup "^\\*\\(?:Agenda Com\\|Calendar\\|Org \\(?:Links\\|Export Dispatcher\\|Select\\)\\)"
-    '((slot . -1) (size . +popup-shrink-to-fit))
+    '((slot . -1) (vslot . -1) (size . +popup-shrink-to-fit))
-    '((transient)))
+    '((transient . 0)))
   (set! :popup "^\\*Org Agenda" '((size . 20)) '((select . t) (transient)))
   (set! :popup "^\\*Org Src"    '((size . 0.3)) '((quit) (select . t)))
   (set! :popup "^CAPTURE.*\\.org$" '((size . 0.2)) '((quit) (select . t)))

modules/feature/popup/autoload.el

@@ -180,14 +180,16 @@ Uses `shrink-window-if-larger-than-buffer'."
          (add-hook 'doom-escape-hook #'+popup|close-on-escape t)
          (add-hook 'doom-cleanup-hook #'+popup|cleanup-rules)
          (setq +popup--old-display-buffer-alist display-buffer-alist
-               display-buffer-alist +popup--display-buffer-alist)
+               display-buffer-alist +popup--display-buffer-alist
+               window--sides-inhibit-check t)
          (dolist (prop +popup-window-parameters)
            (push (cons prop 'writable) window-persistent-parameters)))
         (t
          (remove-hook 'doom-unreal-buffer-functions #'+popup-buffer-p)
          (remove-hook 'doom-escape-hook #'+popup|close-on-escape)
          (remove-hook 'doom-cleanup-hook #'+popup|cleanup-rules)
-         (setq display-buffer-alist +popup--old-display-buffer-alist)
+         (setq display-buffer-alist +popup--old-display-buffer-alist
+               window--sides-inhibit-check nil)
          (+popup|cleanup-rules)
          (dolist (prop +popup-window-parameters)
            (map-delete prop window-persistent-parameters)))))
@@ -415,38 +417,131 @@ prevent the popup(s) from messing up the UI (or vice versa)."
 ;; 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)
+(defun +popup-display-buffer (buffer alist)
-  "Highly experimental!"
+  "A `display-buffer' action that serves as an alternative to
-  (when-let* ((frame (+popup--splittable-frame)))
+`display-buffer-in-side-window', but allows for stacking popups not only
-    (let* ((-side (or (alist-get 'side alist) 'bottom))
+laterally with the `vslot' alist entry.
-           (side (+popup--side -side))
+
-           (size (alist-get (+popup--dimension -side) alist))
+Accepts the same arguments as `display-buffer-in-side-window'. You must set
-           (old-size (window-size (frame-root-window frame)
+`window--sides-inhibit-check' to non-nil for this work properly."
-                                  (memq -side '(left right))))
+  (let* ((side  (or (cdr (assq 'side alist)) 'bottom))
-           (new-size
+         (slot  (or (cdr (assq 'slot alist))  0))
-            (when (numberp size)
+         (vslot (or (cdr (assq 'vslot alist)) 0))
-              (round (if (>= size 1)
+         (left-or-right (memq side '(left right)))
-                         (- old-size size)
+         (dedicated (or display-buffer-mark-dedicated 'popup)))
-                       (* (- 1 size) old-size)))))
+
-           (window (split-window (frame-root-window frame) new-size side)))
+    (cond ((not (memq side '(top bottom left right)))
-      (window--display-buffer buf window 'window alist t))))
+           (error "Invalid side %s specified" side))
+          ((not (numberp slot))
+           (error "Invalid slot %s specified" slot))
+          ((not (numberp vslot))
+           (error "Invalid vslot %s specified" slot)))
+
+    (let* ((major (get-window-with-predicate
+                   (lambda (window)
+                     (and (eq (window-parameter window 'window-side) side)
+                          (eq (window-parameter window 'window-vslot) vslot)))
+                   nil t))
+           (reversed (window--sides-reverse-on-frame-p (selected-frame)))
+           (windows
+            (cond ((window-live-p major)
+                   (list major))
+                  ((window-valid-p major)
+                   (let* ((first (window-child major))
+                          (next (window-next-sibling first))
+                          (windows (list next first)))
+                     (setq reversed (> (window-parameter first 'window-slot)
+                                       (window-parameter next 'window-slot)))
+                     (while (setq next (window-next-sibling next))
+                       (setq windows (cons next windows)))
+                     (if reversed windows (nreverse windows))))))
+           (slots (if major (max 1 (window-child-count major))))
+           (max-slots
+            (nth (plist-get '(left 0 top 1 right 2 bottom 3) side)
+                 window-sides-slots))
+           (window--sides-inhibit-check t)
+           window this-window this-slot prev-window next-window
+           best-window best-slot abs-slot)
+
+      (cond ((and (numberp max-slots) (<= max-slots 0))
+             nil)
+            ((not windows)
+             (cl-letf (((symbol-function 'window--make-major-side-window-next-to)
+                        (lambda (_side) (frame-root-window (selected-frame)))))
+               (when-let* ((window (window--make-major-side-window buffer side slot alist)))
+                 (set-window-parameter window 'window-vslot vslot)
+                 (add-to-list 'window-persistent-parameters '(window-vslot . writable))
+                 window)))
+            (t
+             ;; Scan windows on SIDE.
+             (catch 'found
+               (dolist (window windows)
+                 (setq this-slot (window-parameter window 'window-slot))
+                 (cond ((not (numberp this-slot)))
+                       ((= this-slot slot) ; A window with a matching slot found
+                        (setq this-window window)
+                        (throw 'found t))
+                       (t
+                        ;; Check if this window has a better slot value wrt the
+                        ;; slot of the window we want.
+                        (setq abs-slot
+                              (if (or (and (> this-slot 0) (> slot 0))
+                                      (and (< this-slot 0) (< slot 0)))
+                                  (abs (- slot this-slot))
+                                (+ (abs slot) (abs this-slot))))
+                        (unless (and best-slot (<= best-slot abs-slot))
+                          (setq best-window window)
+                          (setq best-slot abs-slot))
+                        (if reversed
+                            (cond
+                             ((<= this-slot slot)
+                              (setq next-window window))
+                             ((not prev-window)
+                              (setq prev-window window)))
+                          (cond
+                           ((<= this-slot slot)
+                            (setq prev-window window))
+                           ((not next-window)
+                            (setq next-window window))))))))
+
+             ;; `this-window' is the first window with the same SLOT.
+             ;; `prev-window' is the window with the largest slot < SLOT. A new
+             ;; window will be created after it.
+             ;; `next-window' is the window with the smallest slot > SLOT. A new
+             ;; window will be created before it.
+             ;; `best-window' is the window with the smallest absolute
+             ;; difference of its slot and SLOT.
+             (or (and this-window
+                      ;; Reuse `this-window'.
+                      (with-current-buffer buffer
+                        (setq window--sides-shown t))
+                      (window--display-buffer
+                       buffer this-window 'reuse alist dedicated))
+                 (and (or (not max-slots) (< slots max-slots))
+                      (or (and next-window
+                               ;; Make new window before `next-window'.
+                               (let ((next-side (if left-or-right 'above 'left))
+                                     (window-combination-resize 'side))
+                                 (setq window (split-window-no-error
+                                               next-window nil next-side))))
+                          (and prev-window
+                               ;; Make new window after `prev-window'.
+                               (let ((prev-side (if left-or-right 'below 'right))
+                                     (window-combination-resize 'side))
+                                 (setq window (split-window-no-error
+                                               prev-window nil prev-side)))))
+                      (set-window-parameter window 'window-slot slot)
+                      (with-current-buffer buffer
+                        (setq window--sides-shown t))
+                      (window--display-buffer
+                       buffer window 'window alist dedicated))
+                 (and best-window
+                      ;; Reuse `best-window'.
+                      (progn
+                        ;; Give best-window the new slot value.
+                        (set-window-parameter best-window 'window-slot slot)
+                        (with-current-buffer buffer
+                          (setq window--sides-shown t))
+                        (window--display-buffer
+                         buffer best-window 'reuse alist dedicated)))))))))

modules/feature/popup/config.el

@@ -67,7 +67,7 @@ a brief description of some native window parameters that Emacs uses:
   `pop-to-buffer'. Doom popups sets this. The default is nil.")
 
 (defvar +popup-display-buffer-actions
-  '(display-buffer-reuse-window display-buffer-in-side-window)
+  '(display-buffer-reuse-window +popup-display-buffer)
   "The functions to use to display the popup buffer.")
 
 (defvar +popup-default-alist
@@ -145,19 +145,19 @@ ALIST supports one custom parameter: `size', which will resolve to
 ;;
 
 (eval-when-compile
-  (set! :popup "^ \\*" '((slot . -1) (size . +popup-shrink-to-fit)))
+  (set! :popup "^ \\*" '((slot . 1) (vslot . -1) (size . +popup-shrink-to-fit)))
-  (set! :popup "^\\*" nil '((select . t)))
+  (set! :popup "^\\*"  '((slot . 1) (vslot . -1)) '((select . t)))
-  (set! :popup "^\\*Completions" '((slot . -1)) '((transient . 0)))
+  (set! :popup "^\\*Completions" '((slot . -1) (vslot . -2)) '((transient . 0)))
   (set! :popup "^\\*Compilation" nil '((transient . 0) (quit . t)))
   (set! :popup "^\\*\\(?:scratch\\|Messages\\)" nil '((transient)))
   (set! :popup "^\\*Help"
-    '((slot . -1) (size . 0.2))
+    '((slot . 2) (vslot . 2) (size . 0.2))
     '((select . t)))
   (set! :popup "^\\*doom \\(?:term\\|eshell\\)"
     '((size . 0.25))
     '((quit) (transient . 0)))
   (set! :popup "^\\*doom:"
-    '((size . 0.35))
+    '((size . 0.35) (side . top))
     '((select . t) (modeline . t) (quit) (transient))))
 
 (setq +popup--display-buffer-alist (eval-when-compile +popup--display-buffer-alist))