From e18cf02e22049ad3cc4ce96059edc37a5ecb6719 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Wed, 1 Jul 2026 22:14:07 -0400 Subject: feat(buffer-file): confirmation policy for the destructive C-; b operations Delete file (D) ran with no confirmation at all; erase, clear-to-top/bottom, and revert were a single keystroke from destroying unsaved edits; and raw revert-buffer prompted even when there was nothing to lose. Policy now: delete always confirms, naming the file (the VC path keeps vc-delete-file's own prompt); erase/clear/revert confirm only when a file-visiting buffer has unsaved edits, and stay fast otherwise. The delete workhorse is split into an unconfirmed internal so its existing tests keep exercising the file mechanics; 13 new tests cover the policy. --- ...est-custom-buffer-file--destructive-confirms.el | 163 +++++++++++++++++++++ ...st-custom-buffer-file-delete-buffer-and-file.el | 80 +++++----- 2 files changed, 205 insertions(+), 38 deletions(-) create mode 100644 tests/test-custom-buffer-file--destructive-confirms.el (limited to 'tests') diff --git a/tests/test-custom-buffer-file--destructive-confirms.el b/tests/test-custom-buffer-file--destructive-confirms.el new file mode 100644 index 00000000..bf50f348 --- /dev/null +++ b/tests/test-custom-buffer-file--destructive-confirms.el @@ -0,0 +1,163 @@ +;;; test-custom-buffer-file--destructive-confirms.el --- C-; b destructive-op confirms -*- lexical-binding: t; -*- + +;;; Commentary: +;; The C-; b map carries high-blast-radius operations. Policy: +;; - delete file (D) always confirms, naming the file (vc-delete-file +;; already prompts on the VC path, so the wrapper guards only non-VC). +;; - erase (x), clear-to-top (t), clear-to-bottom (b), and revert (g) +;; confirm only when a file-visiting buffer has unsaved edits -- +;; destroying unsaved work is the hazard; anything else is cheap to +;; restore. Non-file buffers and unmodified buffers stay fast. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") +(provide 'ps-print) + +(require 'custom-buffer-file) + +(defmacro test-destructive--with-file-buffer (content &rest body) + "Run BODY in a buffer visiting a temp file whose saved content is CONTENT." + (declare (indent 1)) + `(let* ((file (make-temp-file "destructive-confirm-" nil ".txt" ,content)) + (buf (find-file-noselect file))) + (unwind-protect + (with-current-buffer buf ,@body) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf) + (ignore-errors (delete-file file))))) + +(defun test-destructive--deny (&rest _) nil) +(defun test-destructive--allow (&rest _) t) +(defun test-destructive--forbid-prompt (&rest _) + (error "yes-or-no-p should not have been called")) + +;;; erase + +(ert-deftest test-destructive-erase-modified-file-buffer-denied-keeps-content () + "Error: unsaved edits + user says no -> buffer untouched." + (test-destructive--with-file-buffer "saved\n" + (goto-char (point-max)) + (insert "unsaved edit") + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--deny)) + (cj/erase-buffer)) + (should (string-match-p "unsaved edit" (buffer-string))))) + +(ert-deftest test-destructive-erase-modified-file-buffer-confirmed-erases () + "Normal: unsaved edits + user says yes -> erased." + (test-destructive--with-file-buffer "saved\n" + (insert "more") + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--allow)) + (cj/erase-buffer)) + (should (= (buffer-size) 0)))) + +(ert-deftest test-destructive-erase-unmodified-file-buffer-no-prompt () + "Normal: no unsaved edits -> erases without prompting." + (test-destructive--with-file-buffer "saved\n" + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--forbid-prompt)) + (cj/erase-buffer)) + (should (= (buffer-size) 0)))) + +(ert-deftest test-destructive-erase-non-file-buffer-no-prompt () + "Boundary: modified non-file buffer -> erases without prompting." + (with-temp-buffer + (insert "scratch content") + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--forbid-prompt)) + (cj/erase-buffer)) + (should (= (buffer-size) 0)))) + +;;; clear to top / bottom + +(ert-deftest test-destructive-clear-to-bottom-modified-denied-keeps-content () + "Error: unsaved edits + no -> clear-to-bottom leaves buffer alone." + (test-destructive--with-file-buffer "line1\nline2\n" + (insert "edit") + (goto-char (point-min)) + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--deny)) + (cj/clear-to-bottom-of-buffer)) + (should (string-match-p "line2" (buffer-string))))) + +(ert-deftest test-destructive-clear-to-top-modified-denied-keeps-content () + "Error: unsaved edits + no -> clear-to-top leaves buffer alone." + (test-destructive--with-file-buffer "line1\nline2\n" + (goto-char (point-max)) + (insert "edit") + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--deny)) + (cj/clear-to-top-of-buffer)) + (should (string-match-p "line1" (buffer-string))))) + +;;; revert + +(ert-deftest test-destructive-revert-unmodified-no-prompt-rereads-disk () + "Normal: unmodified buffer reverts silently to disk content." + (test-destructive--with-file-buffer "old content\n" + (let ((file buffer-file-name)) + (with-temp-file file (insert "new disk content\n")) + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--forbid-prompt)) + (cj/revert-buffer)) + (should (string-match-p "new disk content" (buffer-string)))))) + +(ert-deftest test-destructive-revert-modified-denied-keeps-edits () + "Error: unsaved edits + no -> edits kept." + (test-destructive--with-file-buffer "saved\n" + (insert "precious edit") + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--deny)) + (cj/revert-buffer)) + (should (string-match-p "precious edit" (buffer-string))))) + +(ert-deftest test-destructive-revert-modified-confirmed-rereads-disk () + "Normal: unsaved edits + yes -> disk content restored." + (test-destructive--with-file-buffer "saved content\n" + (insert "discard me") + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--allow)) + (cj/revert-buffer)) + (should-not (string-match-p "discard me" (buffer-string))) + (should (string-match-p "saved content" (buffer-string))))) + +(ert-deftest test-destructive-revert-non-file-buffer-user-errors () + "Error: revert in a non-file buffer signals `user-error'." + (with-temp-buffer + (should-error (cj/revert-buffer) :type 'user-error))) + +;;; delete file + +(ert-deftest test-destructive-delete-denied-keeps-file-and-buffer () + "Error: user says no -> file stays on disk, buffer stays alive." + (test-destructive--with-file-buffer "keep me\n" + (let ((file buffer-file-name) + (buf (current-buffer))) + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--deny)) + (cj/delete-buffer-and-file)) + (should (file-exists-p file)) + (should (buffer-live-p buf))))) + +(ert-deftest test-destructive-delete-confirmed-removes-file () + "Normal: user says yes -> file deleted and buffer killed." + (let* ((file (make-temp-file "destructive-delete-" nil ".txt" "bye\n")) + (buf (find-file-noselect file))) + (unwind-protect + (with-current-buffer buf + (cl-letf (((symbol-function 'yes-or-no-p) #'test-destructive--allow) + ((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file)) + (should-not (file-exists-p file))) + (when (buffer-live-p buf) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file file))))) + +;;; keymap + +(ert-deftest test-destructive-keymap-points-at-guarded-commands () + "Smoke: x and g on C-; b now run the guarded wrappers." + (should (eq (keymap-lookup cj/buffer-and-file-map "x") #'cj/erase-buffer)) + (should (eq (keymap-lookup cj/buffer-and-file-map "g") #'cj/revert-buffer))) + +(provide 'test-custom-buffer-file--destructive-confirms) +;;; test-custom-buffer-file--destructive-confirms.el ends here diff --git a/tests/test-custom-buffer-file-delete-buffer-and-file.el b/tests/test-custom-buffer-file-delete-buffer-and-file.el index 4af8d2a7..2c009f99 100644 --- a/tests/test-custom-buffer-file-delete-buffer-and-file.el +++ b/tests/test-custom-buffer-file-delete-buffer-and-file.el @@ -1,7 +1,11 @@ -;;; test-custom-buffer-file-delete-buffer-and-file.el --- Tests for cj/delete-buffer-and-file -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-delete-buffer-and-file.el --- Tests for cj/--delete-buffer-and-file -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/delete-buffer-and-file function from custom-buffer-file.el +;; Tests for the cj/--delete-buffer-and-file function from custom-buffer-file.el +;; +;; These tests target the unconfirmed internal (cj/--delete-buffer-and-file); +;; the always-confirm interactive wrapper is covered in +;; test-custom-buffer-file--destructive-confirms.el. ;; ;; This function deletes both the current buffer and the file it visits. ;; It uses vc-delete-file for version-controlled files and delete-file @@ -75,7 +79,7 @@ (let ((buf (current-buffer))) ;; Mock vc-backend to return nil (non-VC file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)) (should-not (buffer-live-p buf))))) (test-delete-buffer-and-file-teardown))) @@ -90,7 +94,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -105,7 +109,7 @@ (find-file test-file) (let ((buf (current-buffer))) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (buffer-live-p buf))))) (test-delete-buffer-and-file-teardown))) @@ -123,7 +127,7 @@ ((symbol-function 'delete-file) (lambda (file trash) (setq delete-file-args (list file trash))))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should (equal delete-file-args (list test-file t))))) (test-delete-buffer-and-file-teardown))) @@ -141,7 +145,7 @@ ((symbol-function 'message) (lambda (fmt &rest args) (setq message-output (apply #'format fmt args))))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should (string-match-p "Deleted file.*test.txt" message-output)))) (test-delete-buffer-and-file-teardown))) @@ -164,7 +168,7 @@ (kill-buffer (get-file-buffer file))) ;; Actually delete the file for test cleanup (delete-file file t)))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should (string= vc-delete-called test-file)))) (test-delete-buffer-and-file-teardown))) @@ -182,7 +186,7 @@ ((symbol-function 'delete-file) (lambda (file trash) (setq delete-file-called file)))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should (string= delete-file-called test-file)))) (test-delete-buffer-and-file-teardown))) @@ -196,7 +200,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (let ((result (cj/delete-buffer-and-file))) + (let ((result (cj/--delete-buffer-and-file))) ;; kill-buffer returns t, so result should be t (should (eq result t))))) (test-delete-buffer-and-file-teardown))) @@ -212,7 +216,7 @@ (with-temp-file test-file) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -227,7 +231,7 @@ (insert large-content)) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -243,7 +247,7 @@ (insert binary-content)) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -258,7 +262,7 @@ (insert content)) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -274,7 +278,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -288,7 +292,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -302,7 +306,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -316,7 +320,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -330,7 +334,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -345,7 +349,7 @@ (insert "content")) (find-file test-file) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -364,7 +368,7 @@ (should (buffer-modified-p)) (let ((buf (current-buffer))) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)) (should-not (buffer-live-p buf))))) (test-delete-buffer-and-file-teardown))) @@ -381,7 +385,7 @@ (read-only-mode 1) (let ((buf (current-buffer))) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)) (should-not (buffer-live-p buf))))) (test-delete-buffer-and-file-teardown))) @@ -401,7 +405,7 @@ (switch-to-buffer (get-file-buffer test-file)) (let ((buf (current-buffer))) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)) (should-not (buffer-live-p buf)))) (delete-other-windows)) @@ -422,7 +426,7 @@ (find-file file2) ;; Current buffer is file2 (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) ;; file2 should be deleted, file1 should still exist (should-not (file-exists-p file2)) (should (file-exists-p file1))) @@ -443,7 +447,7 @@ (narrow-to-region (point) (line-end-position)) (let ((buf (current-buffer))) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)) (should-not (buffer-live-p buf))))) (test-delete-buffer-and-file-teardown))) @@ -457,7 +461,7 @@ (with-temp-buffer (rename-buffer "non-file-buffer" t) (let ((buf (current-buffer))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) ;; Buffer should still be alive (should (buffer-live-p buf)))) (test-delete-buffer-and-file-teardown))) @@ -467,7 +471,7 @@ (test-delete-buffer-and-file-setup) (unwind-protect (with-current-buffer "*scratch*" - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) ;; Scratch buffer should still exist (should (get-buffer "*scratch*"))) (test-delete-buffer-and-file-teardown))) @@ -485,7 +489,7 @@ (kill-buffer buf) (should-error (with-current-buffer buf - (cj/delete-buffer-and-file)))) + (cj/--delete-buffer-and-file)))) (test-delete-buffer-and-file-teardown))) ;;; Error Cases - File Issues @@ -504,7 +508,7 @@ (lambda (file &optional _trash) (signal 'file-missing (list "Removing old name" "No such file or directory" file))))) ;; Should propagate error from delete-file - (should-error (cj/delete-buffer-and-file) :type 'file-missing))) + (should-error (cj/--delete-buffer-and-file) :type 'file-missing))) (test-delete-buffer-and-file-teardown))) (ert-deftest test-delete-buffer-and-file-no-delete-permission () @@ -521,7 +525,7 @@ (lambda (file &optional _trash) (signal 'file-error (list "Removing old name" "Permission denied" file))))) ;; Should propagate error from delete-file - (should-error (cj/delete-buffer-and-file) :type 'file-error))) + (should-error (cj/--delete-buffer-and-file) :type 'file-error))) (test-delete-buffer-and-file-teardown))) (ert-deftest test-delete-buffer-and-file-no-write-permission-directory () @@ -535,7 +539,7 @@ (find-file test-file) (set-file-modes test-dir #o555) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (should-error (cj/delete-buffer-and-file)) + (should-error (cj/--delete-buffer-and-file)) (set-file-modes test-dir #o755))) (test-delete-buffer-and-file-teardown))) @@ -554,7 +558,7 @@ ;; Both buffers visiting same file (should (eq buf1 buf2)) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)) (should-not (buffer-live-p buf1)))))) (test-delete-buffer-and-file-teardown))) @@ -571,7 +575,7 @@ (make-symbolic-link real-file symlink) (find-file symlink) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) ;; Symlink should be deleted, real file should remain (should-not (file-exists-p symlink)) (should (file-exists-p real-file)))) @@ -590,7 +594,7 @@ (let ((file-via-link (expand-file-name "test.txt" link-dir))) (find-file file-via-link) (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) ;; File should be deleted (should-not (file-exists-p test-file))))) (test-delete-buffer-and-file-teardown))) @@ -614,7 +618,7 @@ (when (get-file-buffer file) (kill-buffer (get-file-buffer file))) (delete-file file t)))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should vc-delete-called))) (test-delete-buffer-and-file-teardown))) @@ -629,7 +633,7 @@ (find-file test-file) ;; vc-backend returns nil for untracked files (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should-not (file-exists-p test-file)))) (test-delete-buffer-and-file-teardown))) @@ -647,7 +651,7 @@ (lambda (file) (setq backend-checked file) nil))) - (cj/delete-buffer-and-file) + (cj/--delete-buffer-and-file) (should (string= backend-checked test-file)))) (test-delete-buffer-and-file-teardown))) @@ -664,7 +668,7 @@ ((symbol-function 'vc-delete-file) (lambda (file) (error "VC operation failed")))) - (should-error (cj/delete-buffer-and-file)))) + (should-error (cj/--delete-buffer-and-file)))) (test-delete-buffer-and-file-teardown))) (provide 'test-custom-buffer-file-delete-buffer-and-file) -- cgit v1.2.3