From bff48e5ed797eb095005225c1074a1c446fd4fc7 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Thu, 11 Jan 2018 01:05:20 -0500 Subject: [PATCH] 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 | 6 +- modules/feature/popup/autoload.el | 167 +++++++++++++++++++++++------- modules/feature/popup/config.el | 12 +-- 3 files changed, 140 insertions(+), 45 deletions(-) diff --git a/modules/feature/popup/+hacks.el b/modules/feature/popup/+hacks.el index dd922a171..e639383e3 100644 --- a/modules/feature/popup/+hacks.el +++ b/modules/feature/popup/+hacks.el @@ -146,9 +146,9 @@ the command buffer." ;; `org' (after! org - (set! :popup "^\\*\\(?:Agenda Com\\|Org \\(?:Links\\|Export Dispatcher\\|Select\\)\\)" - '((slot . -1) (size . +popup-shrink-to-fit)) - '((transient))) + (set! :popup "^\\*\\(?:Agenda Com\\|Calendar\\|Org \\(?:Links\\|Export Dispatcher\\|Select\\)\\)" + '((slot . -1) (vslot . -1) (size . +popup-shrink-to-fit)) + '((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))) diff --git a/modules/feature/popup/autoload.el b/modules/feature/popup/autoload.el index 4e3040205..917387486 100644 --- a/modules/feature/popup/autoload.el +++ b/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) - "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)))) +(defun +popup-display-buffer (buffer alist) + "A `display-buffer' action that serves as an alternative to +`display-buffer-in-side-window', but allows for stacking popups not only +laterally with the `vslot' alist entry. + +Accepts the same arguments as `display-buffer-in-side-window'. You must set +`window--sides-inhibit-check' to non-nil for this work properly." + (let* ((side (or (cdr (assq 'side alist)) 'bottom)) + (slot (or (cdr (assq 'slot alist)) 0)) + (vslot (or (cdr (assq 'vslot alist)) 0)) + (left-or-right (memq side '(left right))) + (dedicated (or display-buffer-mark-dedicated 'popup))) + + (cond ((not (memq side '(top bottom left right))) + (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))))))))) diff --git a/modules/feature/popup/config.el b/modules/feature/popup/config.el index 9fdf12302..eda53a178 100644 --- a/modules/feature/popup/config.el +++ b/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 "^\\*" nil '((select . t))) - (set! :popup "^\\*Completions" '((slot . -1)) '((transient . 0))) + (set! :popup "^ \\*" '((slot . 1) (vslot . -1) (size . +popup-shrink-to-fit))) + (set! :popup "^\\*" '((slot . 1) (vslot . -1)) '((select . t))) + (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))