master 5081ab07952: icomplete.el (icomplete-fido-kill): Make it extensible (bug#72210)

branch: master
commit 5081ab0795291f990e6c774d844ac8c4a1707a1d
Author: Stefan Monnier <[email protected]>
Commit: Stefan Monnier <[email protected]>

    icomplete.el (icomplete-fido-kill): Make it extensible (bug#72210)
    
    * lisp/icomplete.el (icomplete-kill-candidate): New generic function.
    (icomplete-fido-kill): Use it instead of hardcoding support for
    files and buffers.
---
 lisp/icomplete.el | 49 +++++++++++++++++++++++++++++++++----------------
 1 file changed, 33 insertions(+), 16 deletions(-)

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 8902cb2354e..d6a326ba88c 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -387,6 +387,32 @@ Return non-nil if something was stepped."
 
 ;;;_* Helpers for `fido-mode' (or `ido-mode' emulation)
 
+(cl-defgeneric icomplete-kill-candidate (category _candidate)
+  "\"Kill\" CANDIDATE, assuming it is of kind CATEGORY.
+CANDIDATE is a string denoting a completion candidate,
+CATEGORY should be a completion category, as specified
+in `completion-metadata'.
+\"Kill\" here means to actually delete the underlying object, such
+as a file, buffer, ...
+Return non-nil if the operation was successful."
+  (error "Don't know how to kill things for category `%s'" category))
+
+(cl-defmethod icomplete-kill-candidate ((_ (eql 'buffer)) thing)
+  (kill-buffer thing))
+
+(cl-defmethod icomplete-kill-candidate ((_ (eql 'file)) thing)
+  ;; FIXME: This makes assumptions about completion style: e.g. with
+  ;; partial-completion, `/usr/s/d/ema' can result in DIR being
+  ;; `/usr/s/d/' and THING being `share/doc/emacs', in which case DIR
+  ;; isn't the right base directory to pass to `expand-file-name'!
+  (let* ((dir (file-name-directory (icomplete--field-string)))
+         (file (expand-file-name thing dir)))
+    (delete-file file)
+    t))
+
+(cl-defmethod icomplete-kill-candidate ((_ (eql 'project-file)) thing)
+  (icomplete-kill-candidate 'file thing))
+
 (defun icomplete-fido-kill ()
   "Kill line or current completion, like `ido-mode'.
 If killing to the end of line make sense, call `kill-line',
@@ -401,26 +427,15 @@ require user confirmation."
         (call-interactively 'kill-line)
       (let* ((all (completion-all-sorted-completions))
              (thing (car all))
-             (cat (icomplete--category))
-             (action
-              (cl-case cat
-                (buffer
-                 (lambda ()
-                   (when (yes-or-no-p (concat "Kill buffer " thing "? "))
-                     (kill-buffer thing))))
-                ((project-file file)
-                 (lambda ()
-                   (let* ((dir (file-name-directory (icomplete--field-string)))
-                          (path (expand-file-name thing dir)))
-                     (when (yes-or-no-p (concat "Delete file " path "? "))
-                       (delete-file path) t))))
-                (t
-                 (error "Sorry, don't know how to kill things for `%s'" cat)))))
+             (cat (icomplete--category)))
         (when (let (;; Allow `yes-or-no-p' to work and don't let it
                     ;; `icomplete-exhibit' anything.
                     (enable-recursive-minibuffers t)
                     (icomplete-mode nil))
-                (funcall action))
+                ;; FIXME: For some categories (like `multi-category'), this
+                ;; results in a poor prompt.
+                (when (yes-or-no-p (format "Kill %s %s? " cat thing))
+                  (icomplete-kill-candidate cat thing)))
           (completion--cache-all-sorted-completions
            (icomplete--field-beg)
            (icomplete--field-end)
@@ -443,6 +458,8 @@ require user confirmation."
                    (file-name-directory (icomplete--field-string))))
          (current (car completion-all-sorted-completions))
          (probe (and dir current
+                     ;; FIXME: Same problem as in
+                     ;; `icomplete-kill-candidate<file>' above.
                      (expand-file-name (directory-file-name current)
                                        (substitute-env-vars dir)))))
     (cond ((and probe (file-directory-p probe) (not (string= current "./")))