branch: externals/cape
commit f5364cd1455fae83885092a32ab74e90a177c419
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Add cape-wrap-debug and cape-capf-debug
---
CHANGELOG.org | 4 ++++
README.org | 12 ++++++++----
cape.el | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 73 insertions(+), 4 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 26a1636e02..8eb108dab6 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -2,6 +2,10 @@
#+author: Daniel Mendler
#+language: en
+* Development
+
+- Add =cape-wrap-debug= and =cape-capf-debug= to add debug messages to a Capf.
+
* Version 0.17 (2023-08-14)
- Bugfixes.
diff --git a/README.org b/README.org
index f70a0f6cf2..5a0b2836d4 100644
--- a/README.org
+++ b/README.org
@@ -252,6 +252,7 @@ the Capf transformers with =defalias= to a function symbol.
- ~cape-interactive-capf~, ~cape-interactive~: Create a Capf which can be
called interactively.
- ~cape-wrap-accept-all~, ~cape-capf-accept-all~: Create a Capf which accepts
every input as valid.
+- ~cape-wrap-debug~, ~cape-capf-debug~: Create a Capf which prints debugging
messages.
- ~cape-wrap-silent~, ~cape-capf-silent~: Wrap a chatty Capf and silence it.
- ~cape-wrap-purify~, ~cape-capf-purify~: Purify a broken Capf and ensure that
it does not modify the buffer.
- ~cape-wrap-nonexclusive~, ~cape-capf-nonexclusive:~ Mark Capf as
non-exclusive.
@@ -279,11 +280,14 @@ personal configuration.
(setq-local completion-at-point-functions
(list (cape-capf-prefix-length #'cape-dabbrev 2)))
-;; Example 3: Named Capf
+;; Example 3: Create a Capf with debugging messages
+(setq-local completion-at-point-functions (list (cape-capf-debug #'cape-dict)))
+
+;; Example 4: Named Capf
(defalias 'cape-dabbrev-min-2 (cape-capf-prefix-length #'cape-dabbrev 2))
(setq-local completion-at-point-functions (list #'cape-dabbrev-min-2))
-;; Example 4: Define a defensive Dabbrev Capf, which accepts all inputs. If
you
+;; Example 5: Define a defensive Dabbrev Capf, which accepts all inputs. If
you
;; use Corfu and `corfu-auto=t', the first candidate won't be auto selected if
;; `corfu-preselect=valid', such that it cannot be accidentally committed when
;; pressing RET.
@@ -291,12 +295,12 @@ personal configuration.
(cape-wrap-accept-all #'cape-dabbrev))
(add-to-list 'completion-at-point-functions #'my-cape-dabbrev-accept-all)
-;; Example 5: Define interactive Capf which can be bound to a key. Here we
wrap
+;; Example 6: Define interactive Capf which can be bound to a key. Here we
wrap
;; the `elisp-completion-at-point' such that we can complete Elisp code
;; explicitly in arbitrary buffers.
(keymap-global-set "C-c p e" (cape-interactive-capf
#'elisp-completion-at-point))
-;; Example 6: Ignore :keywords in Elisp completion.
+;; Example 7: Ignore :keywords in Elisp completion.
(defun ignore-elisp-keywords (sym)
(not (keywordp sym)))
(setq-local completion-at-point-functions
diff --git a/cape.el b/cape.el
index fe45aa2abd..0ae93c0190 100644
--- a/cape.el
+++ b/cape.el
@@ -203,6 +203,45 @@ BODY is the wrapping expression."
(let ((default-directory dir)
(non-essential t))))))
+(defun cape--debug-print (obj &optional full)
+ "Print OBJ as string, truncate lists if FULL is nil."
+ (cond
+ ((symbolp obj) (symbol-name obj))
+ ((functionp obj) "#<function>")
+ ((and (consp obj) (ignore-errors (length obj)))
+ (concat
+ "("
+ (string-join (mapcar #'cape--debug-print (if full obj (take 5 obj))) " ")
+ (if (and (not full) (length> obj 5)) " ...)" ")")))
+ (t (let ((print-level 2))
+ (prin1-to-string obj)))))
+
+(defun cape--debug-table (table name)
+ "Create completion TABLE with debug messages.
+NAME is the name of the Capf."
+ ;; TODO reuse `cape--wrapped-table'
+ (lambda (str pred action)
+ (let ((result (complete-with-action action table str pred)))
+ (if (and (eq action 'completion--unquote) (functionp (cadr result)))
+ (cl-callf cape--debug-table (cadr result) name)
+ (message
+ "%s(action=%S prefix=%S ignore-case=%S%s%s) => %s"
+ name
+ (pcase action
+ ('nil 'try)
+ ('t 'all)
+ ('lambda 'test)
+ (_ action))
+ str completion-ignore-case
+ (if completion-regexp-list
+ (format " regexp=%s" (cape--debug-print completion-regexp-list t))
+ "")
+ (if pred
+ (format " predicate=%s" (cape--debug-print pred))
+ "")
+ (cape--debug-print result)))
+ result)))
+
(cl-defun cape--table-with-properties (table &key category (sort t)
&allow-other-keys)
"Create completion TABLE with properties.
CATEGORY is the optional completion category.
@@ -852,6 +891,26 @@ changed. The function `cape-company-to-capf' is
experimental."
(interactive (list t))
(if interactive (cape-interactive capf) (funcall capf))))
+;;;###autoload
+(defun cape-wrap-debug (capf)
+ "Call CAPF and return a completion table which prints trace messages."
+ (let ((name (if (symbolp capf) (symbol-name capf) "capf")))
+ (pcase (funcall capf)
+ (`(,beg ,end ,table . ,plist)
+ (let* ((count 0)
+ (cands (all-completions "" table
+ (lambda (&rest _) (< (cl-incf count)
5)))))
+ (message
+ "%s() => beg=%s end=%s candidates=(%s%s)%s"
+ name beg end
+ (string-join (mapcar #'prin1-to-string cands) " ")
+ (and (> count 5) " ...")
+ (if plist (format " plist=%s" (cape--debug-print plist t)) "")))
+ `(,beg ,end ,(cape--debug-table table name) . ,plist))
+ (result
+ (message "%s() => %s (No completion)"
+ name (cape--debug-print result))))))
+
;;;###autoload
(defun cape-wrap-buster (capf &optional valid)
"Call CAPF and return a completion table with cache busting.
@@ -1014,6 +1073,8 @@ This function can be used as an advice around an existing
Capf."
(cape--capf-wrapper buster)
;;;###autoload (autoload 'cape-capf-case-fold "cape")
(cape--capf-wrapper case-fold)
+;;;###autoload (autoload 'cape-capf-debug "cape")
+(cape--capf-wrapper debug)
;;;###autoload (autoload 'cape-capf-inside-comment "cape")
(cape--capf-wrapper inside-comment)
;;;###autoload (autoload 'cape-capf-inside-string "cape")
