eb.el: Improve window handling.

1 files 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 ()