From 76828c173a53e001071a5c925d07bf9021e67365 Mon Sep 17 00:00:00 2001 From: Madeleine Sydney Date: Wed, 15 Jan 2025 01:45:14 -0700 Subject: [PATCH] wip: feat: Delete file --- users/crumb/programs/emacs/lib/syd-buffers.el | 116 ++++++++++++++++++ users/crumb/programs/emacs/lib/syd-file.el | 63 ++++++++-- 2 files changed, 171 insertions(+), 8 deletions(-) diff --git a/users/crumb/programs/emacs/lib/syd-buffers.el b/users/crumb/programs/emacs/lib/syd-buffers.el index b8f66ae..d141cbe 100644 --- a/users/crumb/programs/emacs/lib/syd-buffers.el +++ b/users/crumb/programs/emacs/lib/syd-buffers.el @@ -22,4 +22,120 @@ :desc "Sudo save buffer as root. See `doom/sudo-save-buffer'" :interactive t) +(defvar syd-fallback-buffer-name "*scratch*" + "The name of the buffer to fall back to if no other buffers exist (will create +it if it doesn't exist).") + +(defun syd-fallback-buffer () + "Returns the fallback buffer, creating it if necessary. By default this is the +scratch buffer. See `syd-fallback-buffer-name' to change this." + (let (buffer-list-update-hook) + (get-buffer-create syd-fallback-buffer-name))) + +(defvar-local syd-real-buffer-p nil + "If non-nil, this buffer should be considered real no matter what. See +`syd-real-buffer-p' for more information.") + +(defun syd-special-buffer-p (buf) + "Returns non-nil if BUF's name starts and ends with an *." + (char-equal ?* (aref (buffer-name buf) 0))) + +(defun syd-non-file-visiting-buffer-p (buf) + (with-current-buffer buf + (if buffer-file-name t nil))) + +(defvar syd-unreal-buffer-functions + '(minibufferp syd-special-buffer-p syd-non-file-visiting-buffer-p) + "A list of predicate functions run to determine if a buffer is *not* real, +unlike `syd-real-buffer-functions'. They are passed one argument: the buffer to +be tested. + +Should any of these functions return non-nil, the rest of the functions are +ignored and the buffer is considered unreal. + +See `syd-real-buffer-p' for more information.") + +(defun syd-dired-buffer-p (buf) + "Returns non-nil if BUF is a dired buffer." + (provided-mode-derived-p (buffer-local-value 'major-mode buf) + 'dired-mode)) + +(defvar syd-real-buffer-functions + '(syd-dired-buffer-p) + "A list of predicate functions run to determine if a buffer is real, unlike +`syd-unreal-buffer-functions'. They are passed one argument: the buffer to be +tested. + +Should any of its function returns non-nil, the rest of the functions are +ignored and the buffer is considered real. + +See `syd-real-buffer-p' for more information.") + +(defun syd-temp-buffer-p (buf) + "Returns non-nil if BUF is temporary." + (char-equal ?\s (aref (buffer-name buf) 0))) + +(defun syd-real-buffer-p (buffer-or-name) + "Returns t if BUFFER-OR-NAME is a 'real' buffer. + +A real buffer is a useful buffer; a first class citizen. Real ones should get +special treatment, because we will be spending most of our time in them. Unreal +ones should be low-profile and easy to cast aside, so we can focus on real ones. + +The exact criteria for a real buffer is: + + 1. A non-nil value for the buffer-local value of the `syd-real-buffer-p' + variable OR + 2. Any function in `syd-real-buffer-functions' returns non-nil OR + 3. None of the functions in `syd-unreal-buffer-functions' must return + non-nil. + +If BUFFER-OR-NAME is omitted or nil, the current buffer is tested." + (or (bufferp buffer-or-name) + (stringp buffer-or-name) + (signal 'wrong-type-argument (list '(bufferp stringp) buffer-or-name))) + (when-let (buf (get-buffer buffer-or-name)) + (when-let (basebuf (buffer-base-buffer buf)) + (setq buf basebuf)) + (and (buffer-live-p buf) + (not (syd-temp-buffer-p buf)) + (or (buffer-local-value 'syd-real-buffer-p buf) + (run-hook-with-args-until-success 'syd-real-buffer-functions buf) + (not (run-hook-with-args-until-success 'syd-unreal-buffer-functions buf)))))) + +(defun syd-unreal-buffer-p (buffer-or-name) + "Return t if BUFFER-OR-NAME is an 'unreal' buffer. + +See `syd-real-buffer-p' for details on what that means." + (not (syd-real-buffer-p buffer-or-name))) + +(defun syd-fixup-windows (windows) + "Ensure that each of WINDOWS is showing a real buffer or the fallback buffer." + (dolist (window windows) + (with-selected-window window + (when (syd-unreal-buffer-p (window-buffer)) + (previous-buffer) + (when (syd-unreal-buffer-p (window-buffer)) + (switch-to-buffer (syd-fallback-buffer))))))) + +(defun syd-kill-buffer-fixup-windows (buffer) + "Kill the BUFFER and ensure all the windows it was displayed in have switched +to a real buffer or the fallback buffer." + (let ((windows (get-buffer-window-list buffer))) + (kill-buffer buffer) + (syd-fixup-windows (cl-remove-if-not #'window-live-p windows)))) + +(defun syd/kill-this-buffer-in-all-windows (buffer &optional dont-save) + "Kill BUFFER globally and ensure all windows previously showing this buffer +have switched to a real buffer or the fallback buffer. + +If DONT-SAVE, don't prompt to save modified buffers (discarding their changes)." + (interactive + (list (current-buffer) current-prefix-arg)) + (cl-assert (bufferp buffer) t) + (when (and (buffer-modified-p buffer) dont-save) + (with-current-buffer buffer + (set-buffer-modified-p nil))) + (syd-kill-buffer-fixup-windows buffer)) + (provide 'syd-buffers) diff --git a/users/crumb/programs/emacs/lib/syd-file.el b/users/crumb/programs/emacs/lib/syd-file.el index 9dca811..3ab7c0b 100644 --- a/users/crumb/programs/emacs/lib/syd-file.el +++ b/users/crumb/programs/emacs/lib/syd-file.el @@ -1,16 +1,60 @@ ;;; syd-file.el -*- lexical-binding: t; -*- (require 'syd-prelude) +(require 'syd-buffers) (syd-define-stub syd/copy-this-file :desc "Copy current file. See `doom/copy-this-file'." :interactive t) -(syd-define-stub - syd/delete-this-file - :desc "Delete current file. See `doom/delete-this-file'." - :interactive t) +(defun syd-files--update-refs (&rest files) + "Ensure FILES are updated in `recentf', `magit' and `save-place'." + (let (toplevels) + (dolist (file files) + (when (featurep 'vc) + (vc-file-clearprops file) + (when-let (buffer (get-file-buffer file)) + (with-current-buffer buffer + (vc-refresh-state)))) + (when (featurep 'magit) + (when-let (default-directory + (magit-toplevel (file-name-directory file))) + (cl-pushnew default-directory toplevels))) + (unless (file-readable-p file) + (when (bound-and-true-p recentf-mode) + (recentf-remove-if-non-kept file)) + (dolist (default-directory toplevels) + (magit-refresh)) + (when (bound-and-true-p save-place-mode) + (save-place-forget-unreadable-files)))))) + +(defun syd/delete-this-file (&optional path force-p) + "Delete PATH, kill its buffers and expunge it from vc/magit cache. + +If PATH is not specified, default to the current buffer's file. + +If FORCE-P, delete without confirmation." + (interactive (list (buffer-file-name (buffer-base-buffer)) + current-prefix-arg)) + (let* ((path (or path (buffer-file-name (buffer-base-buffer)))) + (short-path (and path (abbreviate-file-name path)))) + (unless path + (user-error "Buffer is not visiting any file")) + (unless (file-exists-p path) + (error "File doesn't exist: %s" path)) + (unless (or force-p (y-or-n-p (format "Really delete %S?" short-path))) + (user-error "Aborted")) + (let ((buf (current-buffer))) + (unwind-protect + (progn (delete-file path t) t)) + (if (file-exists-p path) + (error "Failed to delete %S" short-path) + ;; Ensures that windows displaying this buffer will be switched to + ;; real buffers (`doom-real-buffer-p') + (syd/kill-this-buffer-in-all-windows buf t) + (syd-files--update-refs path) + (message "Deleted %S" short-path))))) (syd-define-stub syd/move-this-file @@ -32,10 +76,13 @@ :desc "Yank buffer path." :interactive t) -(syd-define-stub - syd/find-file-in-emacs-user-directory - :desc "Find file in `emacs-user-directory'. See `doom/open-private-config'." - :interactive t) +(defun syd/find-file-in-emacs-user-directory () + (interactive) + (unless (file-directory-p user-emacs-directory) + (user-error "`emacs-user-directory' doesn't exist! (%s)" + (abbreviate-file-name emacs-user-directory))) + (let ((default-directory user-emacs-directory)) + (call-interactively #'find-file))) (syd-define-stub syd/open-this-file-as-root