From aabdb17f29216e03b9821fb99b57e9287ee46d6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?John=20Ankarstr=C3=B6m?= Date: Mon, 29 Aug 2022 22:56:33 +0200 Subject: eb.el: Improve window handling. --- eb.el | 158 +++++++++++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 103 insertions(+), 55 deletions(-) diff --git a/eb.el b/eb.el index 60df634..70bdde1 100644 --- a/eb.el +++ b/eb.el @@ -4,10 +4,86 @@ ;;; Code: +(require 'cl-lib) + (defgroup eb nil "Episode Browser development package." :prefix "eb-") +;; Disable ucs-utils for back-button-mode. +;; (when (equal system-type 'windows-nt) +;; (require 'ucs-utils) +;; (defun ucs-utils-char (name fallback &optional test) +;; (or (if (version< emacs-version "26") +;; (cdr (assoc-string name (ucs-names) t)) +;; (char-from-name name t)) +;; fallback))) + +;;;###autoload +(define-minor-mode eb--fleeting-minor-mode + "Minor mode for transient buffer selection pop-up windows." + :lighter "") + +(defmacro eb--fleeting-window (dir buffer &rest body) + (declare (indent defun)) + `(progn + (let ((buffer ,buffer) + (cwd default-directory)) + (if (equal buffer (window-buffer)) + (progn + (eb--fleeting-minor-mode -1) + (quit-window) + nil) + (when eb--fleeting-minor-mode + (eb--fleeting-minor-mode -1) + (quit-window)) + (display-buffer-in-direction buffer '((direction . ,dir))) + (select-window (get-buffer-window buffer)) + (with-current-buffer buffer + (setq default-directory cwd) + ,@body + (eb--fleeting-minor-mode) + (setq eb--fleeting--direction ',dir)) + (get-buffer-window buffer))))) + +(defvar eb--fleeting--buffer nil) +(defvar eb--fleeting--window nil) +(defvar-local eb--fleeting--direction nil) + +(defun eb--fleeting--main-window (&optional fleeting-buffer fleeting-window) + (setq fleeting-buffer (or fleeting-buffer (current-buffer))) + (setq fleeting-window (or fleeting-window (selected-window))) + (with-current-buffer fleeting-buffer + (let ((dir (cl-case eb--fleeting--direction + ('up 'below) + ('down 'above) + ('left 'right) + ('right 'left)))) + (window-in-direction dir fleeting-window)))) + +(defun eb--fleeting--pre-command-hook () + (setq eb--fleeting--buffer (and eb--fleeting-minor-mode (current-buffer))) + (setq eb--fleeting--window (and eb--fleeting-minor-mode (get-buffer-window)))) +(add-hook 'pre-command-hook #'eb--fleeting--pre-command-hook) + +(defun eb--fleeting--window-hook () + (when (and eb--fleeting--buffer + eb--fleeting--window) + (if (and (equal eb--fleeting--window (selected-window)) + (not (equal eb--fleeting--buffer (window-buffer)))) + (progn + (with-current-buffer eb--fleeting--buffer + (eb--fleeting-minor-mode -1)) + (bury-buffer eb--fleeting--buffer) + (let ((new-buffer (window-buffer))) + (select-window (eb--fleeting--main-window eb--fleeting--buffer eb--fleeting--window)) + (switch-to-buffer new-buffer)) + (delete-window eb--fleeting--window)) + (when (not (get-buffer-window eb--fleeting--buffer)) + (with-current-buffer eb--fleeting--buffer + (eb--fleeting-minor-mode -1)))))) +(add-hook 'window-configuration-change-hook #'eb--fleeting--window-hook) + ;;;###autoload (defun eb-quit-or-bury () "Quit window or bury buffer." @@ -30,20 +106,14 @@ "List project buffers. By default, only file buffers are shown." (interactive "P") (require 'projectile) - (if eb--list-buffers - (quit-window) - (let ((buffer - (list-buffers-noselect (not arg) - (when (and (not all) (projectile-project-p)) - (if arg - (projectile-project-buffers) - (mapcan - (lambda (b) (and (buffer-file-name b) (list b))) - (projectile-project-buffers))))))) - (display-buffer-in-direction buffer '((direction . up))) - (select-window (get-buffer-window buffer)) - (with-current-buffer buffer - (setq eb--list-buffers t))))) + (eb--fleeting-window up (list-buffers-noselect + (not arg) + (when (and (not all) (projectile-project-p)) + (if arg + (projectile-project-buffers) + (mapcan + (lambda (b) (and (buffer-file-name b) (list b))) + (projectile-project-buffers))))))) ;;;###autoload (defun eb-list-buffers-all (&optional arg) @@ -51,61 +121,39 @@ (interactive "P") (eb-list-buffers nil t)) -(define-advice Buffer-menu-mouse-select (:around (f event) eb-list-buffers) - (if eb--list-buffers - (progn - (select-window (posn-window (event-end event))) - (let ((buffer (tabulated-list-get-id (posn-point (event-end event))))) - (display-buffer buffer t) - (quit-window))) - (funcall f event))) - ;;;###autoload (defun eb-bookmarks () "Show bookmarks." (interactive) (require 'bookmark) - (if eb--bookmarks - (quit-window) - (bookmark-maybe-load-default-file) - (let ((buffer (get-buffer-create bookmark-bmenu-buffer))) - (display-buffer-in-direction buffer '((direction . up))) - (select-window (get-buffer-window buffer)) - (with-current-buffer buffer - (bookmark-bmenu-mode) - (bookmark-bmenu--revert) - (bookmark-bmenu-list) - (setq eb--bookmarks t))))) - -(define-advice bookmark-bmenu-this-window (:around (f) eb-bookmarks) - (if eb--bookmarks - (progn - (let ((window (selected-window))) - (bookmark-bmenu-other-window) - (quit-window nil window))) - (funcall f))) + (bookmark-maybe-load-default-file) + (eb--fleeting-window up (get-buffer-create bookmark-bmenu-buffer) + (bookmark-bmenu-mode) + (bookmark-bmenu--revert) + (bookmark-bmenu-list))) -(define-advice bookmark-bmenu-other-window-with-mouse (:around (f event) eb-list-buffers) - (funcall f event) - (when eb--bookmarks - (quit-window nil (posn-window (event-end event))))) +(defvar eb--dired-width nil) ;;;###autoload -(defun eb-dired (&optional dir) +(defun eb-dired (&optional arg dir) "Open the root of the current project in `dired'." - (interactive) + (interactive "P") (require 'projectile) - (when eb--list-buffers (quit-window)) (setq dir (or dir (projectile-project-root))) - (if (and (eq major-mode 'dired-mode) (equal default-directory dir)) - (bury-buffer) - (dired dir))) + (let ((fit-window-to-buffer-horizontally t) + (buffer (dired-noselect dir))) + (if arg + (switch-to-buffer buffer) + (eb--fleeting-window right buffer + (toggle-truncate-lines 1) + (message "") + (revert-buffer))))) ;;;###autoload -(defun eb-dired-here () +(defun eb-dired-here (&optional arg) "Open the current working directory in `dired'." - (interactive) - (eb-dired default-directory)) + (interactive "P") + (eb-dired arg default-directory)) ;;;###autoload (defun eb-grep () -- cgit v1.2.3