bug#42386: Acknowledgement ([PATCH] Handle symbols in project-kill-buffers-ignores)

classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

bug#42386: Acknowledgement ([PATCH] Handle symbols in project-kill-buffers-ignores)

Dmitry Gutov
Hey Philip,

How's it going?

On 21.07.2020 21:51, Philip K. wrote:
> You're right, I forgot to stage that.

I can fix up the minor nits and push the patch now, if you like.

Just wanted to make sure you didn't come upon any more significant
problems in daily usage.



Reply | Threaded
Open this post in threaded view
|

bug#42386: Acknowledgement ([PATCH] Handle symbols in project-kill-buffers-ignores)

Philip K.-3

I actually sent a patch yesterday, but thanks to your message I realised
that my messages weren't being sent (new mail provider, didn't configure
it properly).

I attached the patch below, and hope everything works now.

Dmitry Gutov <[hidden email]> writes:

> Hey Philip,
>
> How's it going?

> On 21.07.2020 21:51, Philip K. wrote:
>> You're right, I forgot to stage that.
>
> I can fix up the minor nits and push the patch now, if you like.
>
> Just wanted to make sure you didn't come upon any more significant
> problems in daily usage.


--
        Philip K.


From ae708413a583fa48ed175ac51a465958030d914a Mon Sep 17 00:00:00 2001
From: Philip K <[hidden email]>
Date: Mon, 20 Jul 2020 21:20:34 +0200
Subject: [PATCH] Add project-kill-buffer-conditions

This replaces its negation, project-kill-buffers-ignores, from the
previous version.
---
 lisp/progmodes/project.el | 134 ++++++++++++++++++++++++++++++--------
 1 file changed, 107 insertions(+), 27 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 67ce3dc7d9..237bc1635e 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -843,16 +843,56 @@ project-switch-to-buffer
       nil
       predicate))))
 
