Refactor buffer functions & update tests

+ Split doom-buffer-list into doom-buffer-list
  & doom-project-buffer-list.
+ doom-real-buffers-list => doom-real-buffer-list (for naming
  consistency).
This commit is contained in:
Henrik Lissner 2017-06-27 01:49:04 +02:00
parent 3643d9e16d
commit 5ebda9b0c6
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
4 changed files with 138 additions and 102 deletions

View file

@ -42,35 +42,33 @@ Inspired from http://demonastery.org/2013/04/emacs-evil-narrow-region/"
;; Buffer Life and Death ;;;;;;;;;;;;;;; ;; Buffer Life and Death ;;;;;;;;;;;;;;;
;;;###autoload ;;;###autoload
(defun doom-buffer-list (&optional project-p) (defalias 'doom-buffer-list #'buffer-list)
"Get all buffers in the current project, in the current workspace.
If PROJECT-P is non-nil, get all buffers associated with the current project in
the current workspace."
(let ((buffers (if (and (featurep 'persp-mode) persp-mode)
(persp-buffer-list-restricted)
(buffer-list)))
(project-root (and project-p (doom-project-root t))))
(cond (project-root
(cl-loop for buf in buffers
if (projectile-project-buffer-p buf project-root)
collect buf))
(t
buffers))))
;;;###autoload ;;;###autoload
(defun doom-real-buffers-list (&optional buffer-list) (defun doom-project-buffer-list ()
"Get a list of all buffers (in the current workspace OR in BUFFER-LIST) that "Return a list of buffers belonging to the current project.
`doom-real-buffer-p' returns non-nil for."
If no project is active, return all buffers."
(let ((buffers (doom-buffer-list)))
(if-let (project-root (doom-project-root t))
(cl-loop for buf in buffers
if (projectile-project-buffer-p buf project-root)
collect buf)
buffers)))
;;;###autoload
(defun doom-real-buffer-list (&optional buffer-list)
"Return a list of buffers that satify `doom-real-buffer-p'."
(cl-loop for buf in (or buffer-list (doom-buffer-list)) (cl-loop for buf in (or buffer-list (doom-buffer-list))
if (doom-real-buffer-p buf) if (doom-real-buffer-p buf)
collect buf)) collect buf))
;;;###autoload ;;;###autoload
(defun doom-buffers-in-mode (modes &optional buffer-list derived-p) (defun doom-buffers-in-mode (modes &optional buffer-list derived-p)
"Get a list of all buffers (in the current workspace OR in BUFFER-LIST) whose "Return a list of buffers whose `major-mode' is `eq' to MODE(S).
`major-mode' is one of MODES."
(let ((modes (if (listp modes) modes (list modes)))) If DERIVED-P, test with `derived-mode-p', otherwise use `eq'."
(let ((modes (doom-enlist modes)))
(cl-remove-if-not (if derived-p (cl-remove-if-not (if derived-p
(lambda (buf) (lambda (buf)
(with-current-buffer buf (with-current-buffer buf
@ -81,32 +79,28 @@ the current workspace."
;;;###autoload ;;;###autoload
(defun doom-visible-windows (&optional window-list) (defun doom-visible-windows (&optional window-list)
"Get a list of the visible windows in the current frame (that aren't popups), "Return a list of the visible, non-popup windows."
OR return only the visible windows in WINDOW-LIST."
(cl-loop for win in (or window-list (window-list)) (cl-loop for win in (or window-list (window-list))
unless (doom-popup-p win) unless (doom-popup-p win)
collect win)) collect win))
;;;###autoload ;;;###autoload
(defun doom-visible-buffers (&optional buffer-list) (defun doom-visible-buffers (&optional buffer-list)
"Get a list of unburied buffers in the current project and workspace, OR "Return a list of visible buffers (i.e. not buried)."
return only the unburied buffers in BUFFER-LIST (a list of BUFFER-OR-NAMEs)."
(cl-loop for buf in (or buffer-list (doom-buffer-list)) (cl-loop for buf in (or buffer-list (doom-buffer-list))
when (get-buffer-window buf) when (get-buffer-window buf)
collect buf)) collect buf))
;;;###autoload ;;;###autoload
(defun doom-buried-buffers (&optional buffer-list) (defun doom-buried-buffers (&optional buffer-list)
"Get a list of buried buffers in the current project and workspace, OR return "Get a list of buffers that are buried."
only the buried buffers in BUFFER-LIST (a list of BUFFER-OR-NAMEs)."
(cl-loop for buf in (or buffer-list (doom-buffer-list)) (cl-loop for buf in (or buffer-list (doom-buffer-list))
unless (get-buffer-window buf) unless (get-buffer-window buf)
collect buf)) collect buf))
;;;###autoload ;;;###autoload
(defun doom-matching-buffers (pattern &optional buffer-list) (defun doom-matching-buffers (pattern &optional buffer-list)
"Get a list of all buffers (in the current workspace OR in BUFFER-LIST) that "Get a list of all buffers that match the regex PATTERN."
match the regex PATTERN."
(cl-loop for buf in (or buffer-list (doom-buffer-list)) (cl-loop for buf in (or buffer-list (doom-buffer-list))
when (string-match-p pattern (buffer-name buf)) when (string-match-p pattern (buffer-name buf))
collect buf)) collect buf))
@ -115,7 +109,7 @@ match the regex PATTERN."
"Switch to the next buffer N times (previous, if N < 0), skipping over unreal "Switch to the next buffer N times (previous, if N < 0), skipping over unreal
buffers. If there's nothing left, switch to `doom-fallback-buffer'. See buffers. If there's nothing left, switch to `doom-fallback-buffer'. See
`doom-real-buffer-p' for what 'real' means." `doom-real-buffer-p' for what 'real' means."
(let ((buffers (delq (current-buffer) (doom-real-buffers-list))) (let ((buffers (delq (current-buffer) (doom-real-buffer-list)))
(project-dir (doom-project-root))) (project-dir (doom-project-root)))
(cond ((or (not buffers) (cond ((or (not buffers)
(zerop (% n (1+ (length buffers))))) (zerop (% n (1+ (length buffers)))))
@ -123,13 +117,16 @@ buffers. If there's nothing left, switch to `doom-fallback-buffer'. See
((= (length buffers) 1) ((= (length buffers) 1)
(set-window-buffer nil (car buffers))) (set-window-buffer nil (car buffers)))
(t (t
(let ((move-func (if (> n 0) #'switch-to-next-buffer #'switch-to-prev-buffer))) ;; Why this instead of switching straight to the Nth buffer in
;; Why this instead of switching straight to the Nth buffer in ;; BUFFERS? Because `switch-to-next-buffer' and
;; BUFFERS? Because `switch-to-next-buffer' and ;; `switch-to-prev-buffer' properly update buffer list order.
;; `switch-to-prev-buffer' properly update buffer list order. (cl-loop with move-func =
(while (not (memq (current-buffer) buffers)) (if (> n 0) #'switch-to-next-buffer #'switch-to-prev-buffer)
(dotimes (_i (abs n)) for _i to 20
(funcall move-func)))))) while (not (memq (current-buffer) buffers))
do
(dotimes (_i (abs n))
(funcall move-func)))))
(when (eq (current-buffer) (doom-fallback-buffer)) (when (eq (current-buffer) (doom-fallback-buffer))
(cd project-dir)) (cd project-dir))
(current-buffer))) (current-buffer)))
@ -178,8 +175,8 @@ See `doom-real-buffer-p' for what 'real' means."
(yes-or-no-p "Buffer is unsaved, save it?")) (yes-or-no-p "Buffer is unsaved, save it?"))
(save-buffer) (save-buffer)
(set-buffer-modified-p nil)))) (set-buffer-modified-p nil))))
;; deal with dedicated windows
(if buffer-win (if buffer-win
;; deal with dedicated windows
(if (window-dedicated-p buffer-win) (if (window-dedicated-p buffer-win)
(unless (window--delete buffer-win t t) (unless (window--delete buffer-win t t)
(split-window buffer-win) (split-window buffer-win)
@ -192,8 +189,7 @@ See `doom-real-buffer-p' for what 'real' means."
(when only-buffer-window-p (when only-buffer-window-p
(kill-buffer buffer))) (kill-buffer buffer)))
(not (eq (current-buffer) buffer))) (not (eq (current-buffer) buffer)))
(kill-buffer buffer) (kill-buffer buffer)))))
(not (buffer-live-p buffer))))))
;;;###autoload ;;;###autoload
(defun doom-force-kill-buffer (&optional buffer dont-save) (defun doom-force-kill-buffer (&optional buffer dont-save)
@ -229,7 +225,6 @@ processes killed."
(or (not process-buffer) (or (not process-buffer)
(and (bufferp process-buffer) (and (bufferp process-buffer)
(not (buffer-live-p process-buffer))))) (not (buffer-live-p process-buffer)))))
(message "Killing %s" (process-name p))
(delete-process p) (delete-process p)
(cl-incf n)))) (cl-incf n))))
n)) n))
@ -239,32 +234,35 @@ processes killed."
"Kill all buffers (in current workspace OR in BUFFER-LIST) that match the "Kill all buffers (in current workspace OR in BUFFER-LIST) that match the
regex PATTERN. Returns the number of killed buffers." regex PATTERN. Returns the number of killed buffers."
(let ((buffers (doom-matching-buffers pattern buffer-list))) (let ((buffers (doom-matching-buffers pattern buffer-list)))
(mapc #'doom-kill-buffer buffers) (dolist (buf buffers (length buffers))
(length buffers))) (doom-kill-buffer buf t))))
;;;###autoload ;;;###autoload
(defun doom/kill-this-buffer () (defun doom/kill-this-buffer ()
"Uses `doom-kill-buffer' on the current buffer." "Use `doom-kill-buffer' on the current buffer."
(interactive) (interactive)
(when (and (doom-kill-buffer) (called-interactively-p 'interactive)) (when (and (doom-kill-buffer) (called-interactively-p 'interactive))
(message "Nowhere left to go!"))) (message "Nowhere left to go!")))
;;;###autoload ;;;###autoload
(defun doom/kill-all-buffers (&optional project-p) (defun doom/kill-all-buffers (&optional project-p)
"Kill all buffers in this workspace. If PROJECT-P, kill all buffers that "Kill all buffers.
belong to the current project in this workspace."
If PROJECT-P, kill all buffers that belong to the current project."
(interactive "P") (interactive "P")
(let ((buffers (doom-buffer-list project-p))) (let ((buffers (if project-p (doom-project-buffer-list) (doom-buffer-list))))
(mapc #'doom-kill-buffer-and-windows buffers) (mapc #'doom-kill-buffer-and-windows buffers)
(when (called-interactively-p 'interactive) (when (called-interactively-p 'interactive)
(message "Killed %s buffers" (length buffers))))) (message "Killed %s buffers" (length buffers)))))
;;;###autoload ;;;###autoload
(defun doom/kill-other-buffers (&optional project-p) (defun doom/kill-other-buffers (&optional project-p)
"Kill all other buffers in this workspace. If PROJECT-P, kill only the other "Kill all other buffers.
buffers that belong to the current project."
If PROJECT-P (universal argument), kill only the other buffers that belong to
the current project."
(interactive "P") (interactive "P")
(let ((buffers (doom-buffer-list project-p)) (let ((buffers (if project-p (doom-project-buffer-list) (doom-buffer-list)))
(current-buffer (current-buffer))) (current-buffer (current-buffer)))
(dolist (buf buffers) (dolist (buf buffers)
(unless (eq buf current-buffer) (unless (eq buf current-buffer)
@ -274,10 +272,14 @@ buffers that belong to the current project."
;;;###autoload ;;;###autoload
(defun doom/kill-matching-buffers (pattern &optional project-p) (defun doom/kill-matching-buffers (pattern &optional project-p)
"Kill buffers in current workspace that match regex PATTERN. If BANG, then "Kill buffers that match PATTERN in BUFFER-LIST.
exclude buffers that aren't part of the current project."
(interactive "sP") If PROJECT-P (universal argument), only kill matching buffers in the current
(let* ((buffers (doom-buffer-list project-p)) project."
(interactive
(list (read-regexp "Buffer pattern: ")
current-prefix-arg))
(let* ((buffers (if project-p (doom-project-buffer-list) (doom-buffer-list)))
(n (doom-kill-matching-buffers pattern buffers))) (n (doom-kill-matching-buffers pattern buffers)))
(when (called-interactively-p 'interactive) (when (called-interactively-p 'interactive)
(message "Killed %s buffers" n)))) (message "Killed %s buffers" n))))
@ -286,9 +288,10 @@ exclude buffers that aren't part of the current project."
(defun doom/cleanup-buffers (&optional all-p) (defun doom/cleanup-buffers (&optional all-p)
"Clean up buried and process buffers in the current workspace." "Clean up buried and process buffers in the current workspace."
(interactive "P") (interactive "P")
(let ((buffers (doom-buried-buffers (if all-p (buffer-list))))) (let ((buffers (doom-buried-buffers (if all-p (buffer-list))))
(n 0))
(mapc #'kill-buffer buffers) (mapc #'kill-buffer buffers)
(setq n (+ (doom-kill-process-buffers) (length buffers))) (setq n (+ n (length buffers) (doom-kill-process-buffers)))
(when (called-interactively-p 'interactive) (when (called-interactively-p 'interactive)
(message "Cleaned up %s buffers" n)))) (message "Cleaned up %s buffers" n))))

View file

@ -42,7 +42,7 @@
"Return t if this session should be killed, but not before it prompts the user "Return t if this session should be killed, but not before it prompts the user
for confirmation." for confirmation."
(interactive) (interactive)
(if (ignore-errors (doom-real-buffers-list)) (if (ignore-errors (doom-real-buffer-list))
(or (yes-or-no-p (format " %s" (or prompt "Quit Emacs?"))) (or (yes-or-no-p (format " %s" (or prompt "Quit Emacs?")))
(ignore (message "Aborted"))) (ignore (message "Aborted")))
t)) t))

View file

@ -7,16 +7,18 @@
(dolist (bsym buffer-args) (dolist (bsym buffer-args)
(push `(,bsym (get-buffer-create ,(symbol-name bsym))) (push `(,bsym (get-buffer-create ,(symbol-name bsym)))
buffers)) buffers))
`(let* (,@buffers `(save-window-excursion
(buffer-list (list ,@(reverse (mapcar #'car buffers))))) (cl-flet ((buffer-list (lambda () (list ,@(reverse (mapcar #'car buffers))))))
,@body (let* (persp-mode
(mapc #'kill-buffer buffer-list)))) ,@buffers)
,@body
(mapc #'kill-buffer (buffer-list)))))))
;; ;;
(def-test! get-buffers (def-test! get-buffers
(-with-temp-buffers! (a b c) (-with-temp-buffers! (a b c)
(should (cl-every #'buffer-live-p buffer-list)) (should (cl-every #'buffer-live-p (buffer-list)))
(should (equal buffer-list (list a b c))) (should (equal (buffer-list) (list a b c)))
(dolist (buf (list (cons a doom-emacs-dir) (dolist (buf (list (cons a doom-emacs-dir)
(cons b doom-emacs-dir) (cons b doom-emacs-dir)
(cons c "/tmp/"))) (cons c "/tmp/")))
@ -27,63 +29,60 @@
(let ((buffers (doom-buffer-list))) (let ((buffers (doom-buffer-list)))
(should (cl-every (lambda (x) (memq x buffers)) (list a b c)))) (should (cl-every (lambda (x) (memq x buffers)) (list a b c))))
;; should produce only project buffers ;; should produce only project buffers
(let ((buffers (doom-buffer-list t))) (let ((buffers (doom-project-buffer-list)))
(should (cl-every (lambda (x) (memq x buffers)) (list a b))) (should (cl-every (lambda (x) (memq x buffers)) (list a b)))
(should-not (memq c buffers)))) (should-not (memq c buffers))))
;; If no project is available, just get all buffers ;; If no project is available, just get all buffers
(with-current-buffer c (with-current-buffer c
(let ((buffers (doom-buffer-list t))) (let ((buffers (doom-project-buffer-list)))
(should (cl-every (lambda (x) (memq x buffers)) (list a b c))))))) (should (cl-every (lambda (x) (memq x buffers)) (list a b c)))))))
(def-test! get-real-buffers (def-test! real-buffers
(-with-temp-buffers! (a b c d) (let (doom-real-buffer-functions)
(dolist (buf (list a b)) (-with-temp-buffers! (a b c d)
(with-current-buffer buf (dolist (buf (list a b))
(setq-local buffer-file-name "x"))) (with-current-buffer buf
(with-current-buffer c (setq-local buffer-file-name "x")))
(rename-buffer "*C*")) (with-current-buffer c
(with-current-buffer d (rename-buffer "*C*"))
(doom-popup-mode +1)) (with-current-buffer d
(let ((buffers (doom-real-buffers-list buffer-list))) (doom-popup-mode +1))
(should (= (length buffers) 2)) (should (doom-real-buffer-p a))
(should (cl-every (lambda (x) (memq x buffers)) (list a b))) (should (doom-real-buffer-p b))
(should (cl-notany (lambda (x) (memq x buffers)) (list c d)))))) (should-not (doom-real-buffer-p c))
(should-not (doom-real-buffer-p d))
(let ((buffers (doom-real-buffer-list)))
(should (= (length buffers) 2))
(should (cl-every (lambda (x) (memq x buffers)) (list a b)))
(should (cl-notany (lambda (x) (memq x buffers)) (list c d)))))))
(def-test! kill-buffers ;; `doom-visible-windows'
(-with-temp-buffers! (a b) ;; `doom-visible-buffers'
(doom-kill-buffer a) ;; `doom-buried-buffers'
(should-not (buffer-live-p a)) (def-test! visible-buffers-and-windows
;; modified buffer
(with-current-buffer b
(set-buffer-modified-p t))
(doom-kill-buffer b t)
(should-not (buffer-live-p a))))
(def-test! kill-buffer-then-show-real-buffer
(-with-temp-buffers! (a b c d) (-with-temp-buffers! (a b c d)
(dolist (buf (list a b d))
(with-current-buffer buf
(setq-local buffer-file-name "x")))
(should (cl-every #'buffer-live-p buffer-list))
(switch-to-buffer a) (switch-to-buffer a)
(should (eq (current-buffer) a)) (should (eq (current-buffer) a))
(should (eq (selected-window) (get-buffer-window a))) (should (eq (selected-window) (get-buffer-window a)))
(should (doom-kill-buffer a)) (split-window)
(switch-to-buffer b)
(should (eq (current-buffer) b)) (should (eq (current-buffer) b))
(should (doom-kill-buffer)) (should (eq (selected-window) (get-buffer-window b)))
(should (eq (current-buffer) d)) (should (cl-intersection (list a b) (doom-visible-buffers)))
(doom/kill-this-buffer) (should (cl-intersection (list c d) (doom-buried-buffers)))
(should (eq (current-buffer) (doom-fallback-buffer))))) (should (cl-intersection (mapcar #'get-buffer-window (list a b))
(doom-visible-windows)))))
;; `doom-matching-buffers'
(def-test! matching-buffers (def-test! matching-buffers
(-with-temp-buffers! (a b c) (-with-temp-buffers! (a b c)
(let ((buffers (doom-matching-buffers "^[ac]$"))) (let ((buffers (doom-matching-buffers "^[ac]$")))
(should (= 2 (length buffers))) (should (= 2 (length buffers)))
(should (cl-every #'bufferp buffers)) (should (cl-every #'bufferp buffers))
(should (cl-every (lambda (x) (memq x buffers)) (list a c))) (should (cl-every (lambda (x) (memq x buffers)) (list a c)))
(should (equal (reverse buffers) (should (equal buffers (doom-matching-buffers "^[ac]$"))))))
(doom-matching-buffers "^[ac]$" buffer-list))))))
;; `doom-buffers-in-mode'
(def-test! buffers-in-mode (def-test! buffers-in-mode
(-with-temp-buffers! (a b c d e) (-with-temp-buffers! (a b c d e)
(dolist (buf (list a b)) (dolist (buf (list a b))
@ -97,3 +96,37 @@
(should (cl-every #'buffer-live-p (append el-buffers txt-buffers))) (should (cl-every #'buffer-live-p (append el-buffers txt-buffers)))
(should (= 2 (length el-buffers))) (should (= 2 (length el-buffers)))
(should (= 3 (length txt-buffers)))))) (should (= 3 (length txt-buffers))))))
;; `doom-kill-buffer'
(def-test! kill-buffer
(-with-temp-buffers! (a b)
(doom-kill-buffer a)
(should-not (buffer-live-p a))
;; modified buffer
(with-current-buffer b
(set-buffer-modified-p t))
(doom-kill-buffer b t)
(should-not (buffer-live-p a))))
;; `doom--cycle-real-buffers'
(def-test! kill-buffer-then-show-real-buffer
(-with-temp-buffers! (a b c d)
(dolist (buf (list a b d))
(with-current-buffer buf
(setq-local buffer-file-name "x")))
(should (cl-every #'buffer-live-p (buffer-list)))
(switch-to-buffer a)
(should (eq (current-buffer) a))
(should (eq (selected-window) (get-buffer-window a)))
(should (doom-kill-buffer a))
;; eventually end up in the fallback buffer
(let ((fallback (doom-fallback-buffer)))
(while (not (eq (current-buffer) fallback))
(should (doom-real-buffer-p))
(doom-kill-buffer))
(should (eq (current-buffer) fallback)))))
;; TODO doom/kill-all-buffers
;; TODO doom/kill-other-buffers
;; TODO doom/kill-matching-buffers
;; TODO doom/cleanup-buffers

View file

@ -83,7 +83,7 @@ renamed.")
"Delete workspace associated with current frame IF it has no real buffers." "Delete workspace associated with current frame IF it has no real buffers."
(when (and (string= (or (frame-parameter frame 'assoc-persp) "") (when (and (string= (or (frame-parameter frame 'assoc-persp) "")
(+workspace-current-name)) (+workspace-current-name))
(not (delq (doom-fallback-buffer) (doom-real-buffers-list)))) (not (delq (doom-fallback-buffer) (doom-real-buffer-list))))
(+workspace/delete persp-name))) (+workspace/delete persp-name)))
(add-hook 'delete-frame-functions #'+workspaces*delete-frame-and-persp) (add-hook 'delete-frame-functions #'+workspaces*delete-frame-and-persp)
@ -115,7 +115,7 @@ perspective-specific buffer list via `doom-buffer-list'."
(defun +workspaces*autosave-real-buffers (orig-fn &rest args) (defun +workspaces*autosave-real-buffers (orig-fn &rest args)
"Don't autosave if no real buffers are open." "Don't autosave if no real buffers are open."
(when (doom-real-buffers-list) (when (doom-real-buffer-list)
(apply orig-fn args)) (apply orig-fn args))
t) t)
(advice-add #'persp-asave-on-exit :around #'+workspaces*autosave-real-buffers)) (advice-add #'persp-asave-on-exit :around #'+workspaces*autosave-real-buffers))