aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorConstantine Vetoshev <gepardcv@gmail.com>2021-10-23 08:07:51 -0700
committerConstantine Vetoshev <gepardcv@gmail.com>2021-10-23 08:07:51 -0700
commit06e88e5d66e459d901d50ff620ad5e82410c3576 (patch)
treed3bdb6ad1c295223d434513eaf25618f38501c18
parentca6f778a3f1995600fc3d369bc636888812c80cc (diff)
parent7f0e35efc894e17c9852ac1a14fc927a6bf9e27f (diff)
Merge branch 'mehw-scratch_buffer_properly_create'
-rw-r--r--CHANGELOG.md70
-rw-r--r--perspective.el264
-rw-r--r--test/test-perspective.el1978
3 files changed, 2240 insertions, 72 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 26929a1..96f31a7 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -8,8 +8,78 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
## Unreleased
+### ERT tests added
+
+- `basic-persp-switch-to-scratch-buffer`: evaluate `persp-switch-to-scratch-buffer`.
+- `basic-persp-get-scratch-buffer`: test scratch buffers conformity and creation.
+- `basic-persp-forget-buffer`: evaluate `persp-forget-buffer`.
+- `basic-persp-killing-buffers`: test killing buffers, a perspective's last left live buffer should not be killable/removable.
+- `basic-persp-window-prev-buffers`: evaluate if `window-perv-buffers` gets buffers of other perspectives.
+- `basic-persp-set-buffer`: evaluate `persp-set-buffer`.
+- `basic-persp-add-buffer`: evaluate `persp-add-buffer`.
+- `basic-persp-get-buffer-names`: evaluate `persp-get-buffer-names`.
+- `basic-persp-get-buffers`: evaluate `persp-get-buffers`.
+- `basic-persp-test-buffer-in-persps`: evaluate `persp-test-buffer-in-persps`.
+- `persp-test-buffer-in-persps`: utility function to verify that a buffer is in specified perspectives only.
+- `baisc-persp-test-kill-extra-buffers`: evaluate `persp-test-kill-extra-buffers`
+- `persp-test-kill-extra-buffers`: utility function for cleaning up and killing extra buffers.
+- `basic-persp-test-match-scratch-buffers`: evaluate `persp-test-match-scratch-buffers`.
+- `persp-test-match-scratch-buffers`: utility function to list live scratch buffers.
+- `basic-persp-test-with-persp`: evaluate `persp-test-with-persp` macro.
+
+
+### ERT tests changed
+
+- `basic-persp-header-line-format-default-value`: remove leading tab.
+- `basic-persp-get-scratch-buffer`: evaluate `persp-get-scratch-buffer`.
+- `basic-persp-switching`: tests the `current-buffer` too.
+- `basic-persp-creation-deletion`: test killing all perspectives, main perspective included.
+- `persp-test-with-persp`: `unwind-protect` BODY to ensure a proper cleanup upon failures.
+- `persp-test-with-persp`: kill other perspectives than the main perspective when cleaning up.
+
+
+### ERT tests fixed
+
+- `persp-test-with-persp`: verify that a `*scratch* (NAME)` buffer exists before killing it.
+
+
+### Added
+
+- `persp-switch-to-scratch-buffer`: interactive function to switch to the current perspective's scratch buffer, creating one if missing.
+- `persp-get-scratch-buffer`: utility function to properly get/create a scratch buffer.
+- `persp-forget-buffer`: disassociate buffer with perspective without the risk of killing it. This balances `persp-add-buffer`. Newly created buffers via `get-buffer-create` are rogue buffers not found in any perspective, this function allows to get back to that state.
+- `persp-maybe-kill-buffer`: designed as `kill-buffer-query-functions` hook to keep a perspective's last left buffer from being killed.
+- `persp-get-buffer-names`: get any perspective's list of live buffers.
+- `persp-get-buffers`: get any perspective's list of buffers.
+
+
+### Changed
+
+- `perspective-map`: Add binding `C-x x B` to call `persp-switch-to-scratch-buffer`.
+- `persp-other-buffer`: call `persp-get-scratch-buffer` to get/create a scratch buffer.
+- `persp-new`: call `persp-get-scratch-buffer` to get/create a scratch buffer.
+- `persp-switch`: remove duplicated code. It's now possible to call `persp-new` either to get an existing perspective or to create a new one.
+- `persp-mode`: add/remove `persp-maybe-kill-buffer` hook.
+- `persp-kill`: switch `persp-maybe-kill-buffer` on/off to allow killing a perspective's last left buffer.
+- `persp-set-buffer`: walk perspectives rather than using a while `persp-buffer-in-other-p` loop, since the former isn't prone to infinite loops. This is needed due to buffers kept in perspectives by `persp-maybe-kill-buffer` and `persp-remove-buffer` when a buffer is a perspective`s last left buffer.
+- `persp-set-buffer`: use `persp-forget-buffer` to remove a buffer from a perspective.
+- `persp-maybe-kill-buffer`: use `persp-forget-buffer` to remove a buffer from a perspective.
+- `persp-remove-buffer`: use `persp-forget-buffer` to remove a buffer from a perspective.
+- `persp-remove-buffer`: do not kill/remove a perspective's last left buffer.
+- `persp-remove-buffer`: when burying a buffer, walk windows rather than using a while loop, since the former isn't prone to infinite loops.
+- `make-persp`: document that executing BODY saves/restores the `current-buffer`.
+- `persp-set-buffer`: follow the coding style of `persp-add-buffer`.
+
+
### Fixed
+- `persp-new`: enable `initial-major-mode` only if the scratch buffer is in `fundamental-mode`.
+- `persp-new`: properly substitute command keys when inserting `initial-scratch-message` into scratch buffers.
+- `persp-new`: do not recreate existing perspectives. This prevents from resetting perspectives to a state where in the perspective there's only the scratch buffer.
+- `persp-reset-windows`: set `switch-to-buffer-preserve-window-point` to `nil` before calling `delete-window`, that up to Emacs 27.2 updates `window-prev-buffers` of all windows, unless the former is turned off.
+- `persp-remove-buffer`: force update the `current-buffer` to the current window's buffer due to `with-selected-window` saving/restoring the `current-buffer` when executing it's BODY. This properly updates the `current-buffer` to what should be the real current buffer when burying the current buffer.
+- `persp-activate`: force update the `current-buffer` to the current window's buffer due to `make-persp` saving/restoring the `current-buffer` when executing it's BODY. This properly updates the `current-buffer` to what should be the real current buffer when switching to a new perspective.
+- `persp-add-buffer`: discard unexisting buffer as argument.
- Added a workaround for potential problems caused by recursive minibuffer use.
diff --git a/perspective.el b/perspective.el
index cc7be51..2939281 100644
--- a/perspective.el
+++ b/perspective.el
@@ -216,6 +216,29 @@ filtering in buffer display modes like ibuffer."
(unless initial-persp
(format " (%s)" name)))))
+(defun persp-get-scratch-buffer (&optional name)
+ "Return the \"*scratch* (NAME)\" buffer.
+Create it if the current perspective doesn't have one yet."
+ (let* ((scratch-buffer-name (persp-scratch-buffer name))
+ (scratch-buffer (get-buffer scratch-buffer-name)))
+ ;; Do not interfere with an existing scratch buffer's status.
+ (unless scratch-buffer
+ (setq scratch-buffer (get-buffer-create scratch-buffer-name))
+ (with-current-buffer scratch-buffer
+ (when (eq major-mode 'fundamental-mode)
+ (funcall initial-major-mode))
+ (when (and (zerop (buffer-size))
+ initial-scratch-message)
+ (insert (substitute-command-keys initial-scratch-message))
+ (set-buffer-modified-p nil))))
+ scratch-buffer))
+
+(defun persp-switch-to-scratch-buffer ()
+ "Switch to the current perspective's scratch buffer.
+Create the scratch buffer if there isn't one yet."
+ (interactive)
+ (switch-to-buffer (persp-get-scratch-buffer)))
+
(defalias 'persp-killed-p 'persp-killed
"Return whether the perspective CL-X has been killed.")
@@ -291,6 +314,7 @@ Run with the activated perspective active.")
(define-key perspective-map (kbd "a") 'persp-add-buffer)
(define-key perspective-map (kbd "A") 'persp-set-buffer)
(define-key perspective-map (kbd "b") 'persp-switch-to-buffer)
+(define-key perspective-map (kbd "B") 'persp-switch-to-scratch-buffer)
(define-key perspective-map (kbd "i") 'persp-import)
(define-key perspective-map (kbd "n") 'persp-next)
(define-key perspective-map (kbd "<right>") 'persp-next)
@@ -428,7 +452,12 @@ ARGS will be interpreted by `format-message'."
ARGS is a list of keyword arguments followed by an optional BODY.
The keyword arguments set the fields of the perspective struct.
If BODY is given, it is executed to set the window configuration
-for the perspective."
+for the perspective.
+
+Save point, and current buffer before executing BODY, and then
+restore them after. If the current buffer is changed in BODY,
+that change is lost when getting out, hence the current buffer
+will need to be changed again after calling `make-persp'."
(declare (indent defun))
(let ((keywords))
(while (keywordp (car args))
@@ -442,6 +471,9 @@ for the perspective."
,(when args
;; Body form given
`(save-excursion ,@args))
+ ;; If the `current-buffer' changes while in `save-excursion',
+ ;; that change isn't kept when getting out, since the current
+ ;; buffer is saved before executing BODY and restored after.
(run-hooks 'persp-created-hook))
persp)))
@@ -523,7 +555,15 @@ REQUIRE-MATCH can take the same values as in `completing-read'."
"Remove all windows, ensure the remaining one has no window parameters.
This prevents the propagation of reserved window parameters like
window-side creating perspectives."
- (let ((ignore-window-parameters t))
+ (let ((ignore-window-parameters t)
+ ;; Required up to Emacs 27.2 to prevent `delete-window' from
+ ;; updating `window-prev-buffers' for all windows. Allowing
+ ;; to create a fresh window (aka `split-window'), with empty
+ ;; `window-prev-buffers'. If the latter is not empty, other
+ ;; perspectives may pull in buffers of the current one, as a
+ ;; side effect when `persp-reactivate-buffers' is called and
+ ;; the perspective is then switched.
+ (switch-to-buffer-preserve-window-point nil))
(delete-other-windows)
(when (ignore-errors
;; Create a fresh window without any window parameters, the
@@ -535,15 +575,13 @@ window-side creating perspectives."
(delete-window))))
(defun persp-new (name)
- "Return a new perspective with name NAME.
+ "Return a perspective named NAME, or create a new one if missing.
The new perspective will start with only an `initial-major-mode'
buffer called \"*scratch* (NAME)\"."
- (make-persp :name name
- (switch-to-buffer (persp-scratch-buffer name))
- (funcall initial-major-mode)
- (when initial-scratch-message
- (insert initial-scratch-message))
- (persp-reset-windows)))
+ (or (gethash name (perspectives-hash))
+ (make-persp :name name
+ (switch-to-buffer (persp-get-scratch-buffer name))
+ (persp-reset-windows))))
(defun persp-reactivate-buffers (buffers)
"Raise BUFFERS to the top of the most-recently-selected list.
@@ -673,10 +711,8 @@ If NORECORD is non-nil, do not update the
(unless (persp-valid-name-p name)
(setq name (persp-prompt (and (persp-last) (persp-name (persp-last))))))
(if (and (persp-curr) (equal name (persp-current-name))) name
- (let ((persp (gethash name (perspectives-hash))))
+ (let ((persp (persp-new name)))
(set-frame-parameter nil 'persp--last (persp-curr))
- (when (null persp)
- (setq persp (persp-new name)))
(unless norecord
(run-hooks 'persp-before-switch-hook))
(persp-activate persp)
@@ -714,6 +750,8 @@ If NORECORD is non-nil, do not update the
(when (marker-position (persp-point-marker persp))
(goto-char (persp-point-marker persp)))
(persp-update-modestring)
+ ;; force update of `current-buffer'
+ (set-buffer (window-buffer))
(run-hooks 'persp-activated-hook))
(defun persp-switch-quick (char)
@@ -777,31 +815,36 @@ create a new main perspective and return \"main\"."
:point-marker (point-marker)))
persp-initial-frame-name)))
-(defun persp-add-buffer (buffer)
- "Associate BUFFER with the current perspective.
+(defun persp-add-buffer (buffer-or-name)
+ "Associate BUFFER-OR-NAME with the current perspective.
See also `persp-switch' and `persp-remove-buffer'."
(interactive
(list
(let ((read-buffer-function nil))
(read-buffer "Add buffer to perspective: "))))
- (let ((buffer (get-buffer buffer)))
- (unless (persp-is-current-buffer buffer)
- (push buffer (persp-current-buffers)))))
-
-(defun persp-set-buffer (buffer-name)
- "Associate BUFFER-NAME with the current perspective and remove it from any other."
+ (let ((buffer (get-buffer buffer-or-name)))
+ (if (not (buffer-live-p buffer))
+ (message "buffer %s doesn't exist" buffer-or-name)
+ (unless (persp-is-current-buffer buffer)
+ (push buffer (persp-current-buffers))))))
+
+(defun persp-set-buffer (buffer-or-name)
+ "Associate BUFFER-OR-NAME with the current perspective and remove it from any other."
(interactive
(list
(let ((read-buffer-function nil))
(read-buffer "Set buffer to perspective: "))))
- (cond ((get-buffer buffer-name)
- (persp-add-buffer buffer-name)
- (cl-loop for other-persp = (persp-buffer-in-other-p (get-buffer buffer-name))
- while other-persp
- do (with-perspective (cdr other-persp)
- (persp-remove-buffer buffer-name))))
- (t (message "buffer %s doesn't exist" buffer-name))))
+ (let ((buffer (get-buffer buffer-or-name)))
+ (if (not (buffer-live-p buffer))
+ (message "buffer %s doesn't exist" buffer-or-name)
+ (persp-add-buffer buffer)
+ ;; Do not use the combination "while `persp-buffer-in-other-p'",
+ ;; if the buffer is not removed from other perspectives, it will
+ ;; go into an infinite loop.
+ (cl-loop for other-persp in (remove (persp-current-name) (persp-all-names))
+ do (with-perspective other-persp
+ (persp-forget-buffer buffer))))))
(cl-defun persp-buffer-in-other-p (buffer)
"Returns nil if BUFFER is only in the current perspective.
@@ -832,28 +875,124 @@ Prefers perspectives in the selected frame."
(persp-switch (cdr other-persp)))
(switch-to-buffer buffer)))))
-(defun persp-remove-buffer (buffer)
+(defun persp-maybe-kill-buffer ()
+ "Don't kill a buffer if it's the only buffer in a perspective.
+
+This is the default behaviour of `kill-buffer'. Perspectives
+with only one buffer should keep it alive to prevent adding a
+buffer from another perspective, replacing the killed buffer.
+
+Will also cleanup killed buffers form each perspective's list
+of buffers containing the buffer to be killed.
+
+This is a hook for `kill-buffer-query-functions'. Don't call
+this directly, otherwise the current buffer may be removed or
+killed from perspectives.
+
+See also `persp-remove-buffer'."
+ ;; List candidates where the buffer to be killed should be removed
+ ;; instead, whom are perspectives with more than one buffer. This
+ ;; is to allow the buffer to live for perspectives that have it as
+ ;; their only buffer.
+ (persp-protect
+ (let* ((buffer (current-buffer))
+ (bufstr (buffer-name buffer))
+ candidates-for-removal candidates-for-keeping)
+ (dolist (name (persp-names))
+ (let ((buffer-names (persp-get-buffer-names name)))
+ (when (member bufstr buffer-names)
+ (if (cdr buffer-names)
+ (push name candidates-for-removal)
+ ;; We use a list for debugging purposes, a simple bool
+ ;; can suffice for what we are doing here.
+ (push name candidates-for-keeping)))))
+ (cond
+ ;; When there aren't perspectives with the buffer as the only
+ ;; buffer, it can be killed safely. Also cleanup killed ones
+ ;; found in perspectives listing the buffer to be killed.
+ ((not candidates-for-keeping)
+ ;; Switching to a perspective that isn't the current, should
+ ;; automatically cleanup previously killed buffers which are
+ ;; still in the perspective's list of buffers. Removing the
+ ;; buffer to be killed should also keep the list clean.
+ (dolist (name candidates-for-removal)
+ (with-perspective name
+ ;; remove the buffer that has to be killed from the list
+ (setf (persp-current-buffers) (remq buffer (persp-current-buffers)))))
+ t)
+ ;; When a perspective have the buffer as the only buffer, the
+ ;; buffer should not be killed, but removed from perspectives
+ ;; that have more than one buffer. Those perspectives should
+ ;; forget about the buffer.
+ (candidates-for-removal
+ (dolist (name candidates-for-removal)
+ (with-perspective name
+ (persp-forget-buffer buffer)))
+ nil)))))
+
+(defun persp-forget-buffer (buffer)
"Disassociate BUFFER with the current perspective.
+If BUFFER isn't in any perspective, then it is in limbo.
+
+See also `persp-add-buffer' and `persp-remove-buffer'."
+ (interactive
+ (list (funcall persp-interactive-completion-function "Disassociate buffer with perspective: " (persp-current-buffer-names))))
+ (setq buffer (when buffer (get-buffer buffer)))
+ (cond ((not (buffer-live-p buffer)))
+ ;; Do not disassociate a perspective's last left buffer or one
+ ;; that's not part of the current perspective.
+ ((or (not (persp-is-current-buffer buffer))
+ (and (memq 'persp-maybe-kill-buffer kill-buffer-query-functions)
+ (not (remove (buffer-name buffer) (persp-current-buffer-names)))))
+ (setq buffer nil))
+ ;; Make the buffer go away if we can see it.
+ ((let (buffer-in-any-window)
+ (walk-windows (lambda (window)
+ (when (eq buffer (window-buffer window))
+ (setq buffer-in-any-window t)
+ ;; Burying the current buffer should also
+ ;; act as an `unrecord-window-buffer'.
+ (with-selected-window window (bury-buffer)))))
+ (let ((window (get-buffer-window buffer)))
+ (when window
+ (error "Buried buffer %s found in window %s, but it shouldn't"
+ buffer window)))
+ ;; `with-selected-window' restores the `current-buffer'.
+ ;; If the current buffer is buried, it should not be the
+ ;; next current buffer. Remember to fix it later.
+ buffer-in-any-window))
+ (t (bury-buffer buffer)))
+ ;; If the `current-buffer' was buried in `with-selected-window', set
+ ;; the real current buffer, since `with-selected-window' restored it
+ ;; as the next current buffer after processing its body.
+ (set-buffer (window-buffer))
+ (setf (persp-current-buffers) (remq buffer (persp-current-buffers))))
+
+(defun persp-remove-buffer (buffer)
+ "Remove BUFFER from the current perspective.
+Kill BUFFER if it falls into limbo (not in any perspective).
+
+To disassociate BUFFER without the chance of killing it, see
+`persp-forget-buffer'.
See also `persp-switch' and `persp-add-buffer'."
(interactive
(list (funcall persp-interactive-completion-function "Remove buffer from perspective: " (persp-current-buffer-names))))
(setq buffer (when buffer (get-buffer buffer)))
(cond ((not (buffer-live-p buffer)))
- ;; Only kill the buffer if no other perspectives are using it
+ ;; Do not kill or remove a buffer if the perspective will then
+ ;; switch to the buffer of another perspective. It may happen
+ ;; when the buffer is the perspective's last left buffer or if
+ ;; the next candidate is a perspective's special buffer. This
+ ;; could not be enforced when a perspective is killed.
+ ((and (persp-is-current-buffer buffer)
+ (memq 'persp-maybe-kill-buffer kill-buffer-query-functions)
+ (not (remove (buffer-name buffer) (persp-current-buffer-names)))))
+ ;; Only kill the buffer if no other perspectives are using it.
((not (persp-buffer-in-other-p buffer))
(kill-buffer buffer))
;; Make the buffer go away if we can see it.
- ((get-buffer-window buffer)
- (let ((window (get-buffer-window buffer)))
- (while window
- (with-selected-window window (bury-buffer))
- (let ((new-window (get-buffer-window buffer)))
- ;; If `window' is still selected even after being buried, exit
- ;; the loop because otherwise it will go on infinitely.
- (setq window (unless (eq window new-window) new-window))))))
- (t (bury-buffer buffer)))
- (setf (persp-current-buffers) (remq buffer (persp-current-buffers))))
+ ((persp-forget-buffer buffer))))
(defun persp-kill (name)
"Kill the perspective given by NAME.
@@ -862,10 +1001,12 @@ Killing a perspective means that all buffers associated with that
perspective and no others are killed."
(interactive "i")
(if (null name) (setq name (persp-prompt (persp-current-name) t)))
+ (remove-hook 'kill-buffer-query-functions 'persp-maybe-kill-buffer)
(with-perspective name
(run-hooks 'persp-killed-hook)
(mapc 'persp-remove-buffer (persp-current-buffers))
(setf (persp-killed (persp-curr)) t))
+ (add-hook 'kill-buffer-query-functions 'persp-maybe-kill-buffer)
(remhash name (perspectives-hash))
(when (boundp 'persp--xref-marker-ring) (remhash name persp--xref-marker-ring))
(persp-update-modestring)
@@ -933,6 +1074,45 @@ copied across frames."
(let ((persp (gethash name (perspectives-hash))))
(if persp (cl-return-from persp-all-get (persp-buffers persp))))))))
+(defun persp-get-buffers (&optional persp-or-name frame)
+ "Return the list of PERSP-OR-NAME buffers in FRAME.
+If PERSP-OR-NAME isn't given or nil use the current perspective.
+If FRAME isn't nil, fetch PERSP-OR-NAME in FRAME, otherwise stay
+in the selected frame.
+
+Uses `persp-current-buffers' as backhand.
+
+See also `persp-get-buffer-names' to get only live buffers. See
+`persp-all-get' to get buffers from all frames."
+ (let ((name (if (stringp persp-or-name)
+ persp-or-name
+ (persp-name (or persp-or-name (persp-curr)))))
+ buffers)
+ (with-selected-frame (or frame (selected-frame))
+ (when (member name (persp-names))
+ (with-perspective name
+ (setq buffers (persp-current-buffers)))))
+ buffers))
+
+(defun persp-get-buffer-names (&optional persp-or-name frame)
+ "Return the list of PERSP-OR-NAME live buffers in FRAME.
+If PERSP-OR-NAME isn't given or nil use the current perspective.
+If FRAME isn't nil, fetch PERSP-OR-NAME in FRAME, otherwise stay
+in the selected frame.
+
+Uses `persp-current-buffer-names' as backhand.
+
+See also `persp-get-buffers' to get all buffers."
+ (let ((name (if (stringp persp-or-name)
+ persp-or-name
+ (persp-name (or persp-or-name (persp-curr)))))
+ buffers)
+ (with-selected-frame (or frame (selected-frame))
+ (when (member name (persp-names))
+ (with-perspective name
+ (setq buffers (persp-current-buffer-names)))))
+ buffers))
+
(defun persp-read-buffer (prompt &optional def require-match predicate)
"A replacement for the built-in `read-buffer', meant to be used with `read-buffer-function'.
Return the name of the buffer selected, only selecting from buffers
@@ -1094,6 +1274,7 @@ named collections of buffers and window configurations."
(add-hook 'after-make-frame-functions 'persp-init-frame)
(add-hook 'delete-frame-functions 'persp-delete-frame)
(add-hook 'ido-make-buffer-list-hook 'persp-set-ido-buffers)
+ (add-hook 'kill-buffer-query-functions 'persp-maybe-kill-buffer)
(setq read-buffer-function 'persp-read-buffer)
(mapc 'persp-init-frame (frame-list))
(setf (persp-current-buffers) (buffer-list))
@@ -1103,6 +1284,7 @@ named collections of buffers and window configurations."
(remove-hook 'delete-frame-functions 'persp-delete-frame)
(remove-hook 'after-make-frame-functions 'persp-init-frame)
(remove-hook 'ido-make-buffer-list-hook 'persp-set-ido-buffers)
+ (remove-hook 'kill-buffer-query-functions 'persp-maybe-kill-buffer)
(setq read-buffer-function nil)
(set-frame-parameter nil 'persp--hash nil)
(setq global-mode-string (delete '(:eval (persp-mode-line)) global-mode-string))
@@ -1221,12 +1403,12 @@ perspective beginning with the given letter."
"A version of `other-buffer' which respects perspectives."
(let ((other (other-buffer buffer visible-ok frame)))
(if (member other (persp-current-buffers))
- other
+ other
;; In cases where `other-buffer' produces a buffer that is not
;; part of the current perspective, select the current
;; perspective's *scratch* buffer, similar to the behaviour of
;; `other-buffer'.
- (get-buffer-create (persp-scratch-buffer)))))
+ (persp-get-scratch-buffer))))
;;; --- perspective-aware buffer switchers
diff --git a/test/test-perspective.el b/test/test-perspective.el
index d614d55..f581a9a 100644
--- a/test/test-perspective.el
+++ b/test/test-perspective.el
@@ -38,6 +38,76 @@ perspectives), filtering out temporaries."
filtering out temporaries."
(cl-remove-if-not #'persp-test-interesting-buffer? (persp-buffers persp)))
+(defun persp-test-match-scratch-buffers (&rest buffer-or-name)
+ "Return a list of buffers that are considered *scratch* buffers.
+If not nil, verify that BUFFER-OR-NAME are all the buffers that
+are in the list of buffers or return nil otherwise. Return nil
+if there are no *scratch* buffers to be found.
+
+Consider buffers being *scratch* buffers when their name begins
+with \"*scratch*\". Sort the list by names via `string-lessp'."
+ (let ((scratch-buffers (mapcar #'get-buffer buffer-or-name))
+ (matched-buffers (cl-remove-if-not
+ (lambda (buffer)
+ (string-match-p "^\\*scratch\\*.*$" (buffer-name buffer)))
+ (buffer-list))))
+ (when (cl-every (lambda (buffer)
+ (memq buffer matched-buffers))
+ scratch-buffers)
+ (sort matched-buffers
+ (lambda (a b)
+ (string-lessp (buffer-name a) (buffer-name b)))))))
+
+(defun persp-test-kill-extra-buffers (&rest buffer-or-name)
+ "Kill BUFFER-OR-NAME and extra scratch buffers found.
+Return a list of names of the killed buffers, or nil if there's
+no candidate to kill.
+
+Extra scratch buffers have a name that begins with \"*scratch*\",
+like \"*scratch* \" and \"*scratch* (NAME)\"."
+ (let* (kill-list-names
+ (scratch-buffer (get-buffer "*scratch*"))
+ (extra-buffers (mapcar #'get-buffer buffer-or-name))
+ (matched-buffers (remq scratch-buffer (persp-test-match-scratch-buffers))))
+ (dolist (buffer (cl-remove-duplicates (append extra-buffers matched-buffers)))
+ (when (buffer-live-p buffer)
+ (push (buffer-name buffer) kill-list-names)
+ (kill-buffer buffer)))
+ (sort kill-list-names #'string-lessp)))
+
+(defun persp-test-buffer-in-persps (buffer-or-name &rest persp-or-name)
+ "Return the buffer BUFFER-OR-NAME when live and found in each of
+PERSP-OR-NAME, and, at the same time, not in any other existing
+perspective that is not PERSP-OR-NAME. Otherwise return nil.
+
+If PERSP-OR-NAME is nil or not given, BUFFER-OR-NAME should not
+be found in any existing perspective. Otherwise return nil.
+
+PERSP-OR-NAME may be a perspective's name or a perspective data
+object `perspective-p', if the latter it may even not exist."
+ (let (whitelist
+ (persps (hash-table-values (perspectives-hash)))
+ (buffer (when buffer-or-name (get-buffer buffer-or-name))))
+ (catch 'result
+ (unless (and buffer (buffer-live-p buffer))
+ (throw 'result nil))
+ ;; whitelist
+ (dolist (persp persp-or-name)
+ (when (stringp persp)
+ ;; resolve a perspective's name to its data
+ (setq persp (cl-find-if (lambda (p)
+ (equal persp (persp-name p)))
+ persps)))
+ (unless (and (perspective-p persp)
+ (memq buffer (persp-buffers persp)))
+ (throw 'result nil))
+ (push persp whitelist))
+ ;; blacklist
+ (dolist (persp (cl-set-difference persps whitelist))
+ (when (memq buffer (persp-buffers persp))
+ (throw 'result nil)))
+ (throw 'result buffer))))
+
(defmacro persp-test-with-persp (&rest body)
"Allow multiple tests to run with reasonable assumption of
isolation. This macro assumes persp-mode is turned off, then
@@ -46,13 +116,26 @@ perspectives and open buffers."
(declare (indent 0))
`(progn
(persp-mode 1)
- ,@body
- ;; get rid of perspective-specific *scratch* buffers first
- (mapc (lambda (persp)
- (kill-buffer (format "*scratch* (%s)" persp)))
- (delete persp-initial-frame-name (persp-names)))
- (persp-mode -1)
- (mapc #'kill-buffer (persp-test-buffer-list-all))))
+ (unwind-protect
+ (progn ,@body)
+ (let ((other-persps (delete persp-initial-frame-name (persp-names))))
+ ;; Kill other perspectives than the main perspective to get rid
+ ;; of buffers that are not found in the main perspective.
+ (mapc #'persp-kill other-persps)
+ ;; Then get rid of perspective-specific *scratch* buffers which
+ ;; have become part of the main perspective.
+ (mapc (lambda (persp)
+ ;; `get-buffer' should suffice here, there's no need to
+ ;; also call `buffer-live-p' when a string is passed as
+ ;; argument to the former, but we do it anyway ;)
+ (let* ((scratch-name (format "*scratch* (%s)" persp))
+ (scratch-buffer (get-buffer scratch-name)))
+ (when (buffer-live-p scratch-buffer)
+ (kill-buffer scratch-buffer))))
+ other-persps))
+ (persp-mode -1)
+ ;; Remove live buffers that are not temporaries.
+ (mapc #'kill-buffer (persp-test-buffer-list-all)))))
(defmacro persp-test-with-temp-buffers (vars &rest body)
"Bind temporary buffers to VARS, evaluate BODY, then kill
@@ -129,6 +212,404 @@ deleted at cleanup."
;; no buffers should be open after all this
(should (= 0 (length (persp-test-buffer-list-all)))))
+(ert-deftest basic-persp-test-with-persp ()
+ "Test `persp-test-with-persp'.
+
+When cleaning up, don't assume there's a \"*scratch* (NAME)\" for
+every perspective NAME still existing before the cleanup. That
+may cause `kill-buffer' to fail passing a non-existent buffer.
+
+Buffers like \"*dummy* (NAME)\" should not be killed just because
+they follow the pattern \"*scratch* (NAME)\".
+
+Buffers should always be killed when only found in perspectives
+that are not the main perspective."
+ (unwind-protect
+ (persp-test-with-persp
+ ;; Summary before exiting `persp-test-with-persp':
+ ;;
+ ;; main: *dummy*, *dummy* (A), *scratch*, *scratch* (A), *scratch* (C)
+ ;; A: *dummy* (A)
+ ;; B: *dummy* (B)
+ ;; C is killed before the cleanup
+ ;; D: *scratch* (D)
+ ;;
+ ;; Expected buffers after `persp-test-with-persp' cleanup:
+ ;;
+ ;; *dummy*, *dummy* (A), *scratch*, *scratch* (C)
+ ;;
+ ;; *scratch* (A) is killed during cleanup, because perspective
+ ;; A exists before the cleanup, instead *scratch* (C) will not
+ ;; be killed, because perspective C has been killed before the
+ ;; cleanup. There should be no attempt killing *scratch* (B),
+ ;; since it's non-existent and *scratch* (D) is killed killing
+ ;; perspective D. *dummy* (A) persists, it is shared with the
+ ;; main perspective, instead *dummy* (B) is killed killing the
+ ;; perspective B, it's not shared with the main perspective.
+ (let ((dummy-buffer (get-buffer-create "*dummy*"))
+ (dummy-buffer-A (get-buffer-create "*dummy* (A)"))
+ (dummy-buffer-B (get-buffer-create "*dummy* (B)")))
+ (should persp-mode)
+ (should (buffer-live-p dummy-buffer))
+ (should (buffer-live-p dummy-buffer-A))
+ (should (buffer-live-p dummy-buffer-B))
+ (should (get-buffer-create "*scratch*"))
+ (persp-set-buffer (get-buffer "*scratch*"))
+ (persp-switch "A")
+ (persp-set-buffer dummy-buffer-A)
+ (should (get-buffer "*scratch* (A)"))
+ (persp-switch "B")
+ (persp-set-buffer dummy-buffer-B)
+ (should (get-buffer "*scratch* (B)"))
+ (persp-switch "C")
+ (persp-set-buffer dummy-buffer)
+ (should (get-buffer "*scratch* (C)"))
+ (persp-switch "D")
+ (should (get-buffer "*scratch* (D)"))
+ (persp-switch "main")
+ (persp-add-buffer dummy-buffer)
+ (persp-add-buffer dummy-buffer-A)
+ (should (kill-buffer "*scratch* (B)"))
+ (should-not (get-buffer "*scratch* (B)"))
+ (persp-set-buffer (get-buffer "*scratch* (A)"))
+ (persp-set-buffer (get-buffer "*scratch* (C)"))
+ (persp-kill "C")))
+ (should-not persp-mode)
+ ;; Buffers found only in the main perspective or shared with main.
+ (should (get-buffer "*dummy*"))
+ (should (get-buffer "*scratch*"))
+ (should (get-buffer "*dummy* (A)"))
+ ;; Buffers found in the main perspective while perspective NAME is
+ ;; killed before the cleanup.
+ (should (get-buffer "*scratch* (C)"))
+ ;; Buffers found in the main perspective while perspective NAME is
+ ;; alive before the cleanup.
+ (should-not (get-buffer "*scratch* (A)"))
+ ;; Buffers found only in other perspectives than main perspective.
+ (should-not (get-buffer "*dummy* (B)"))
+ (should-not (get-buffer "*scratch* (D)"))
+ ;; Buffers manually killed but perspective NAME is kept alive till
+ ;; the cleanup.
+ (should-not (get-buffer "*scratch* (B)"))
+ ;; Reset state.
+ (should (kill-buffer "*dummy*"))
+ (should-not (get-buffer "*dummy*"))
+ (should (kill-buffer "*dummy* (A)"))
+ (should-not (get-buffer "*dummy* (A)"))
+ (should (kill-buffer "*scratch* (C)"))
+ (should-not (get-buffer "*scratch* (C)"))))
+
+(ert-deftest basic-persp-test-match-scratch-buffers ()
+ "Test `persp-test-match-scratch-buffers'.
+
+Expect a list of live buffers that may be considered *scratch*
+buffers, aka the buffer's name begins with \"*scratch*\", or nil
+if there's none.
+
+When providing buffer or buffer's name arguments, them should
+include exactly what the function would find. Repetition and
+order do not matter. If just one argument isn't a candidate,
+return nil."
+ (let (matched-buffers dummy-buffer scratch-buffer scratch-buffer-A)
+ ;; Cleanup *scratch* buffers.
+ (mapc (lambda (buffer)
+ (when (string-match-p "^\\*scratch\\*.*$" (buffer-name buffer))
+ (kill-buffer buffer)))
+ (buffer-list))
+ ;; Match live *scratch* buffers.
+ (persp-test-with-persp
+ (should (setq dummy-buffer (get-buffer-create "*dummy*")))
+ (should (setq scratch-buffer (get-buffer-create "*scratch*")))
+ ;; get a list of all live *scratch* buffers
+ (should (setq matched-buffers (list scratch-buffer)))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers)))
+ ;; verify that all arguemnts meet the criteria
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch*")))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers scratch-buffer)))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch*" scratch-buffer)))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers scratch-buffer "*scratch*")))
+ ;; verify that the matching criteria cannot be subverted
+ (should-not (persp-test-match-scratch-buffers "*dummy*"))
+ (should-not (persp-test-match-scratch-buffers dummy-buffer))
+ (should-not (persp-test-match-scratch-buffers "*scratch* "))
+ (should-not (persp-test-match-scratch-buffers "*scratch*" "*dummy*"))
+ (should-not (persp-test-match-scratch-buffers "*dummy*" "*scratch*"))
+ (should-not (persp-test-match-scratch-buffers "*scratch*" "*scratch* "))
+ (should-not (persp-test-match-scratch-buffers "*scratch* " "*scratch*"))
+ (should-not (persp-test-match-scratch-buffers scratch-buffer dummy-buffer))
+ (should-not (persp-test-match-scratch-buffers dummy-buffer scratch-buffer))
+ (should-not (persp-test-match-scratch-buffers "*scratch*" "*scratch* " "*scratch*"))
+ (should (kill-buffer dummy-buffer))
+ (should-not (get-buffer "*dummy*"))
+ (should-not (buffer-live-p dummy-buffer))
+ (should-not (persp-test-match-scratch-buffers dummy-buffer))
+ (should-not (persp-test-match-scratch-buffers scratch-buffer dummy-buffer))
+ (should-not (persp-test-match-scratch-buffers dummy-buffer scratch-buffer))
+ (should (get-buffer-create "*scratch* "))
+ (setq matched-buffers (list scratch-buffer (get-buffer "*scratch* ")))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch*" "*scratch* ")))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch* " "*scratch*")))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch*" "*scratch* " "*scratch*"))))
+ ;; Cleanup *scratch* buffers.
+ (mapc (lambda (buffer)
+ (when (string-match-p "^\\*scratch\\*.*$" (buffer-name buffer))
+ (kill-buffer buffer)))
+ (buffer-list))
+ ;; Match live *scratch* buffers.
+ (persp-test-with-persp
+ (persp-new "A")
+ (should (setq scratch-buffer (get-buffer-create "*scratch*")))
+ (should (setq scratch-buffer-A (get-buffer "*scratch* (A)")))
+ ;; get a list of all live *scratch* buffers
+ (should (setq matched-buffers (list scratch-buffer scratch-buffer-A)))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers)))
+ ;; verify that all arguemnts meet the criteria
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch*" "*scratch* (A)")))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch* (A)" "*scratch*")))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A)))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers scratch-buffer-A "*scratch* (A)" scratch-buffer "*scratch*")))
+ ;; verify that the matching criteria cannot be subverted
+ (should-not (persp-test-match-scratch-buffers "*scratch*" "*scratch* " "*scratch* (A)"))
+ (should (get-buffer-create "*scratch* "))
+ (setq matched-buffers (list scratch-buffer (get-buffer "*scratch* ") scratch-buffer-A))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch*" "*scratch* " "*scratch* (A)")))
+ (should (equal matched-buffers (persp-test-match-scratch-buffers "*scratch* (A)" "*scratch*" "*scratch* "))))
+ ;; Cleanup *scratch* buffers.
+ (mapc (lambda (buffer)
+ (when (string-match-p "^\\*scratch\\*.*$" (buffer-name buffer))
+ (kill-buffer buffer)))
+ (buffer-list))
+ (should (get-buffer-create "*scratch*"))))
+
+(ert-deftest basic-persp-test-kill-extra-buffers ()
+ "Test `persp-test-kill-extra-buffers'.
+
+Expect to automatically cleanup *scratch* buffers that are not
+the \"*scratch*\" buffer, and all the buffers and buffer's names
+given as arguments, \"*scratch*\" buffer itself when included."
+ ;; Cleanup from extra *scratch* buffers.
+ (mapc #'kill-buffer (persp-test-match-scratch-buffers))
+ (should (get-buffer-create "*scratch*"))
+ ;; Try to kill some buffers and buffer's names.
+ (let ((some-buffer (get-buffer-create "*some*"))
+ (live-buffer (get-buffer-create "*live*"))
+ (dead-buffer (get-buffer-create "*dead*")))
+ (should (get-buffer "*some*"))
+ (should (get-buffer "*live*"))
+ (should (get-buffer "*dead*"))
+ (should (kill-buffer dead-buffer))
+ (should-not (get-buffer "*dead*"))
+ (should (buffer-live-p some-buffer))
+ (should (buffer-live-p live-buffer))
+ (should-not (buffer-live-p dead-buffer))
+ ;; As result, expect a list of names in alphabetical order of the
+ ;; buffers the function tries to kill. Expect nil if there is no
+ ;; suitable candidate. If the killing does not happen, it may be
+ ;; due to reasons outside of the scope of the function.
+ (should-not (persp-test-kill-extra-buffers))
+ (should-not (persp-test-kill-extra-buffers "*dead*"))
+ (should-not (persp-test-kill-extra-buffers dead-buffer))
+ (should-not (persp-test-kill-extra-buffers "*dead*" dead-buffer))
+ (should (equal (list "*live*" "*some*")
+ (persp-test-kill-extra-buffers "*some*" dead-buffer "*dead*" live-buffer)))
+ (should (persp-test-match-scratch-buffers "*scratch*"))
+ (should-not (buffer-live-p dead-buffer))
+ (should-not (buffer-live-p live-buffer))
+ (should-not (buffer-live-p some-buffer))
+ (should-not (get-buffer "*dead*"))
+ (should-not (get-buffer "*live*"))
+ (should-not (get-buffer "*some*"))
+ ;; Duplicate arguments, as buffer or buffer's name, should not be
+ ;; a problem.
+ (should (setq some-buffer (get-buffer-create "*some*")))
+ (should (equal (list "*some*")
+ (persp-test-kill-extra-buffers "*some*" some-buffer "*some*" some-buffer)))
+ (should (persp-test-match-scratch-buffers "*scratch*"))
+ (should-not (buffer-live-p some-buffer))
+ (should-not (get-buffer "*some*")))
+ ;; Expect to kill extra scratch buffers that aren't the "*scratch*"
+ ;; buffer, doing a cleanup after exiting `persp-mode'.
+ (persp-test-with-persp
+ (should (switch-to-buffer "*dummy*"))
+ (should (switch-to-buffer "*scratch*"))
+ (should (switch-to-buffer "*scratch* "))
+ (should (switch-to-buffer "*scratch* (A)"))
+ (should (switch-to-buffer "*scratch* (B)")))
+ (should (equal (list "*scratch* " "*scratch* (A)" "*scratch* (B)")
+ (persp-test-kill-extra-buffers)))
+ (should (persp-test-match-scratch-buffers "*scratch*"))
+ (should (get-buffer "*dummy*"))
+ ;; Do a cleanup while in `persp-mode', killing the "*scratch*" too.
+ ;; Expect a list of names of buffers the function tries to kill, it
+ ;; doesn't matter if the buffers survive the killing. The function
+ ;; tries to kill what matches its criteria. Candidates to kill can
+ ;; be given in any order, the result will be in alphabetical order.
+ (persp-test-with-persp
+ (persp-switch "A")
+ (persp-switch "B")
+ (should (get-buffer "*dummy*"))
+ (should (get-buffer-create "*scratch* "))
+ (should (equal (list "*scratch*" "*scratch* " "*scratch* (A)" "*scratch* (B)")
+ (persp-test-kill-extra-buffers "*scratch* (C)" "*scratch* (B)" "*scratch*"))))
+ (should-not (persp-test-match-scratch-buffers))
+ (should (get-buffer "*dummy*"))
+ ;; Cleanup.
+ (should (get-buffer-create "*scratch*"))
+ (should (equal (list "*dummy*")
+ (persp-test-kill-extra-buffers "*dummy*")))
+ (should (persp-test-match-scratch-buffers "*scratch*"))
+ (should-not (get-buffer "*dummy*")))
+
+(ert-deftest basic-persp-test-buffer-in-persps ()
+ "Test that `persp-test-buffer-in-persps' is working properly.
+
+Verify that a buffer can only be found in perspectives owning it
+and, at the same time, not in other existing perspectives. keep
+in mind that a perspective owning the buffer may be bare data of
+a formally non-existent `perspective-p' object."
+ (should (get-buffer-create "*dummy*"))
+ (should (get-buffer-create "*scratch*"))
+ (persp-test-kill-extra-buffers "*rogue*")
+ (persp-test-with-persp
+ (persp-new "A")
+ (persp-new "B")
+ (let (persp
+ persp-A
+ persp-B
+ buffers
+ buffers-A
+ buffers-B
+ rogue-buffer
+ (dummy-buffer (get-buffer "*dummy*"))
+ (scratch-buffer (get-buffer "*scratch*"))
+ (scratch-buffer-A (get-buffer "*scratch* (A)"))
+ (scratch-buffer-B (get-buffer "*scratch* (B)")))
+ ;; Get perspective's data from each existing perspective.
+ (setq persp (persp-curr))
+ (should (persp-is-current-buffer dummy-buffer))
+ (should (persp-is-current-buffer scratch-buffer))
+ (should-not (persp-is-current-buffer scratch-buffer-A))
+ (should-not (persp-is-current-buffer scratch-buffer-B))
+ (setq buffers (copy-sequence (persp-buffers (persp-curr))))
+ (with-perspective "A"
+ (setq persp-A (persp-curr))
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (should-not (persp-is-current-buffer scratch-buffer))
+ (should (persp-is-current-buffer scratch-buffer-A))
+ (should-not (persp-is-current-buffer scratch-buffer-B))
+ (setq buffers-A (copy-sequence (persp-buffers (persp-curr)))))
+ (with-perspective "B"
+ (setq persp-B (persp-curr))
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (should-not (persp-is-current-buffer scratch-buffer))
+ (should-not (persp-is-current-buffer scratch-buffer-A))
+ (should (persp-is-current-buffer scratch-buffer-B))
+ (setq buffers-B (copy-sequence (persp-buffers (persp-curr)))))
+ ;; Read the list of buffers from each perspective's data.
+ (should (equal buffers (persp-buffers persp)))
+ (should (equal buffers-A (persp-buffers persp-A)))
+ (should (equal buffers-B (persp-buffers persp-B)))
+ ;; *dummy* is in main, not in A and B
+ (should (memq dummy-buffer buffers))
+ (should-not (memq dummy-buffer buffers-A))
+ (should-not (memq dummy-buffer buffers-B))
+ ;; *scratch* is in main, not in A and B
+ (should (memq scratch-buffer buffers))
+ (should-not (memq scratch-buffer buffers-A))
+ (should-not (memq scratch-buffer buffers-B))
+ ;; *scratch* (A) is in A, not in main and B
+ (should (memq scratch-buffer-A buffers-A))
+ (should-not (memq scratch-buffer-A buffers))
+ (should-not (memq scratch-buffer-A buffers-B))
+ ;; *scratch* (B) is in B, not is main and A
+ (should (memq scratch-buffer-B buffers-B))
+ (should-not (memq scratch-buffer-B buffers))
+ (should-not (memq scratch-buffer-B buffers-A))
+ ;; Find buffer by name in specific perspectives.
+ (should (persp-test-buffer-in-persps "*dummy*" "main"))
+ (should (persp-test-buffer-in-persps "*scratch*" "main"))
+ (should (persp-test-buffer-in-persps "*scratch* (A)" "A"))
+ (should (persp-test-buffer-in-persps "*scratch* (B)" "B"))
+ ;; Find buffer by name in perspective's data.
+ (should (persp-test-buffer-in-persps "*dummy*" persp))
+ (should (persp-test-buffer-in-persps "*scratch*" persp))
+ (should (persp-test-buffer-in-persps "*scratch* (A)" persp-A))
+ (should (persp-test-buffer-in-persps "*scratch* (B)" persp-B))
+ ;; Find buffer in specific perspectives.
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "B"))
+ ;; Find buffer in perspective's data.
+ (should (persp-test-buffer-in-persps dummy-buffer persp))
+ (should (persp-test-buffer-in-persps scratch-buffer persp))
+ (should (persp-test-buffer-in-persps scratch-buffer-A persp-A))
+ (should (persp-test-buffer-in-persps scratch-buffer-B persp-B))
+ ;; Try buffer in wrong perspective.
+ (should-not (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ ;; Try in non-existent perspective.
+ (should-not (persp-test-buffer-in-persps dummy-buffer "main" "C"))
+ ;; Try buffer in duplicate targets.
+ (should (persp-test-buffer-in-persps dummy-buffer (persp-curr)))
+ (should (persp-test-buffer-in-persps dummy-buffer persp (persp-curr)))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" (persp-curr)))
+ (should (persp-test-buffer-in-persps dummy-buffer persp "main" (persp-curr)))
+ ;; Try finding non-existent buffer.
+ (should-not (get-buffer "*rogue*"))
+ (should-not (persp-test-buffer-in-persps "*rogue*"))
+ ;; Try finding a new rogue buffer.
+ (should (setq rogue-buffer (get-buffer-create "*rogue*")))
+ (should (persp-test-buffer-in-persps "*rogue*"))
+ (should-not (persp-is-current-buffer rogue-buffer))
+ (with-perspective "A"
+ (should-not (persp-is-current-buffer rogue-buffer)))
+ (with-perspective "B"
+ (should-not (persp-is-current-buffer rogue-buffer)))
+ ;; Try a rogue perspective's data.
+ (persp-set-buffer rogue-buffer)
+ (setq persp (copy-perspective (persp-curr)))
+ (setf (persp-current-buffers) (remq rogue-buffer (persp-current-buffers)))
+ (should (memq rogue-buffer (persp-buffers persp)))
+ (should-not (persp-is-current-buffer rogue-buffer))
+ (should (persp-test-buffer-in-persps "*rogue*" persp))
+ (should-not (persp-test-buffer-in-persps "*rogue*" "main"))
+ (should-not (persp-test-buffer-in-persps "*rogue*" (persp-curr)))
+ (should-not (persp-test-buffer-in-persps "*rogue*" persp "main" (persp-curr)))
+ ;; Try finding a killed buffer.
+ (persp-remove-buffer dummy-buffer)
+ (should-not (get-buffer "*dummy*"))
+ (should-not (buffer-live-p dummy-buffer))
+ (should (memq dummy-buffer (persp-buffers persp)))
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (should-not (persp-test-buffer-in-persps "*dummy*"))
+ (should-not (persp-test-buffer-in-persps dummy-buffer))
+ (should-not (persp-test-buffer-in-persps "*dummy*" persp))
+ (should-not (persp-test-buffer-in-persps dummy-buffer persp))
+ ;; Try finding a shared buffer.
+ (should (setq dummy-buffer (get-buffer-create "*dummy*")))
+ ;; *dummy* is a rogue buffer
+ (should (persp-test-buffer-in-persps "*dummy*"))
+ ;; put *dummy* in A and B
+ (setq persp (persp-curr))
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (with-perspective "A"
+ (setq persp-A (persp-curr))
+ (persp-add-buffer dummy-buffer)
+ (should (persp-is-current-buffer dummy-buffer)))
+ (with-perspective "B"
+ (setq persp-B (persp-curr))
+ (persp-add-buffer dummy-buffer)
+ (should (persp-is-current-buffer dummy-buffer)))
+ ;; where is *dummy*?
+ (should (persp-test-buffer-in-persps "*dummy*" "A" "B"))
+ (should (persp-test-buffer-in-persps "*dummy*" persp-A "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "A" persp-B))
+ (should-not (persp-test-buffer-in-persps "*dummy*" "A" "B" persp))
+ (should (persp-test-buffer-in-persps dummy-buffer persp-A persp-B))
+ (should (persp-test-buffer-in-persps dummy-buffer "A" persp-A persp-B "B"))))
+ ;; Cleanup.
+ (persp-test-kill-extra-buffers "*dummy*" "*rogue*"))
+
(ert-deftest basic-persp-header-line-format-default-value ()
"Disabling `persp-mode' should properly restore the default
value of `header-line-format'.
@@ -136,7 +617,7 @@ value of `header-line-format'.
Updating `header-line-format' default value using a buffer
local value of it is a mistake."
(let ((persp-show-modestring 'header)
- (default-header-line-format (default-value 'header-line-format)))
+ (default-header-line-format (default-value 'header-line-format)))
;; Since `persp-test-with-persp' may change in the future, do not
;; use it. We need to avoid switching to another buffer than the
;; *dummy* buffer just before `persp-mode' is disabled. For this
@@ -158,41 +639,1476 @@ local value of it is a mistake."
(kill-buffer "*dummy*")))
(ert-deftest basic-persp-creation-deletion ()
+ "Switching to a non-existing perspective should create the new
+perspective. Switching to an existing perspective should not
+duplicate the perspective. Creating a new perspective should
+not automatically switch to the perspective."
(persp-test-with-persp
- (should (equal (list "main") (persp-names)))
+ (should (equal (persp-current-name) "main"))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; test if switching to a non-existing perspective also creates it
(persp-switch "A")
+ (should (equal (persp-current-name) "A"))
(should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; test if creating a new perspective switches to it automatically
+ (persp-new "B")
+ (should (equal (persp-current-name) "A"))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; test if switching to an existing perspective duplicates it
(persp-switch "B")
+ (should (equal (persp-current-name) "B"))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ (persp-switch "A")
+ (should (equal (persp-current-name) "A"))
(should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
- (persp-kill "A")
+ ;; kill the current perspective to see where we land
+ (persp-kill (persp-current-name))
+ (should (equal (persp-current-name) "B"))
(should (equal (list "B" "main") (sort (persp-names) #'string-lessp)))
- (persp-kill "B")
- (should (equal (list "main") (persp-names)))))
+ (persp-kill (persp-current-name))
+ (should (equal (persp-current-name) "main"))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; sanity checks before killing the main perspective
+ (should (get-buffer "*Messages*"))
+ (should (get-buffer-create "*scratch*"))
+ (persp-set-buffer (get-buffer "*scratch*"))
+ (let ((ert-buffer (get-buffer "*ert*"))
+ (msg-buffer (get-buffer "*Messages*")))
+ ;; interactively run ert requires the *ert* buffer
+ (setf (persp-current-buffers) (remq ert-buffer (persp-current-buffers)))
+ ;; the *Messages* buffer is also ert's requiremet
+ (setf (persp-current-buffers) (remq msg-buffer (persp-current-buffers)))
+ ;; *scratch* is in main, not *ert* and *Messages*
+ (should (persp-test-buffer-in-persps "*scratch*" "main"))
+ (should-not (persp-test-buffer-in-persps ert-buffer "main"))
+ (should-not (persp-test-buffer-in-persps msg-buffer "main"))
+ ;; kill the main perspective except above buffers
+ (persp-kill (persp-current-name))
+ ;; the *scratch* buffer should have been killed
+ (should-not (get-buffer "*scratch*"))
+ ;; *ert* is needed by interactively run tests
+ (should (eq ert-buffer (get-buffer "*ert*")))
+ ;; the *Messages* buffer is needed by ert
+ (should (eq msg-buffer (get-buffer "*Messages*")))))
+ ;; cleanup
+ (should (get-buffer-create "*scratch*")))
+
+(ert-deftest basic-persp-get-buffers ()
+ "Test `persp-get-buffers'.
+Expect the list of a perspective's buffers."
+ (persp-test-with-persp
+ ;; buffers whose name is special should be listed
+ (let ((special-buffer (get-buffer-create " *foo*")))
+ (should (buffer-live-p special-buffer))
+ (persp-add-buffer special-buffer)
+ (let ((buffers (copy-sequence (persp-buffers (persp-curr)))))
+ (should (equal buffers (persp-get-buffers (persp-curr))))
+ (should (equal buffers (persp-get-buffers "main")))
+ (should (equal buffers (persp-current-buffers)))
+ (should (equal buffers (persp-get-buffers)))
+ (should (memq special-buffer buffers)))
+ (persp-switch "A")
+ (persp-add-buffer special-buffer)
+ (let ((buffers (copy-sequence (persp-buffers (persp-curr)))))
+ (should (equal buffers (persp-get-buffers (persp-curr))))
+ (should (equal buffers (persp-get-buffers "A")))
+ (should (equal buffers (persp-current-buffers)))
+ (should (equal buffers (persp-get-buffers)))
+ (should (memq special-buffer buffers)))
+ (persp-switch "B")
+ (persp-add-buffer special-buffer)
+ (let ((buffers (copy-sequence (persp-buffers (persp-curr)))))
+ (should (equal buffers (persp-get-buffers (persp-curr))))
+ (should (equal buffers (persp-get-buffers "B")))
+ (should (equal buffers (persp-current-buffers)))
+ (should (equal buffers (persp-get-buffers)))
+ (should (memq special-buffer buffers)))
+ (persp-switch "main")
+ (should (memq special-buffer (persp-get-buffers)))
+ (should (memq special-buffer (persp-get-buffers "A")))
+ (should (memq special-buffer (persp-get-buffers "B")))
+ (should (equal (persp-get-buffers) (persp-get-buffers "main")))
+ (should-not (equal (persp-get-buffers) (persp-get-buffers "A")))
+ (should-not (equal (persp-get-buffers "A") (persp-get-buffers "B")))))
+ ;; cleanup
+ (persp-test-kill-extra-buffers " *foo*"))
+
+(ert-deftest basic-persp-get-buffer-names ()
+ "Test `persp-get-buffer-names'.
+Expect the list of a perspective's live buffers."
+ (persp-test-with-persp
+ ;; buffers whose name is special should be filtered
+ (let ((special-buffer (get-buffer-create " *foo*")))
+ (should (buffer-live-p special-buffer))
+ (persp-add-buffer special-buffer)
+ (let ((buffers (copy-sequence (persp-current-buffer-names))))
+ (should (equal buffers (persp-get-buffer-names (persp-curr))))
+ (should (equal buffers (persp-get-buffer-names "main")))
+ (should (equal buffers (persp-get-buffer-names)))
+ (should-not (memq special-buffer buffers)))
+ (persp-switch "A")
+ (persp-add-buffer special-buffer)
+ (let ((buffers (copy-sequence (persp-current-buffer-names))))
+ (should (equal buffers (persp-get-buffer-names (persp-curr))))
+ (should (equal buffers (persp-get-buffer-names "A")))
+ (should (equal buffers (persp-get-buffer-names)))
+ (should-not (memq special-buffer buffers)))
+ (persp-switch "B")
+ (persp-add-buffer special-buffer)
+ (let ((buffers (copy-sequence (persp-current-buffer-names))))
+ (should (equal buffers (persp-get-buffer-names (persp-curr))))
+ (should (equal buffers (persp-get-buffer-names "B")))
+ (should (equal buffers (persp-get-buffer-names)))
+ (should-not (memq special-buffer buffers)))
+ (persp-switch "main")
+ (should-not (memq special-buffer (persp-get-buffer-names)))
+ (should-not (memq special-buffer (persp-get-buffer-names "A")))
+ (should-not (memq special-buffer (persp-get-buffer-names "B")))
+ (should (equal (persp-get-buffer-names) (persp-get-buffer-names "main")))
+ (should-not (equal (persp-get-buffer-names) (persp-get-buffer-names "A")))
+ (should-not (equal (persp-get-buffer-names "A") (persp-get-buffer-names "B")))))
+ ;; cleanup
+ (persp-test-kill-extra-buffers " *foo*"))
+
+(ert-deftest basic-persp-add-buffer ()
+ "Test that `persp-add-buffer' shares buffers between perspectives.
+A non-existing buffer passed as argument should be discarded."
+ ;; Starting conditions.
+ (persp-test-kill-extra-buffers "*dummy*")
+ (persp-test-with-persp
+ (let ((dummy-buffer (get-buffer-create "*dummy*")))
+ (should (buffer-live-p dummy-buffer))
+ ;; Add the new *dummy* buffer to each perspective.
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (persp-add-buffer dummy-buffer)
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (persp-switch "A")
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (persp-add-buffer dummy-buffer)
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (persp-switch "B")
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (persp-add-buffer dummy-buffer)
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A" "B"))
+ ;; Verify that perspectives only stored buffers.
+ (should (cl-every #'bufferp (persp-get-buffers "A")))
+ (should (cl-every #'bufferp (persp-get-buffers "B")))
+ (should (cl-every #'bufferp (persp-get-buffers "main")))
+ ;; Don't add the same buffer more than one time.
+ (persp-add-buffer dummy-buffer)
+ ;; The *dummy* buffer should be a shared buffer.
+ (should (eq 1 (cl-count dummy-buffer (persp-get-buffers "A"))))
+ (should (eq 1 (cl-count dummy-buffer (persp-get-buffers "B"))))
+ (should (eq 1 (cl-count dummy-buffer (persp-get-buffers "main"))))
+ ;; Kill the other perspectives sharing *dummy*.
+ (persp-kill "A")
+ (persp-kill "B")
+ ;; The *dummy* buffer should still be there.
+ (should (buffer-live-p dummy-buffer))
+ (should (persp-is-current-buffer dummy-buffer))
+ ;; Kill the *dummy* buffer (also cleanup).
+ (persp-remove-buffer dummy-buffer)
+ (should-not (buffer-live-p dummy-buffer))
+ (should-not (persp-is-current-buffer dummy-buffer))
+ ;; Try to add an unexisting buffer.
+ (let ((buffers (copy-sequence (persp-current-buffers))))
+ (persp-add-buffer "*dummy*")
+ (should (equal buffers (persp-current-buffers)))
+ ;; Try to add a killed buffer.
+ (persp-add-buffer dummy-buffer)
+ (should (equal buffers (persp-current-buffers))))))
+ ;; Forced cleanup when tests failed.
+ (persp-test-kill-extra-buffers "*dummy*"))
+
+(ert-deftest basic-persp-set-buffer ()
+ "Test that `persp-set-buffer' doesn't share buffers between perspectives.
+A non-existing buffer passed as argument should be discarded."
+ ;; Starting conditions.
+ (persp-test-kill-extra-buffers "*dummy*")
+ (persp-test-with-persp
+ (let ((dummy-buffer (get-buffer-create "*dummy*")))
+ (should (buffer-live-p dummy-buffer))
+ ;; Set the new *dummy* buffer in each perspective.
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (persp-set-buffer dummy-buffer)
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (persp-switch "A")
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (persp-set-buffer dummy-buffer)
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (persp-switch "B")
+ (should-not (persp-is-current-buffer dummy-buffer))
+ (persp-set-buffer dummy-buffer)
+ (should (persp-test-buffer-in-persps dummy-buffer "B"))
+ ;; Verify that perspectives only stored buffers.
+ (should (cl-every #'bufferp (persp-get-buffers "A")))
+ (should (cl-every #'bufferp (persp-get-buffers "B")))
+ (should (cl-every #'bufferp (persp-get-buffers "main")))
+ ;; Don't add the same buffer more than one time.
+ (persp-set-buffer dummy-buffer)
+ ;; The *dummy* buffer shan't be a shared buffer.
+ (should (eq 0 (cl-count dummy-buffer (persp-get-buffers "A"))))
+ (should (eq 1 (cl-count dummy-buffer (persp-get-buffers "B"))))
+ (should (eq 0 (cl-count dummy-buffer (persp-get-buffers "main"))))
+ ;; Kill the other perspectives except the main.
+ (persp-kill "A")
+ (persp-kill "B")
+ ;; Verify that *dummy* has been killed.
+ (should-not (buffer-live-p dummy-buffer))
+ (should-not (persp-is-current-buffer dummy-buffer))
+ ;; Try to set an unexisting buffer.
+ (let ((buffers (copy-sequence (persp-current-buffers))))
+ (persp-set-buffer "*dummy*")
+ (should (equal buffers (persp-current-buffers)))
+ ;; Try to set a killed buffer.
+ (persp-set-buffer dummy-buffer)
+ (should (equal buffers (persp-current-buffers))))))
+ ;; Forced cleanup when tests failed.
+ (persp-test-kill-extra-buffers "*dummy*"))
+
+(ert-deftest basic-persp-window-prev-buffers ()
+ "Test if `window-prev-buffers' gets buffers of other perspectives.
+
+A dirty `window-prev-buffers' may allow a perspective to pull in
+buffers from other perspectives.
+
+Till Emacs 27.2, `delete-window' may update `window-prev-buffers'
+for all windows. This means that after `persp-reset-windows' the
+single window left may end up with a dirty `window-prev-buffers',
+unless `switch-to-buffer-preserve-window-point' is nil.
+
+Upstream commit 8f63f0078a23421eada97b4da51b9308b82532ce reverted
+window/winner changes (Revert 0454bfd3313) in Emacs (bug#23621).
+So, what said above should not apply any more after that commit,
+and `switch-to-buffer-preserve-window-point' could not be used."
+ (should (get-buffer-create "*scratch*"))
+ (persp-test-kill-extra-buffers "*dummy*")
+ (persp-test-with-persp
+ (let (dummy-buffer scratch-buffer scratch-buffer-A)
+ (should (setq scratch-buffer (switch-to-buffer "*scratch*")))
+ (should (setq dummy-buffer (switch-to-buffer "*dummy*")))
+ (should-not (assq dummy-buffer (window-prev-buffers)))
+ (should (assq scratch-buffer (window-prev-buffers)))
+ (should (eq dummy-buffer (current-buffer)))
+ (persp-switch "A")
+ (persp-set-buffer "*dummy*")
+ (should (setq scratch-buffer-A (get-buffer "*scratch* (A)")))
+ (should-not (assq scratch-buffer-A (window-prev-buffers)))
+ (should-not (assq scratch-buffer (window-prev-buffers)))
+ (should-not (assq dummy-buffer (window-prev-buffers)))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (persp-switch "main")
+ (should-not (assq scratch-buffer-A (window-prev-buffers)))
+ (should-not (assq dummy-buffer (window-prev-buffers)))
+ (should (assq scratch-buffer (window-prev-buffers)))
+ (should (eq scratch-buffer (current-buffer))))))
+
+;; This may supersede `basic-persp-switching'.
+(ert-deftest basic-persp-killing-buffers ()
+ "Expect that a perspective always has at least one live buffer.
+Consider live buffers those that respect `ido-ignore-buffers'.
+It should be possible to kill any perspective independently on
+the number of buffers, shared or not, that it has, though."
+ ;; Starting conditions.
+ (should (switch-to-buffer "*scratch*"))
+ (persp-test-kill-extra-buffers " *foo*" "*dummy*")
+ (persp-test-with-persp
+ ;; While running ert tests, in some cases, the `current-buffer'
+ ;; may (unexpectedly) switch to " *temp*". Keep it in mind.
+ (let (special-buffer dummy-buffer scratch-buffer scratch-buffer-A scratch-buffer-B)
+ ;; PERSPECTIVE / ACTION | " *foo*" | *dummy* | *scratch* | *scratch* (A) | *scratch* (B) | NOTES
+ ;; ----------------------------------------------------------------------------------------------------------------------------
+ ;; main | | | main | | | create rogue buffers
+ (should (setq special-buffer (get-buffer-create " *foo*")))
+ (should (setq dummy-buffer (get-buffer-create "*dummy*")))
+ (should (setq scratch-buffer (get-buffer "*scratch*")))
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (>= (length (persp-get-buffer-names "main")) 1))
+ (should (persp-test-buffer-in-persps special-buffer))
+ (should (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; kill rogue " *foo*" | | | main | | | buffer not in any perspective
+ (persp-remove-buffer special-buffer)
+ (should-not (get-buffer " *foo*"))
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (>= (length (persp-get-buffer-names "main")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; kill rogue *dummy* | | | main | | | buffer not in any perspective
+ (persp-remove-buffer dummy-buffer)
+ (should-not (get-buffer "*dummy*"))
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (>= (length (persp-get-buffer-names "main")) 1))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; switch to " *foo*" | main | | main | | | " *foo*" is `ido-ignore-buffers'
+ (should (setq special-buffer (switch-to-buffer " *foo*")))
+ (should (equal (persp-current-name) "main"))
+ (should (eq special-buffer (current-buffer)))
+ (should (>= (length (persp-get-buffer-names "main")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; switch to *dummy* | main | main | main | | | switch to a live buffer
+ (should (setq dummy-buffer (switch-to-buffer "*dummy*")))
+ (should (equal (persp-current-name) "main"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (>= (length (persp-get-buffer-names "main")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; kill *dummy* | main | | main | | | switch to another live buffer
+ (should (kill-buffer dummy-buffer))
+ (should-not (get-buffer "*dummy*"))
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (>= (length (persp-get-buffer-names "main")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; switch to *dummy* | main | main | main | | | re-create *dummy*
+ (should (setq dummy-buffer (switch-to-buffer "*dummy*")))
+ (should (equal (persp-current-name) "main"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (>= (length (persp-get-buffer-names "main")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))
+ ;; new A | main | main | main | A | | new *scratch* (A)
+ (persp-new "A")
+ (should (setq scratch-buffer-A (get-buffer "*scratch* (A)")))
+ (should (equal (persp-current-name) "main"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; remove *scratch* (A) | main | main | main | A | | buffer is in other perspective
+ (persp-remove-buffer scratch-buffer-A)
+ (should (equal (persp-current-name) "main"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; kill *scratch* (A) | main | main | main | A | | cannot kill last left live buffer
+ (should-not (kill-buffer scratch-buffer-A))
+ (should (equal (persp-current-name) "main"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; set *scratch* (A) | main | main | main | main A | | cannot remove last left live buffer
+ (persp-set-buffer scratch-buffer-A)
+ (should (equal (persp-current-name) "main"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; main -> A | main | main | main | main A | | switch to A
+ (persp-switch "A")
+ (should (equal (persp-current-name) "A"))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; kill *scratch* (A) | main | main | main | A | | cannot kill last left live buffer
+ (should-not (kill-buffer scratch-buffer-A))
+ (should (equal (persp-current-name) "A"))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; remove *scratch* (A) | main | main | main | A | | cannot remove last left live buffer
+ (persp-remove-buffer scratch-buffer-A)
+ (should (equal (persp-current-name) "A"))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; switch to " *foo*" | main A | main | main | A | | share " *foo*"
+ (should (switch-to-buffer special-buffer))
+ (should (equal (persp-current-name) "A"))
+ (should (eq special-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; kill *scratch* (A) | main A | main | main | A | | cannot kill last left live buffer
+ (should-not (kill-buffer scratch-buffer-A))
+ (should (equal (persp-current-name) "A"))
+ (should (eq special-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; remove *scratch* (A) | main A | main | main | A | | cannot remove last left live buffer
+ (persp-remove-buffer scratch-buffer-A)
+ (should (equal (persp-current-name) "A"))
+ (should (eq special-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; remove " *foo*" | main | main | main | A | | remove shared buffer
+ (persp-remove-buffer special-buffer)
+ (should (equal (persp-current-name) "A"))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; add *dummy* | main | main A | main | A | | share *dummy*
+ (persp-add-buffer dummy-buffer)
+ (should (equal (persp-current-name) "A"))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; remove *scratch* (A) | main | main A | main | | | kill unshared buffer
+ (persp-remove-buffer scratch-buffer-A)
+ (should-not (get-buffer "*scratch* (A)"))
+ (should (equal (persp-current-name) "A"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ (should (equal (list "A" "main") (sort (persp-names) #'string-lessp)))
+ ;; A -> new B | main | main A | main | | B | new *scratch* (B)
+ (persp-switch "B")
+ (should (setq scratch-buffer-B (get-buffer "*scratch* (B)")))
+ (should (equal (persp-current-name) "B"))
+ (should (eq scratch-buffer-B (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 1))
+ (should (persp-test-buffer-in-persps special-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; switch to " *foo*" | main B | main A | main | | B | share " *foo*"
+ (should (switch-to-buffer special-buffer))
+ (should (equal (persp-current-name) "B"))
+ (should (eq special-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; kill *dummy* | main B | A | main | | B | cannot kill last left live buffer
+ (should-not (kill-buffer dummy-buffer))
+ (should (equal (persp-current-name) "B"))
+ (should (eq special-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; B -> main | main B | A | main | | B | switch to main
+ (persp-switch "main")
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; add *dummy* | main B | main A | main | | B | share *dummy*
+ (persp-add-buffer dummy-buffer)
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; add *scratch* (B) | main B | main A | main | | main B | share *scratch* (B)
+ (persp-add-buffer scratch-buffer-B)
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main" "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; main -> A | main B | main A | main | | main B | switch to A
+ (persp-switch "A")
+ (should (equal (persp-current-name) "A"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main" "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; add *scratch* | main B | main A | main A | | main B | share *scratch*
+ (persp-add-buffer scratch-buffer)
+ (should (equal (persp-current-name) "A"))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main" "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; A -> B | main B | main A | main A | | main B | switch to B
+ (persp-switch "B")
+ (should (equal (persp-current-name) "B"))
+ (should (eq special-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main" "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; set *dummy* | main B | B | main A | | main B | unshare buffer
+ (persp-set-buffer dummy-buffer)
+ (should (equal (persp-current-name) "B"))
+ (should (eq special-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 3))
+ (should (persp-test-buffer-in-persps special-buffer "main" "B"))
+ (should (persp-test-buffer-in-persps dummy-buffer "B"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main" "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; kill " *foo*" | | B | main A | | main B | kill shared buffer
+ (should (kill-buffer special-buffer))
+ (should-not (get-buffer " *foo*"))
+ (should (equal (persp-current-name) "B"))
+ (should (eq scratch-buffer-B (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps dummy-buffer "B"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main" "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "A" "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; kill A | | B | main | | main B | keep shared buffer
+ (persp-kill "A")
+ (should (equal (persp-current-name) "B"))
+ (should (eq scratch-buffer-B (current-buffer)))
+ (should (= (length (persp-get-buffers "B")) 2))
+ (should (persp-test-buffer-in-persps dummy-buffer "B"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main" "B"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "B" "main") (sort (persp-names) #'string-lessp)))
+ ;; kill B | | | main | | main | kill unshared buffer
+ (persp-kill "B")
+ (should-not (get-buffer "*dummy*"))
+ (should (equal (persp-current-name) "main"))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-B "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-B))
+ (should (equal (list "main") (sort (persp-names) #'string-lessp)))))
+ ;; Forced cleanup when tests failed.
+ (persp-test-kill-extra-buffers " *foo*" "*dummy*"))
+
+(ert-deftest basic-persp-forget-buffer ()
+ "Test `persp-forget-buffer' and `persp-remove-buffer'.
+
+The former should disassociate buffers with perspectives, never
+killing them, the latter disassociates shared buffers and kills
+unshared ones, aka buffers not found in any other perspective."
+ (persp-test-with-persp
+ (let (dummy-buffer scratch-buffer scratch-buffer-A)
+ ;; switch to *scratch* in main
+ (should (setq scratch-buffer (switch-to-buffer "*scratch*")))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; switch to *dummy* in main
+ (should (setq dummy-buffer (switch-to-buffer "*dummy*")))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; disassociate *dummy* with main
+ (persp-forget-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; disassociate unassociated *dummy*
+ (persp-forget-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer (current-buffer)))
+ (should (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; remove unassociated *dummy*
+ (persp-remove-buffer dummy-buffer)
+ (should-not (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer (current-buffer)))
+ (should-not (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; switch to *dummy* in main
+ (should (setq dummy-buffer (switch-to-buffer "*dummy*")))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; remove *dummy* from main
+ (persp-remove-buffer dummy-buffer)
+ (should-not (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer (current-buffer)))
+ (should-not (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; switch to *dummy* in main
+ (should (setq dummy-buffer (switch-to-buffer "*dummy*")))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; switch to new perspective A
+ (persp-switch "A")
+ (should (setq scratch-buffer-A (get-buffer "*scratch* (A)")))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq dummy-buffer (current-buffer))))
+ ;; disassociate unassociated *dummy*
+ (persp-forget-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq dummy-buffer (current-buffer))))
+ ;; remove unassociated *dummy*
+ (persp-remove-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq dummy-buffer (current-buffer))))
+ ;; switch to *dummy* in A
+ (should (switch-to-buffer dummy-buffer))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq dummy-buffer (current-buffer))))
+ ;; disassociate *dummy* with A
+ (persp-forget-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq dummy-buffer (current-buffer))))
+ ;; switch to *dummy* in A
+ (should (switch-to-buffer dummy-buffer))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq dummy-buffer (current-buffer))))
+ ;; remove *dummy* from A
+ (persp-remove-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq dummy-buffer (current-buffer))))
+ ;; set *dummy* to A
+ (persp-set-buffer dummy-buffer)
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; disassociate *dummy* with A
+ (persp-forget-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; disassociate unassociated *dummy*
+ (persp-forget-buffer dummy-buffer)
+ (should (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; remove unassociated *dummy*
+ (persp-remove-buffer dummy-buffer)
+ (should-not (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should-not (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; switch to *dummy* in A
+ (should (setq dummy-buffer (switch-to-buffer "*dummy*")))
+ (should (eq dummy-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 2))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; remove *dummy* from A
+ (persp-remove-buffer dummy-buffer)
+ (should-not (buffer-live-p dummy-buffer))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should-not (persp-test-buffer-in-persps dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; disassociate "*scratch* (A)" with A
+ (persp-forget-buffer scratch-buffer-A)
+ (should (buffer-live-p scratch-buffer-A))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; remove "*scratch* (A)" from A
+ (persp-remove-buffer scratch-buffer-A)
+ (should (buffer-live-p scratch-buffer-A))
+ (should (eq scratch-buffer-A (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "main"
+ (should (eq scratch-buffer (current-buffer))))
+ ;; switch to perspective main
+ (persp-switch "main")
+ (should (eq scratch-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "A"
+ (should (eq scratch-buffer-A (current-buffer))))
+ ;; set "*scratch* (A)" to main
+ (persp-set-buffer scratch-buffer-A)
+ (should (eq scratch-buffer (current-buffer)))
+ (should (= (length (persp-get-buffers "A")) 1))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ (with-perspective "A"
+ (should (eq scratch-buffer-A (current-buffer))))))
+ ;; forced cleanup when tests failed
+ (persp-test-kill-extra-buffers "*dummy*"))
(ert-deftest basic-persp-switching ()
+ "Test switching buffers and perspectives.
+
+Verify the `current-buffer' when switching buffer/perspective and
+when removing a perspective's buffer.
+
+Verify that after switching to a new perspective, the perspective
+has its scratch buffer set as `current-buffer'."
(persp-test-with-persp
(persp-test-with-temp-buffers (A1 A2 B1 B2 B3)
- ;; currently in "main" perspective
- (cl-loop for buf in (list A1 A2 B1 B2 B3) do
- (should-not (memq buf (persp-buffers (persp-curr)))))
+ (let (scratch-buffer)
+ ;; currently in "main" perspective
+ (cl-loop for buf in (list A1 A2 B1 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (should (switch-to-buffer B3))
+ (should (eq B3 (current-buffer)))
+ (should (memq B3 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A1 A2 B1 B2) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (persp-new "A")
+ (should (get-buffer "*scratch* (A)"))
+ (should (eq B3 (current-buffer)))
+ (should (memq B3 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A1 A2 B1 B2) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (persp-switch "A")
+ (should (eq (get-buffer "*scratch* (A)") (current-buffer)))
+ (cl-loop for buf in (list A1 A2 B1 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (should (switch-to-buffer A1))
+ (should (eq A1 (current-buffer)))
+ (should (memq A1 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A2 B1 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (should (switch-to-buffer A2))
+ (should (eq A2 (current-buffer)))
+ (cl-loop for buf in (list A1 A2) do
+ (should (memq buf (persp-buffers (persp-curr)))))
+ (cl-loop for buf in (list B1 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ ;; A2 is killed, since it's not a shared buffer
+ (persp-remove-buffer A2)
+ (should-not (buffer-live-p A2))
+ (should (eq A1 (current-buffer)))
+ (should (memq A1 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A2 B1 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (persp-switch "main")
+ (should (eq B3 (current-buffer)))
+ (should (memq B3 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A1 A2 B1 B2) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (persp-switch "A")
+ (should (eq A1 (current-buffer)))
+ (should (memq A1 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A2 B1 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (persp-switch "B")
+ (should (eq (get-buffer "*scratch* (B)") (current-buffer)))
+ (cl-loop for buf in (list A1 A2 B1 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (should (switch-to-buffer B1))
+ (should (eq B1 (current-buffer)))
+ (should (memq B1 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A1 A2 B2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (should (switch-to-buffer B2))
+ (should (eq B2 (current-buffer)))
+ (cl-loop for buf in (list B1 B2) do
+ (should (memq buf (persp-buffers (persp-curr)))))
+ (cl-loop for buf in (list A1 A2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (should (switch-to-buffer B3))
+ (should (eq B3 (current-buffer)))
+ (cl-loop for buf in (list B1 B2 B3) do
+ (should (memq buf (persp-buffers (persp-curr)))))
+ (cl-loop for buf in (list A1 A2) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ ;; B3 is not killed, since it's a shared buffer
+ (persp-remove-buffer B3)
+ (should (buffer-live-p B3))
+ (should (eq B2 (current-buffer)))
+ (cl-loop for buf in (list B1 B2) do
+ (should (memq buf (persp-buffers (persp-curr)))))
+ (cl-loop for buf in (list A1 A2 B3) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))
+ (persp-switch "main")
+ (should (eq B3 (current-buffer)))
+ (should (memq B3 (persp-buffers (persp-curr))))
+ (cl-loop for buf in (list A1 A2 B1 B2) do
+ (should-not (memq buf (persp-buffers (persp-curr)))))))))
+
+(ert-deftest basic-persp-get-scratch-buffer ()
+ "Verify that creating a new perspective also creates its own
+*scratch* buffer, if missing, or adds the existing one. If
+created, expect the same as the startup *scratch* buffer.
+
+Enabling `persp-mode' shouldn't replace a missing *scratch*
+buffer, and `persp-new' shouldn't modify perspectives which
+already exist, re-creating *scratch* buffers or adding back
+existing ones, or resetting a perspective's list of buffer.
+
+Switching perspectives shouldn't re-create or add *scratch*
+buffers into any perspective."
+ (let ((default-scratch-message
+ (substitute-command-keys initial-scratch-message))
+ (dummy-buffer (get-buffer-create "*dummy*"))
+ scratch-buffer scratch-buffer-A)
+ ;; It's expected that `initial-scratch-message' contains a command
+ ;; key description. We'll check if it's resolved to a name in the
+ ;; *scratch* buffers, like `default-scratch-message' should be.
+ (if (or (> emacs-major-version 25)
+ (and (= emacs-major-version 25) (>= emacs-minor-version 1)))
+ ;; Treat `initial-scratch-message' as a doc string.
+ (should-not (equal initial-scratch-message default-scratch-message))
+ ;; Treat `initial-scratch-message' as plain text.
+ (should (equal initial-scratch-message default-scratch-message)))
+ ;; Kill the *scratch* buffer. We'll test if enabling `persp-mode'
+ ;; automatically re-creates it in the main perspective.
+ (should (buffer-live-p dummy-buffer))
+ (persp-test-kill-extra-buffers "*scratch*")
+ (persp-test-with-persp
+ ;; PERSPECTIVE / ACTION | *scratch* | *scratch* (A) | *dummy* | NOTES
+ ;; -------------------------------------------------------------------------------------------------------
+ ;; main | | | main | only main <- begin
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; main -> new A | | A | main | add new *scratch* (A)
(persp-switch "A")
- (switch-to-buffer A1)
- (switch-to-buffer A2)
- (cl-loop for buf in (list A1 A2) do
- (should (memq buf (persp-buffers (persp-curr)))))
- (cl-loop for buf in (list B1 B2 B3) do
- (should-not (memq buf (persp-buffers (persp-curr)))))
- (persp-switch "B")
- (switch-to-buffer B1)
- (switch-to-buffer B2)
- (switch-to-buffer B3)
- (cl-loop for buf in (list A1 A2) do
- (should-not (memq buf (persp-buffers (persp-curr)))))
- (cl-loop for buf in (list B1 B2 B3) do
- (should (memq buf (persp-buffers (persp-curr)))))
+ (should (setq scratch-buffer-A (persp-test-buffer-in-persps "*scratch* (A)" "A")))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; kill A -> main | | | main | kill *scratch* (A)
+ (persp-kill "A")
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; create *scratch* | - | | main | new rogue *scratch*
+ (should (setq scratch-buffer (get-buffer-create "*scratch*")))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; main -> new A | - | A | main | add new *scratch* (A)
+ (persp-switch "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (setq scratch-buffer-A (persp-test-buffer-in-persps "*scratch* (A)" "A")))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill A -> main | - | | main | kill *scratch* (A)
+ (persp-kill "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; create *scratch* (A) | - | - | main | new rogue *scratch* (A)
+ (should (setq scratch-buffer-A (get-buffer-create "*scratch* (A)")))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; main -> new A | - | A | main | add rogue *scratch* (A)
+ (persp-switch "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill A -> main | - | | main | kill *scratch* (A)
+ (persp-kill "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; switch to *scratch* (A) | - | main | main | add new *scratch* (A)
+ (should (setq scratch-buffer-A (switch-to-buffer "*scratch* (A)")))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; main -> new A | - | main A | main | share *scratch* (A)
+ (persp-switch "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "main" "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; add all of main to A | - | main A | main A | share main buffers with A
+ (mapc #'persp-add-buffer (persp-get-buffers "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "main" "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill main | - | A | A | keep shared buffers <- end
+ (persp-kill "main")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill all scratch | | | A | only A <- begin
+ (mapc #'kill-buffer (persp-test-match-scratch-buffers))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; A -> new main | main | | A | add new *scratch*
+ (persp-switch "main")
+ (should (setq scratch-buffer (persp-test-buffer-in-persps "*scratch*" "main")))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; kill main -> A | | | A | kill *scratch*
+ (persp-kill "main")
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; create *scratch* (A) | | - | A | new rogue *scratch* (A)
+ (should (setq scratch-buffer-A (get-buffer-create "*scratch* (A)")))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; A -> new main | main | - | A | add new *scratch*
+ (persp-switch "main")
+ (should (setq scratch-buffer (persp-test-buffer-in-persps "*scratch*" "main")))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill main -> A | | - | A | kill *scratch*
+ (persp-kill "main")
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; create *scratch* | - | - | A | new rogue *scratch*
+ (should (setq scratch-buffer (get-buffer-create "*scratch*")))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; A -> new main | main | - | A | add rogue *scratch*
(persp-switch "main")
- (cl-loop for buf in (list A1 A2 B1 B2 B3) do
- (should-not (memq buf (persp-buffers (persp-curr))))))))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill main -> A | | - | A | kill *scratch*
+ (persp-kill "main")
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; switch to *scratch* | A | - | A | add new *scratch*
+ (should (setq scratch-buffer (switch-to-buffer "*scratch*")))
+ (should (persp-test-buffer-in-persps scratch-buffer "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; A -> new main | main A | - | A | share *scratch*
+ (persp-switch "main")
+ (should (persp-test-buffer-in-persps scratch-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; add all of A to main | main A | - | main A | share A buffers with main
+ (mapc #'persp-add-buffer (persp-get-buffers "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer "main" "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill A | main | - | main | keep shared buffers <- end
+ (persp-kill "A")
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill all scratch | | | main | only main <- begin
+ (mapc #'kill-buffer (persp-test-match-scratch-buffers))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; new A | | A | main | add new *scratch* (A)
+ (persp-new "A")
+ (should (setq scratch-buffer-A (persp-test-buffer-in-persps "*scratch* (A)" "A")))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; add *dummy* to A | | A | main A | share *dummy*
+ (with-perspective "A"
+ (persp-add-buffer dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; kill all scratch | | | main A | reset state
+ (mapc #'kill-buffer (persp-test-match-scratch-buffers))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; re-create A | | | main A | nothing changes
+ (persp-new "A")
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; re-create main | | | main A | nothing changes
+ (persp-new "main")
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; create *scratch* | - | | main A | new rogue *scratch*
+ (should (setq scratch-buffer (get-buffer-create "*scratch*")))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; create *scratch* (A) | - | - | main A | new rogue *scratch* (A)
+ (should (setq scratch-buffer-A (get-buffer-create "*scratch* (A)")))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; re-create A | - | - | main A | nothing changes
+ (persp-new "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; re-create main | - | - | main A | nothing changes
+ (persp-new "main")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; main -> A | - | - | main A | nothing changes
+ (persp-switch "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; add all of main to A | - | - | main A | share main buffers with A
+ (mapc #'persp-add-buffer (persp-get-buffers "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill main | - | - | A | keep shared buffers <- end
+ (persp-kill "main")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill all scratch | | | A | only A <- begin
+ (mapc #'kill-buffer (persp-test-match-scratch-buffers))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; new main | main | | A | add new *scratch*
+ (persp-new "main")
+ (should (setq scratch-buffer (persp-test-buffer-in-persps "*scratch*" "main")))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; add *dummy* to main | main | | main A | share *dummy*
+ (with-perspective "main"
+ (persp-add-buffer dummy-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer))
+ ;; kill all scratch | | | main A | reset state
+ (mapc #'kill-buffer (persp-test-match-scratch-buffers))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; re-create main | | | main A | nothing changes
+ (persp-new "main")
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; re-create A | | | main A | nothing changes
+ (persp-new "A")
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; create *scratch* (A) | | - | main A | new rogue *scratch* (A)
+ (should (setq scratch-buffer-A (get-buffer-create "*scratch* (A)")))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; create *scratch* | - | - | main A | new rogue *scratch*
+ (should (setq scratch-buffer (get-buffer-create "*scratch*")))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; re-create main | - | - | main A | nothing changes
+ (persp-new "main")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; re-create A | - | - | main A | nothing changes
+ (persp-new "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; A -> main | - | - | main A | nothing changes
+ (persp-switch "main")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; add all of A to main | - | - | main A | share A buffers with main
+ (mapc #'persp-add-buffer (persp-get-buffers "A"))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill A | - | - | main | keep shared buffers <- end
+ (persp-kill "A")
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; kill all scratch | | | main | only main <- begin
+ (mapc #'kill-buffer (persp-test-match-scratch-buffers))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should-not (persp-test-match-scratch-buffers))
+ ;; main -> new A | | A | main | add new *scratch* (A)
+ (persp-switch "A")
+ (should (setq scratch-buffer-A (persp-test-buffer-in-persps "*scratch* (A)" "A")))
+ (should (persp-test-buffer-in-persps dummy-buffer "main"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; add all of main to A | | A | main A | share main buffers with A
+ (mapc #'persp-add-buffer (persp-get-buffers "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; kill main | | A | A | keep shared buffers
+ (persp-kill "main")
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer-A))
+ ;; A -> new main | main | A | A | add new *scratch*
+ (persp-switch "main")
+ (should (setq scratch-buffer (persp-test-buffer-in-persps "*scratch*" "main")))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; add some buffers to main | main | A | main A | share most with main <- end
+ (mapc #'persp-add-buffer (remq scratch-buffer-A (persp-get-buffers "A")))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; At this point, "*scratch*" and "*scratch* (A)" are brand new.
+ ;; The perspectives main and A, respectively, own the former and
+ ;; the latter.
+ ;; -------------------------------------------------------------------------------------------------------
+ ;; Verify if the "main" perspective scratch buffer is conformant
+ ;; to the startup scratch buffer. Also verify if recreating the
+ ;; perspective duplicates the `initial-scratch-message'.
+ (persp-new "main")
+ (with-current-buffer scratch-buffer
+ (should-not (buffer-modified-p))
+ (should (eq major-mode initial-major-mode))
+ (should (equal (buffer-string) default-scratch-message)))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify if another perspective's scratch buffer is conformant,
+ ;; and if the `initial-scratch-message' is duplicated.
+ (persp-new "A")
+ (with-current-buffer scratch-buffer-A
+ (should-not (buffer-modified-p))
+ (should (eq major-mode initial-major-mode))
+ (should (equal (buffer-string) default-scratch-message)))
+ (should (persp-test-buffer-in-persps scratch-buffer "main"))
+ (should (persp-test-buffer-in-persps scratch-buffer-A "A"))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify that `persp-get-scratch-buffer' does not automatically
+ ;; add scratch buffers to perspectives.
+ (with-perspective "main"
+ (setf (persp-current-buffers) (remq scratch-buffer (persp-current-buffers))))
+ (with-perspective "A"
+ (setf (persp-current-buffers) (remq scratch-buffer-A (persp-current-buffers))))
+ ;; Verify if `persp-get-scratch-buffer' gets the scratch buffers
+ ;; when calling it from the "main" perspective.
+ (with-perspective "main"
+ (should (eq scratch-buffer (persp-get-scratch-buffer)))
+ (should (eq scratch-buffer (persp-get-scratch-buffer "main")))
+ (should (eq scratch-buffer-A (persp-get-scratch-buffer "A"))))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify if `persp-get-scratch-buffer' gets the scratch buffers
+ ;; when calling it from another perspective.
+ (with-perspective "A"
+ (should (eq scratch-buffer-A (persp-get-scratch-buffer)))
+ (should (eq scratch-buffer (persp-get-scratch-buffer "main")))
+ (should (eq scratch-buffer-A (persp-get-scratch-buffer "A"))))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify that `persp-get-scratch-buffer' does not try to modify
+ ;; the "main" perspective's scratch buffer.
+ (with-perspective "main"
+ (with-current-buffer scratch-buffer
+ (erase-buffer)
+ (fundamental-mode))
+ (should (eq scratch-buffer (persp-get-scratch-buffer)))
+ (with-current-buffer scratch-buffer
+ (should (buffer-modified-p))
+ (should (zerop (buffer-size)))
+ (should (eq major-mode 'fundamental-mode))))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify that `persp-get-scratch-buffer' does not try to modify
+ ;; another perspective's scratch buffer.
+ (with-perspective "A"
+ (with-current-buffer scratch-buffer-A
+ (erase-buffer)
+ (fundamental-mode))
+ (should (eq scratch-buffer-A (persp-get-scratch-buffer)))
+ (with-current-buffer scratch-buffer-A
+ (should (buffer-modified-p))
+ (should (zerop (buffer-size)))
+ (should (eq major-mode 'fundamental-mode))))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify that `persp-get-scratch-buffer' created scratch buffer
+ ;; isn't automatically added to perspectives. Try to create the
+ ;; buffers from the "main" perspective.
+ (should (kill-buffer scratch-buffer))
+ (should (kill-buffer scratch-buffer-A))
+ (should-not (persp-test-match-scratch-buffers))
+ (with-perspective "main"
+ (should (setq scratch-buffer (persp-get-scratch-buffer)))
+ (should (setq scratch-buffer-A (persp-get-scratch-buffer "A"))))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify that `persp-get-scratch-buffer' created scratch buffer
+ ;; isn't automatically added to perspectives. Try to create the
+ ;; buffers from another perspective.
+ (should (kill-buffer scratch-buffer))
+ (should (kill-buffer scratch-buffer-A))
+ (should-not (persp-test-match-scratch-buffers))
+ (with-perspective "A"
+ (should (setq scratch-buffer (persp-get-scratch-buffer "main")))
+ (should (setq scratch-buffer-A (persp-get-scratch-buffer))))
+ (should (persp-test-buffer-in-persps scratch-buffer))
+ (should (persp-test-buffer-in-persps scratch-buffer-A))
+ (should (persp-test-buffer-in-persps dummy-buffer "main" "A"))
+ (should (persp-test-match-scratch-buffers scratch-buffer scratch-buffer-A))
+ ;; Verify that `persp-get-scratch-buffer' created scratch buffer
+ ;; is conformant to the startup scratch buffer.
+ (with-current-buffer scratch-buffer
+ (should-not (buffer-modified-p))
+ (should (eq major-mode initial-major-mode))
+ (should (equal (buffer-string) default-scratch-message)))
+ (with-current-buffer scratch-buffer-A
+ (should-not (buffer-modified-p))
+ (should (eq major-mode initial-major-mode))
+ (should (equal (buffer-string) default-scratch-message)))))
+ ;; Cleanup.
+ (persp-test-kill-extra-buffers "*dummy*")
+ (should (get-buffer-create "*scratch*")))
+
+(ert-deftest basic-persp-switch-to-scratch-buffer ()
+ (persp-test-with-persp
+ ;; currently in "main" perspective
+ (switch-to-buffer "*dummy*")
+ (should (get-buffer "*scratch*"))
+ (should (equal (buffer-name) "*dummy*"))
+ ;; switch to the perspective's scratch buffer
+ (persp-switch-to-scratch-buffer)
+ (should (equal (buffer-name) "*scratch*"))
+ (switch-to-buffer "*dummy*")
+ (should (kill-buffer "*scratch*"))
+ (should-not (get-buffer "*scratch*"))
+ ;; create and switch to the perspective's scratch buffer
+ (persp-switch-to-scratch-buffer)
+ (should (equal (buffer-name) "*scratch*"))
+ (persp-switch "A")
+ (switch-to-buffer "*dummy*")
+ (should (get-buffer "*scratch* (A)"))
+ (should (equal (buffer-name) "*dummy*"))
+ ;; switch to the perspective's scratch buffer
+ (persp-switch-to-scratch-buffer)
+ (should (equal (buffer-name) "*scratch* (A)"))
+ (switch-to-buffer "*dummy*")
+ (should (kill-buffer "*scratch* (A)"))
+ (should-not (get-buffer "*scratch* (A)"))
+ ;; create and switch to the perspective's scratch buffer
+ (persp-switch-to-scratch-buffer)
+ (should (equal (buffer-name) "*scratch* (A)"))
+ (should (kill-buffer "*dummy*"))
+ (should-not (get-buffer "*dummy*"))))
(defmacro persp-test-make-sample-environment ()
"Make a test environment with the following window layout: