aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--eb.el158
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 ()