branch: externals/company
commit 374322ceac9bf387c539d0ab047e0a9bb87ce181
Author: Dmitry Gutov <dmi...@gutov.dev>
Commit: Dmitry Gutov <dmi...@gutov.dev>
Add caching helpers and use them in company-dabbrev and company-ispell
Previously described in #285.
---
company-dabbrev.el | 33 +++++++++++++++++++--------------
company-ispell.el | 36 ++++++++++++++++++++++--------------
company.el | 31 +++++++++++++++++++++++++++++++
3 files changed, 72 insertions(+), 28 deletions(-)
diff --git a/company-dabbrev.el b/company-dabbrev.el
index b7434de393..d8a3d0ede0 100644
--- a/company-dabbrev.el
+++ b/company-dabbrev.el
@@ -1,6 +1,6 @@
;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*-
lexical-binding: t -*-
-;; Copyright (C) 2009-2011, 2013-2018, 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2013-2018, 2021-2023 Free Software Foundation,
Inc.
;; Author: Nikolaj Schumacher
@@ -180,6 +180,19 @@ This variable affects both `company-dabbrev' and
`company-dabbrev-code'."
(let ((completion-ignore-case company-dabbrev-ignore-case))
(all-completions prefix candidates)))
+(defun company-dabbrev--fetch ()
+ (let ((words (company-dabbrev--search (company-dabbrev--make-regexp)
+ company-dabbrev-time-limit
+ (pcase company-dabbrev-other-buffers
+ (`t (list major-mode))
+ (`all `all))))
+ (downcase-p (if (eq company-dabbrev-downcase 'case-replace)
+ case-replace
+ company-dabbrev-downcase)))
+ (if downcase-p
+ (mapcar 'downcase words)
+ words)))
+
;;;###autoload
(defun company-dabbrev (command &optional arg &rest _ignored)
"dabbrev-like `company-mode' completion backend."
@@ -188,20 +201,12 @@ This variable affects both `company-dabbrev' and
`company-dabbrev-code'."
(interactive (company-begin-backend 'company-dabbrev))
(prefix (company-dabbrev--prefix))
(candidates
- (let* ((case-fold-search company-dabbrev-ignore-case)
- (words (company-dabbrev--search (company-dabbrev--make-regexp)
- company-dabbrev-time-limit
- (pcase
company-dabbrev-other-buffers
- (`t (list major-mode))
- (`all `all))))
- (downcase-p (if (eq company-dabbrev-downcase 'case-replace)
- case-replace
- company-dabbrev-downcase)))
- (setq words (company-dabbrev--filter arg words))
- (if downcase-p
- (mapcar 'downcase words)
- words)))
+ (company-dabbrev--filter
+ arg
+ (company-cache-fetch 'dabbrev-candidates #'company-dabbrev--fetch
+ :expire t)))
(kind 'text)
+ (no-cache t)
(ignore-case company-dabbrev-ignore-case)
(duplicates t)))
diff --git a/company-ispell.el b/company-ispell.el
index 3cb7c5d693..7c207f3eea 100644
--- a/company-ispell.el
+++ b/company-ispell.el
@@ -1,6 +1,6 @@
;;; company-ispell.el --- company-mode completion backend using Ispell
-;; Copyright (C) 2009-2011, 2013-2016, 2018, 2021 Free Software Foundation,
Inc.
+;; Copyright (C) 2009-2011, 2013-2016, 2018, 2021, 2023 Free Software
Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -33,30 +33,35 @@
"Completion backend using Ispell."
:group 'company)
+(defun company--set-dictionary (symbol value)
+ (set-default-toplevel-value symbol value)
+ (company-cache-delete 'ispell-candidates))
+
(defcustom company-ispell-dictionary nil
"Dictionary to use for `company-ispell'.
If nil, use `ispell-complete-word-dict'."
:type '(choice (const :tag "default (nil)" nil)
- (file :tag "dictionary" t)))
+ (file :tag "dictionary" t))
+ :set #'company--set-dictionary)
(defvar company-ispell-available 'unknown)
-(defalias 'company-ispell--lookup-words
- (if (fboundp 'ispell-lookup-words)
- 'ispell-lookup-words
- 'lookup-words))
-
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
- (company-ispell--lookup-words "WHATEVER")
+ (ispell-lookup-words "WHATEVER")
(setq company-ispell-available t))
(error
(message "Company-Ispell: %s" (error-message-string err))
(setq company-ispell-available nil))))
company-ispell-available)
+(defun company--ispell-dict ()
+ (or company-ispell-dictionary
+ ispell-complete-word-dict
+ ispell-alternate-dictionary))
+
;;;###autoload
(defun company-ispell (command &optional arg &rest ignored)
"`company-mode' completion backend using Ispell."
@@ -66,16 +71,19 @@ If nil, use `ispell-complete-word-dict'."
(prefix (when (company-ispell-available)
(company-grab-word)))
(candidates
- (let ((words (company-ispell--lookup-words
- arg
- (or company-ispell-dictionary ispell-complete-word-dict)))
- (completion-ignore-case t))
+ (let* ((dict (company--ispell-dict))
+ (all-words
+ (company-cache-fetch 'ispell-candidates
+ (lambda () (ispell-lookup-words "" dict))
+ :check-tag dict))
+ (completion-ignore-case t))
(if (string= arg "")
;; Small optimization.
- words
+ all-words
;; Work around issue #284.
- (all-completions arg words))))
+ (all-completions arg all-words))))
(kind 'text)
+ (no-cache t)
(sorted t)
(ignore-case 'keep-prefix)))
diff --git a/company.el b/company.el
index a0d8dc086c..2ead4e4864 100644
--- a/company.el
+++ b/company.el
@@ -1133,6 +1133,33 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a
cons."
(car (setq ppss (cdr ppss)))
(nth 3 ppss))))
+(defvar company--cache (make-hash-table :test #'equal :size 10))
+
+(cl-defun company-cache-fetch (key
+ fetcher
+ &key expire &key check-tag)
+ "Fetch the value assigned to KEY in the cache.
+When not found, or when found to be stale, calls FETCHER to compute the
+result. When EXPIRE is non-nil, the value will be deleted at the end of
+completion. CHECK-TAG, when present, is saved as well, and the entry will
+be recomputed when this value changes."
+ ;; We could make EXPIRE accept a time value as well.
+ (let ((res (gethash key company--cache 'none))
+ value)
+ (if (and (not (eq res 'none))
+ (or (not check-tag)
+ (equal check-tag (assoc-default :check-tag res))))
+ (assoc-default :value res)
+ (setq res (list (cons :value (setq value (funcall fetcher)))))
+ (if expire (push '(:expire . t) res))
+ (if check-tag (push `(:check-tag . ,check-tag) res))
+ (puthash key res company--cache)
+ value)))
+
+(defun company-cache-delete (key)
+ "Delete KEY from cache."
+ (remhash key company--cache))
+
(defun company-call-backend (&rest args)
(company--force-sync #'company-call-backend-raw args company-backend))
@@ -2204,6 +2231,10 @@ For more details see `company-insertion-on-trigger' and
company--multi-uncached-backends nil
company--multi-min-prefix nil
company-point nil)
+ (maphash (lambda (k v)
+ (when (assoc-default :expire v)
+ (remhash k company--cache)))
+ company--cache)
(when company-timer
(cancel-timer company-timer))
(company-echo-cancel t)
