[emacs] lexical binding i guess

1 files changed, 54 insertions, 25 deletions

diff --git a/emacs/inits/11-completion.el b/emacs/inits/11-completion.el
index c5fd883..654ee5c 100644
--- a/emacs/inits/11-completion.el
+++ b/emacs/inits/11-completion.el
@@ -1,4 +1,6 @@
-;; Time-stamp: <2026-04-05 20h56 BST (anker)>
+;;; -*- lexical-binding: t -*-
+
+;; Time-stamp: <2026-08-25 15h27 BST (581d7bf5)>
 
 (use-package savehist
   :ensure t
@@ -33,32 +35,59 @@
 
   :init
   (defun my-completing-read-in-region (start end collection &optional predicate)
-    "Prompt for completion of region in the minibuffer if non-unique."
+    "Prompt for completion of region in the minibuffer."
     (barf-if-buffer-read-only)
     (let* ((initial (buffer-substring-no-properties start end))
-           (metadata (completion-metadata initial collection predicate))
-           (all (completion-all-completions initial collection predicate
-                                            (if (<= start (point) end)
-                                                (- (point) start)
-                                              (length initial)))))
-      (when-let ((last (last all)))
-        (setcdr last nil))
-      (let ((completion (cond
-                         ((null all) nil)
-                         ((and (consp all) (null (cdr all))) (car all))
-                         (t (completing-read "Completion: " collection
-                                             predicate t initial)))))
-        (cond
-         (completion
-          (completion--replace start end completion)
-          (let ((exit-fn (completion-metadata-get metadata 'exit-function)))
-            (when exit-fn
-              (funcall exit-fn completion
-                       (if (eq (try-completion completion collection predicate) t)
-                           'finished 'exact))))
-          t)
-         (t (message "No completion") nil)))))
-
+           (source-buffer (current-buffer))
+           (wrapped-table
+            (if (functionp collection)
+                `(lambda (str pred action)
+                   (let ((result (with-current-buffer ,source-buffer
+                                   (funcall ',collection str pred action))))
+                     (if (eq action 'metadata)
+                         (cons 'metadata
+                               (mapcar
+                                (lambda (x)
+                                  (if (and (consp x)
+                                           (symbolp (car x))
+                                           (string-suffix-p
+                                            "-function" (symbol-name (car x)))
+                                           (functionp (cdr x)))
+                                      (cons (car x)
+                                            `(lambda (&rest args)
+                                               (with-current-buffer ,',source-buffer
+                                                 (apply ',(cdr x) args))))
+                                    x))
+                                (cdr result)))
+                       result)))
+              collection))
+           (exit-fn (plist-get completion-extra-properties :exit-function))
+           (ann-fun (plist-get completion-extra-properties :annotation-function))
+           (aff-fun (plist-get completion-extra-properties :affixation-function))
+           (completion-extra-properties
+            `(,@(and ann-fun
+                     (list :annotation-function
+                           `(lambda (&rest args)
+                              (with-current-buffer ,source-buffer
+                                (apply ',ann-fun args)))))
+              ,@(and aff-fun
+                     (list :affixation-function
+                           `(lambda (&rest args)
+                              (with-current-buffer ,source-buffer
+                                (apply ',aff-fun args)))))))
+           (minibuffer-allow-text-properties t)
+           (enable-recursive-minibuffers t)
+           (completion (completing-read "Completion: " wrapped-table
+                                        predicate t initial)))
+      (cond
+       ((and completion (not (string-empty-p completion)))
+        (completion--replace start end completion)
+        (when exit-fn
+          (funcall exit-fn completion
+                   (if (eq (try-completion completion collection predicate) t)
+                       'finished 'exact)))
+        t)
+       (t ([message]I "No completion") nil))))
 
   (defun my-icomplete-backspace ()
     "Delete back to previous / in paths, or normal backspace otherwise."