msyds/sydnix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: Expand org-mode defadvice! calls

Browse Source
This commit is contained in:
Madeleine Sydney
2025-01-30 03:52:07 -07:00
parent d27a3b60ce
commit d6c5e321c8
1 changed files with 68 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

108
users/crumb/programs/emacs/modules/doom-popup/doom-popup-hacks.el
View File

@@ -261,70 +261,98 @@ the command buffer."
(with-eval-after-load 'org (with-eval-after-load 'org
(defadvice! doom-popup--suppress-delete-other-windows-a (fn &rest args) (defun doom-popup--suppress-delete-other-windows-a (fn &rest args)
"Org has a scorched-earth window management policy I'm not fond of. i.e. it "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 kills all other windows just so it can monopolize the frame. No thanks. We can
do better." do better."
:around #'org-add-log-note
:around #'org-capture-place-template
:around #'org-export--dispatch-ui
:around #'org-agenda-get-restriction-and-command
:around #'org-goto-location
:around #'org-fast-tag-selection
:around #'org-fast-todo-selection
(if doom-popup-mode (if doom-popup-mode
(letf! ((#'delete-other-windows #'ignore) (cl-letf (((symbol-function #'delete-other-windows) #'ignore))
(#'delete-window #'ignore)) (cl-letf
(apply fn args)) (((symbol-function #'delete-window) #'ignore))
(apply fn args)))
(apply fn args))) (apply fn args)))
(defadvice! doom-popup--org-fix-goto-a (fn &rest args) (dolist (target (list #'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))
(advice-add target
:around #'doom-popup--suppress-delete-other-windows-a))
(defun doom-popup--org-fix-goto-a (fn &rest args)
"`org-goto' uses `with-output-to-temp-buffer' to display its help buffer, "`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 for some reason, which is very unconventional, and so requires these gymnastics
to tame (i.e. to get the popup manager to handle it)." to tame (i.e. to get the popup manager to handle it)."
:around #'org-goto-location
(if doom-popup-mode (if doom-popup-mode
(letf! (defun internal-temp-output-buffer-show (buffer) (cl-letf ((internal-temp-output-buffer-show
(let ((temp-buffer-show-function (symbol-function #'internal-temp-output-buffer-show)))
(lambda (&rest args) (ignore internal-temp-output-buffer-show)
(apply #'doom-popup-display-buffer-stacked-side-window-fn (cl-letf (((symbol-function #'internal-temp-output-buffer-show)
(lambda (buffer)
(let ((temp-buffer-show-function
(lambda (&rest args)
(apply
#'doom-popup-display-buffer-stacked-side-window-fn
nil args)))) nil args))))
(with-current-buffer buffer (with-current-buffer buffer
(doom-popup-buffer-mode +1)) (doom-popup-buffer-mode 1))
(funcall internal-temp-output-buffer-show buffer))) (funcall internal-temp-output-buffer-show buffer)))))
(apply fn args)) (apply fn args)))
(apply fn args))) (apply fn args)))
(advice-add #'org-goto-location
:around #'doom-popup--org-fix-goto-a)
(defadvice! doom-popup--org-fix-popup-window-shrinking-a (fn &rest args) (defun doom-popup--org-fix-popup-window-shrinking-a (fn &rest args)
"Hides the mode-line in *Org tags* buffer so you can actually see its "Hides the mode-line in *Org tags* buffer so you can actually see its
content and displays it in a side window without deleting all other windows. content and displays it in a side window without deleting all other windows.
Ugh, such an ugly hack." Ugh, such an ugly hack."
:around #'org-fast-tag-selection
:around #'org-fast-todo-selection
(if doom-popup-mode (if doom-popup-mode
(letf! ((defun read-char-exclusive (&rest args) (cl-letf ((read-char-exclusive
(message nil) (symbol-function #'read-char-exclusive)))
(apply read-char-exclusive args)) (ignore read-char-exclusive)
(defun split-window-vertically (&optional _size) (cl-letf (((symbol-function #'read-char-exclusive)
(funcall split-window-vertically (- 0 window-min-height 1))) (lambda (&rest args) (message nil)
(defun org-fit-window-to-buffer (&optional window max-height min-height shrink-only) (apply read-char-exclusive args))))
(when-let (buf (window-buffer window)) (cl-letf ((split-window-vertically
(with-current-buffer buf (symbol-function #'split-window-vertically)))
(doom-popup-buffer-mode))) (ignore split-window-vertically)
(when (> (window-buffer-height window) (cl-letf (((symbol-function #'split-window-vertically)
(window-height window)) (lambda (&optional _size)
(fit-window-to-buffer window (window-buffer-height window))))) (funcall split-window-vertically
(apply fn args)) (- 0 window-min-height 1)))))
(cl-letf ((org-fit-window-to-buffer
(symbol-function #'org-fit-window-to-buffer)))
(ignore org-fit-window-to-buffer)
(cl-letf (((symbol-function #'org-fit-window-to-buffer)
(lambda (&optional window max-height
min-height shrink-only)
(when-let* ((buf (window-buffer window)))
(with-current-buffer buf
(doom-popup-buffer-mode)))
(when (> (window-buffer-height window)
(window-height window))
(fit-window-to-buffer
window
(window-buffer-height window))))))
(apply fn args)))))))
(apply fn args))) (apply fn args)))
(dolist (target (list #'org-fast-tag-selection
#'org-fast-todo-selection))
(advice-add target
:around #'doom-popup--org-fix-popup-window-shrinking-a))
(defadvice! doom-popup--org-edit-src-exit-a (fn &rest args) (defun doom-popup--org-edit-src-exit-a (fn &rest args)
"If you switch workspaces or the src window is recreated..." "If you switch workspaces or the src window is recreated..."
:around #'org-edit-src-exit
(let* ((window (selected-window)) (let* ((window (selected-window))
(popup-p (doom-popup-window-p window))) (popup-p (doom-popup-window-p window)))
(prog1 (apply fn args) (prog1 (apply fn args)
(when (and popup-p (window-live-p window)) (when (and popup-p (window-live-p window))
(delete-window window)))))) (delete-window window)))))
(advice-add #'org-edit-src-exit
:around #'doom-popup--org-edit-src-exit-a))
;;;###package org-journal ;;;###package org-journal
(with-eval-after-load 'org-journal (with-eval-after-load 'org-journal