-(defcustom project-kill-buffers-ignores
-  '("\\*Help\\*")
-  "Conditions for buffers `project-kill-buffers' should not kill.
-Each condition is either a regular expression matching a buffer
-name, or a predicate function that takes a buffer object as
-argument and returns non-nil if it matches.  Buffers that match
-any of the conditions will not be killed."
-  :type '(repeat (choice regexp function))
+(defcustom project-kill-buffer-conditions
+  '(buffer-file-name    ; All file-visiting buffers are included.
+    ;; Most of the temp buffers in the background:
+    (major-mode . fundamental-mode)
+    ;; non-text buffer such as xref, occur, vc, log, ...
+    (and (derived-mode . special-mode)
+         (not (major-mode . help-mode)))
+    (derived-mode . compilation-mode)
+    (derived-mode . dired-mode)
+    (derived-mode . diff-mode))
+  "List of conditions for how to kill buffers related to a project.
+This list is used by `project-kill-buffers'.
+Each condition is either:
+- a regular expression, to match a buffer name,
+- a predicate function that takes a buffer object as argument
+  and returns non-nil if the buffer should be killed,
+- a symbol, denoting a buffer local variable, where the buffer
+  is killed if it's value is non-nil.  If the symbol also has a
+  function slot, it will be interpreted as a function first.
+- a cons-cell, where the car describes how to interpret the cdr.
+  The car can be one of the following:
+  * `major-mode': the buffer is killed if the buffers major
+    mode is eq to the cons-cell's cdr
+  * `defived-mode': the buffer is killed if the buffers major
+    mode is derived from the major mode denoted by the cons-cell's
+    cdr
+  * `not': the cdr is interpreted as a negation of a condition.
+  * `and': the cdr is a list of recursive conditions, that all have
+    to be met.
+  * `or': the cdr is a list of recursive conditions, of which at
+    least one has to be met.
+
+If any of these conditions are satified, a buffer will be
+killed.  By default buffers are left alone, so that
+`project-kill-buffers' doesn't accidentally delete more than it
+should."
+  :type '(repeat (choice regexp function symbol
+                         (cons :tag "Major mode"
+                               (const major-mode) symbol)
+                         (cons :tag "Derived mode"
+                               (const derived-mode) symbol)
+                         (cons :tag "Negation"
+                               (const not) sexp)
+                         (cons :tag "Conjunction"
+                               (const and) sexp)
+                         (cons :tag "Disjunction"
+                               (const or) sexp)))
   :version "28.1"
-  :package-version '(project . "0.5.0"))
+  :group 'project
+  :package-version '(project . "0.6.0"))
 
 (defun project--buffer-list (pr)
   "Return the list of all buffers in project PR."
@@ -864,26 +904,66 @@ project--buffer-list
         (push buf bufs)))
     (nreverse bufs)))
 
-;;;###autoload
-(defun project-kill-buffers ()
-  "Kill all live buffers belonging to the current project.
-Two buffers belong to the same project if their project instances,
-as reported by `project-current' in each buffer, are identical.
-Certain buffers may be \"spared\", see `project-kill-buffers-ignores'."
-  (interactive)
-  (let ((pr (project-current t)) bufs)
+(defun project--kill-buffer-check (buf conditions)
+  "Check if buffer BUF matches any element of the list CONDITIONS.
+See `project-kill-buffer-conditions' for more details on the form
+of CONDITIONS."
+  (catch 'kill
+    (dolist (c conditions)
+      (when (cond
+             ((stringp c)
+              (string-match-p c (buffer-name buf)))
+             ((symbolp c)
+              (funcall c buf))
+             ((eq (car-safe c) 'major-mode)
+              (eq (buffer-local-value 'major-mode buf)
+                  (cdr c)))
+             ((eq (car-safe c) 'derived-mode)
+              (provided-mode-derived-p
+               (buffer-local-value 'major-mode buf)
+               (cdr c)))
+             ((eq (car-safe c) 'not)
+              (not (project--kill-buffer-check buf (cdr c))))
+             ((eq (car-safe c) 'or)
+              (project--kill-buffer-check buf (cdr c)))
+             ((eq (car-safe c) 'and)
+              (seq-every-p
+               (apply-partially #'project--kill-buffer-check
+                                buf)
+               (mapcar #'list (cdr c)))))
+        (throw 'kill t)))))
+
+(defun project-list-buffers-to-kill (pr)
+  "Return list of buffers in project PR to kill.
+What buffers should or should not be killed is described
+in `project-kill-buffer-conditions'."
+  (let (bufs)
     (dolist (buf (project--buffer-list pr))
-      (unless (seq-some
-               (lambda (c)
-                 (cond ((stringp c)
-                        (string-match-p c (buffer-name buf)))
-                       ((functionp c)
-                        (funcall c buf))))
-               project-kill-buffers-ignores)
+      (when (project--kill-buffer-check buf project-kill-buffer-conditions)
         (push buf bufs)))
-    (when (yes-or-no-p (format "Kill %d buffers in %s? "
-                               (length bufs) (project-root pr)))
-      (mapc #'kill-buffer bufs))))
+    bufs))
+
+;;;###autoload
+(defun project-kill-buffers (&optional no-confirm)
+  "Kill all live buffers belonging to the current project.
+Two buffers belong to the same project if their project
+instances, as reported by `project-current' in each buffer, are
+identical.  Only the buffers that match a condition in
+`project-kill-buffer-conditions' will be killed.  If NO-CONFIRM
+is non-nil, the command will not ask the user for confirmation.
+NO-CONFIRM is always nil when the command is invoked
+interactivly."
+  (interactive)
+  (let* ((pr (project-current t))
+         (bufs (project-list-buffers-to-kill pr)))
+    (cond (no-confirm
+           (mapc #'kill-buffer bufs))
+          ((null bufs)
+           (message "No buffers to kill"))
+          ((yes-or-no-p (format "Kill %d buffers in %s? "
+                                (length bufs)
+                                (project-root pr)))
+           (mapc #'kill-buffer bufs)))))
 
 
 ;;; Project list
--
2.20.1

Reply | Threaded
Open this post in threaded view
|

bug#42386: Acknowledgement ([PATCH] Handle symbols in project-kill-buffers-ignores)

Dmitry Gutov
On 27.07.2020 21:33, Philip K. wrote:
> I actually sent a patch yesterday, but thanks to your message I realised
> that my messages weren't being sent (new mail provider, didn't configure
> it properly).
>
> I attached the patch below, and hope everything works now.

Thanks!

Applied a few minor changes and pushed.