Updating Doom Emacs.

.emacs.d/modules/ui/popup/+hacks.el

@@ -9,7 +9,7 @@
 ;;    other windows just to pop up one tiny window).
 ;; 2. Forcing plugins to use `display-buffer' and `pop-to-buffer' instead of
 ;;    `switch-to-buffer' (which is unaffected by `display-buffer-alist', which
-;;    this module heavily relies on).
+;;    we must rely on, heavily).
 ;; 3. Closing popups (temporarily) before functions that are highly destructive
 ;;    to the illusion of popup control get run (with the use of the
 ;;    `save-popups!' macro).
@@ -26,6 +26,15 @@
 ;;
 ;;; Core functions
 
+(defadvice! +popup--make-case-sensitive-a (orig-fn &rest args)
+  "Make regexps in `display-buffer-alist' case-sensitive.
+
+To reduce fewer edge cases and improve performance when `display-buffer-alist'
+grows larger."
+  :around #'display-buffer-assq-regexp
+  (let (case-fold-search)
+    (apply orig-fn args)))
+
 ;; Don't try to resize popup windows
 (advice-add #'balance-windows :around #'+popup-save-a)
 
@@ -37,8 +46,8 @@ to this commmand."
   (let ((orig-buffer (current-buffer)))
     (quit-window)
     (when (and (eq orig-buffer (current-buffer))
-               (+popup-window-p))
-      (+popup/close))))
+               (+popup-buffer-p))
+      (+popup/close nil 'force))))
 (global-set-key [remap quit-window] #'+popup/quit-window)
 
 
@@ -186,30 +195,28 @@ the command buffer."
   ;; Fix #897: "cannot open side window" error when TAB-completing file links
   (defadvice! +popup--helm-hide-org-links-popup-a (orig-fn &rest args)
     :around #'org-insert-link
-    (cl-letf* ((old-org-completing-read (symbol-function 'org-completing-read))
-               ((symbol-function 'org-completing-read)
-                (lambda (&rest args)
-                  (when-let (win (get-buffer-window "*Org Links*"))
-                    ;; While helm is opened as a popup, it will mistaken the
-                    ;; *Org Links* popup for the "originated window", and will
-                    ;; target it for actions invoked by the user. However, since
-                    ;; *Org Links* is a popup too (they're dedicated side
-                    ;; windows), Emacs complains about being unable to split a
-                    ;; side window. The simple fix: get rid of *Org Links*!
-                    (delete-window win)
-                    ;; But it must exist for org to clean up later.
-                    (get-buffer-create "*Org Links*"))
-                  (apply old-org-completing-read args))))
+    (letf! ((defun org-completing-read (&rest args)
+              (when-let (win (get-buffer-window "*Org Links*"))
+                ;; While helm is opened as a popup, it will mistaken the *Org
+                ;; Links* popup for the "originated window", and will target it
+                ;; for actions invoked by the user. However, since *Org Links*
+                ;; is a popup too (they're dedicated side windows), Emacs
+                ;; complains about being unable to split a side window. The
+                ;; simple fix: get rid of *Org Links*!
+                (delete-window win)
+                ;; ...but it must exist for org to clean up later.
+                (get-buffer-create "*Org Links*"))
+              (apply org-completing-read args)))
       (apply #'funcall-interactively orig-fn args)))
 
   ;; Fix left-over popup window when closing persistent help for `helm-M-x'
   (defadvice! +popup--helm-elisp--persistent-help-a (candidate _fun &optional _name)
     :before #'helm-elisp--persistent-help
     (let (win)
-      (when (and (helm-attr 'help-running-p)
-                 (string= candidate (helm-attr 'help-current-symbol))
-                 (setq win (get-buffer-window (get-buffer (help-buffer)))))
-        (delete-window win)))))
+      (and (helm-attr 'help-running-p)
+           (string= candidate (helm-attr 'help-current-symbol))
+           (setq win (get-buffer-window (get-buffer (help-buffer))))
+           (delete-window win)))))
 
 
 ;;;###package Info
@@ -219,32 +226,37 @@ the command buffer."
     (when (+popup-window-p win)
       (select-window win))))
 
-
-;;;###package multi-term
-(setq multi-term-buffer-name "doom terminal")
-
-
-;;;###package neotree
-(after! neotree
-  (advice-add #'neo-util--set-window-width :override #'ignore)
-  (advice-remove #'balance-windows #'ad-Advice-balance-windows))
-
-
 ;;;###package org
 (after! org
   ;; Org has a scorched-earth window management policy I'm not fond of. i.e. it
   ;; kills all other windows just so it can monopolize the frame. No thanks. We
-  ;; can do better ourselves.
+  ;; can do better.
   (defadvice! +popup--suppress-delete-other-windows-a (orig-fn &rest args)
     :around '(org-add-log-note
               org-capture-place-template
               org-export--dispatch-ui
               org-agenda-get-restriction-and-command
+              org-goto-location
               org-fast-tag-selection
               org-fast-todo-selection)
     (if +popup-mode
-        (cl-letf (((symbol-function #'delete-other-windows)
-                   (symbol-function #'ignore)))
+        (letf! ((#'delete-other-windows #'ignore)
+                (#'delete-window        #'ignore))
+          (apply orig-fn args))
+      (apply orig-fn args)))
+
+  (defadvice! +popup--org-fix-goto-a (orig-fn &rest args)
+    "`org-goto' uses `with-output-to-temp-buffer' to display its help buffer,
+for some reason, which is very unconventional, and so requires these gymnastics
+to tame (i.e. to get the popup manager to handle it)."
+    :around #'org-goto-location
+    (if +popup-mode
+        (letf! (defun internal-temp-output-buffer-show (buffer)
+                 (let ((temp-buffer-show-function
+                        (doom-rpartial #'+popup-display-buffer-stacked-side-window-fn nil)))
+                   (with-current-buffer buffer
+                     (hide-mode-line-mode +1))
+                   (funcall internal-temp-output-buffer-show buffer)))
           (apply orig-fn args))
       (apply orig-fn args)))
 
@@ -255,16 +267,14 @@ Ugh, such an ugly hack."
     :around '(org-fast-tag-selection
               org-fast-todo-selection)
     (if +popup-mode
-        (cl-letf* ((old-fit-buffer-fn (symbol-function #'org-fit-window-to-buffer))
-                   ((symbol-function #'org-fit-window-to-buffer)
-                    (lambda (&optional window max-height min-height shrink-only)
-                      (when-let (buf (window-buffer window))
-                        (delete-window window)
-                        (select-window
-                         (setq window (display-buffer-at-bottom buf nil)))
-                        (with-current-buffer buf
-                          (setq mode-line-format nil)))
-                      (funcall old-fit-buffer-fn window max-height min-height shrink-only))))
+        (letf! ((defun org-fit-window-to-buffer (&optional window max-height min-height shrink-only)
+                  (when-let (buf (window-buffer window))
+                    (delete-window window)
+                    (select-window
+                     (setq window (display-buffer-at-bottom buf nil)))
+                    (with-current-buffer buf
+                      (setq mode-line-format nil)))
+                  (funcall org-fit-window-to-buffer window max-height min-height shrink-only)))
           (apply orig-fn args))
       (apply orig-fn args)))
 
@@ -274,7 +284,24 @@ Ugh, such an ugly hack."
     :around #'org-switch-to-buffer-other-window
     (if +popup-mode
         (pop-to-buffer buf nil norecord)
-      (funcall orig-fn buf norecord))))
+      (funcall orig-fn buf norecord)))
+
+  ;; HACK `pop-to-buffer-same-window' consults `display-buffer-alist', which is
+  ;;      what our popup manager uses to manage popup windows. However,
+  ;;      `org-src-switch-to-buffer' already does its own window management
+  ;;      prior to calling `pop-to-buffer-same-window', so there's no need to
+  ;;      _then_ hand off the buffer to the pop up manager.
+  (defadvice! +popup--org-src-switch-to-buffer-a (orig-fn &rest args)
+    :around #'org-src-switch-to-buffer
+    (letf! ((#'pop-to-buffer-same-window #'switch-to-buffer))
+      (apply orig-fn args))))
+
+
+;;;###package org-journal
+(defadvice! +popup--use-popup-window-a (orig-fn &rest args)
+  :around #'org-journal-search-by-string
+  (letf! ((#'switch-to-buffer #'pop-to-buffer))
+    (apply orig-fn args)))
 
 
 ;;;###package persp-mode
@@ -304,8 +331,7 @@ Ugh, such an ugly hack."
 ;;;###package profiler
 (defadvice! +popup--profiler-report-find-entry-in-other-window-a (orig-fn function)
   :around #'profiler-report-find-entry
-  (cl-letf (((symbol-function 'find-function)
-             (symbol-function 'find-function-other-window)))
+  (letf! ((#'find-function #'find-function-other-window))
     (funcall orig-fn function)))
 
 
@@ -320,14 +346,16 @@ Ugh, such an ugly hack."
 (after! which-key
   (when (eq which-key-popup-type 'side-window)
     (setq which-key-popup-type 'custom
-          which-key-custom-popup-max-dimensions-function (lambda (_) (which-key--side-window-max-dimensions))
+          which-key-custom-popup-max-dimensions-function
+          (lambda (_) (which-key--side-window-max-dimensions))
           which-key-custom-hide-popup-function #'which-key--hide-buffer-side-window
           which-key-custom-show-popup-function
           (lambda (act-popup-dim)
-            (cl-letf (((symbol-function 'display-buffer-in-side-window)
-                       (lambda (buffer alist)
-                         (+popup-display-buffer-stacked-side-window-fn
-                          buffer (append '((vslot . -9999)) alist)))))
+            (letf! ((defun display-buffer-in-side-window (buffer alist)
+                      (+popup-display-buffer-stacked-side-window-fn
+                       buffer (append '((vslot . -9999)) alist))))
+              ;; HACK Fix #2219 where the which-key popup would get cut off.
+              (setcar act-popup-dim (1+ (car act-popup-dim)))
               (which-key--show-buffer-side-window act-popup-dim))))))
 
 
@@ -336,9 +364,8 @@ Ugh, such an ugly hack."
 (defadvice! +popup--ignore-window-parameters-a (orig-fn &rest args)
   "Allow *interactive* window moving commands to traverse popups."
   :around '(windmove-up windmove-down windmove-left windmove-right)
-  (cl-letf (((symbol-function #'windmove-find-other-window)
-             (lambda (dir &optional arg window)
-               (window-in-direction
-                (pcase dir (`up 'above) (`down 'below) (_ dir))
-                window (bound-and-true-p +popup-mode) arg windmove-wrap-around t))))
+  (letf! ((defun windmove-find-other-window (dir &optional arg window)
+            (window-in-direction
+             (pcase dir (`up 'above) (`down 'below) (_ dir))
+             window (bound-and-true-p +popup-mode) arg windmove-wrap-around t)))
     (apply orig-fn args)))