branch: externals/compat
commit efb9ff712a968c506eeb28ab2804e8a282570c0e
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@posteo.net>
Add completion-table-merge and completion-table-with-cache
---
MANUAL | 3 +++
compat-24.el | 47 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 50 insertions(+)
diff --git a/MANUAL b/MANUAL
index 04aefe7d6c..2421779067 100644
--- a/MANUAL
+++ b/MANUAL
@@ -116,6 +116,9 @@ provided by compat by default:
- Function ~bool-vector-subsetp~ :: See [[info:elisp#Bool-Vectors][(elisp)
Bool-Vectors]].
- Function ~bool-vector-count-consecutive~ :: See
[[info:elisp#Bool-Vectors][(elisp) Bool-Vectors]].
- Function ~bool-vector-count-population~ :: See
[[info:elisp#Bool-Vectors][(elisp) Bool-Vectors]].
+- Function ~completion-table-merge~ :: See [[info:elisp#Basic
Completion][(elisp) Basic Completion]].
+- Function ~completion-table-with-cache~ :: See [[info:elisp#Programmed
Completion][(elisp) Programmed
+ Completion]].
These functions are prefixed with ~compat~ prefix, and are only loaded
when ~compat-24~ is required:
diff --git a/compat-24.el b/compat-24.el
index d8baecb6cd..29b5a1e22e 100644
--- a/compat-24.el
+++ b/compat-24.el
@@ -340,6 +340,53 @@ Defaults to `error'."
(delete-dups (copy-sequence (cons name conditions))))
(when message (put name 'error-message message))))
+;;;; Defined in minibuffer.el
+
+(compat-defun completion-table-with-cache (fun &optional ignore-case)
+ "Create dynamic completion table from function FUN, with cache.
+This is a wrapper for `completion-table-dynamic' that saves the last
+argument-result pair from FUN, so that several lookups with the
+same argument (or with an argument that starts with the first one)
+only need to call FUN once. This can be useful when FUN performs a
+relatively slow operation, such as calling an external process.
+
+When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
+ :version "24.4"
+ (let* (last-arg last-result
+ (new-fun
+ (lambda (arg)
+ (if (and last-arg (string-prefix-p last-arg arg ignore-case))
+ last-result
+ (prog1
+ (setq last-result (funcall fun arg))
+ (setq last-arg arg))))))
+ (completion-table-dynamic new-fun)))
+
+(compat-defun completion-table-merge (&rest tables)
+ "Create a completion table that collects completions from all TABLES."
+ :version "24.4"
+ (lambda (string pred action)
+ (cond
+ ((null action)
+ (let ((retvals (mapcar (lambda (table)
+ (try-completion string table pred))
+ tables)))
+ (if (member string retvals)
+ string
+ (try-completion string
+ (mapcar (lambda (value)
+ (if (eq value t) string value))
+ (delq nil retvals))
+ pred))))
+ ((eq action t)
+ (apply #'append (mapcar (lambda (table)
+ (all-completions string table pred))
+ tables)))
+ (t
+ (completion--some (lambda (table)
+ (complete-with-action action table string pred))
+ tables)))))
+
;;;; Defined in subr-x.el
(compat-advise require (feature &rest args)
