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.
This commit is contained in:
Henrik Lissner
parent
991297b8e7
commit
bff48e5ed7
3 changed files with 140 additions and 45 deletions
|
|
@ -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)))))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue