Refactor how company-backends are set and stored

Company backends are now built from an alist (+company-backend-alist),
which can be manipulated through set-company-backend!. Backends can now
be set to all children of a parent mode (text-mode, prog-mode, etc),
like so:

  (set-company-backend! :derived 'text-mode 'company-dabbrev)

or only for an exact major-mode:

  (set-company-backend! 'markdown-mode 'company-dabbrev-code)

Backends cascade. So combining the two examples above will cause
company-backends in a markdown-buffer (which is derived from text-mode)
to be (company-dabbrev-code company-dabbrev).

modules/completion/company/autoload.el

@@ -1,5 +1,13 @@
 ;;; completion/company/autoload.el -*- lexical-binding: t; -*-
 
+;;;###autoload
+(defvar +company-backend-alist
+  '((text-mode :derived (company-dabbrev company-yasnippet))
+    (prog-mode :derived (:separate company-capf company-yasnippet))
+    (conf-mode :derived company-capf company-dabbrev-code company-yasnippet))
+  "An alist matching modes to company backends. The backends for any mode is
+built from this.")
+
 ;;;###autodef
 (defun set-company-backend! (modes &rest backends)
   "Prepends BACKENDS (in order) to `company-backends' in MODES.
@@ -16,24 +24,24 @@ Examples:
     '(company-shell :with company-yasnippet))
   (set-company-backend! 'js2-mode
     '(:separate company-irony-c-headers company-irony))
-  (set-company-backend! 'sh-mode nil)"
+  (set-company-backend! 'sh-mode nil)
+
+To have BACKENDS apply to any mode that is a parent of MODES, set MODES to
+:derived, e.g.
+
+  (set-company-backend! :derived 'text-mode 'company-dabbrev 'company-yasnippet)"
   (declare (indent defun))
-  (dolist (mode (doom-enlist modes))
+  (let ((type :exact))
-    (let ((hook (intern (format "%s-hook" mode)))
+    (when (eq modes :derived)
-          (fn   (intern (format "+company|init-%s" mode))))
+      (setq type :derived
-      (cond ((null (car-safe backends))
+            modes (pop backends)))
-             (remove-hook hook fn)
+    (dolist (mode (doom-enlist modes))
-             (unintern fn nil))
+      (if (null (car backends))
-            ((fset fn
+          (setq +company-backend-alist
-                   (lambda ()
+                (delq (assq mode +company-backend-alist)
-                     (when (or (eq major-mode mode)
+                      +company-backend-alist))
-                               (and (boundp mode) (symbol-value mode)))
+        (setf (alist-get mode +company-backend-alist)
-                       (require 'company)
+              (cons type backends))))))
-                       (make-local-variable 'company-backends)
-                       (dolist (backend (reverse backends))
-                         (cl-pushnew backend company-backends
-                                     :test (if (symbolp backend) #'eq #'equal))))))
-             (add-hook hook fn))))))
 
 ;; FIXME obsolete :company-backend
 ;;;###autoload
@@ -41,6 +49,40 @@ Examples:
   :obsolete set-company-backend!
   `(set-company-backend! ,modes ,@backends))
 
+
+;;
+;; Library
+;;
+
+(defun +company--backends ()
+  (or (cl-loop for (mode . rest) in +company-backend-alist
+               for type = (car rest)
+               for backends = (cdr rest)
+               if (or (and (eq type :derived) (derived-mode-p mode)) ; parent modes
+                      (and (eq type :exact)   (eq major-mode mode))  ; major modes
+                      (and (boundp mode)      (symbol-value mode)))  ; minor modes
+               nconc backends)
+      (default-value 'company-backends)))
+
+
+;;
+;; Hooks
+;;
+
+;;;###autoload
+(defun +company|init-backends ()
+  "Set `company-backends' for the current buffer."
+  (unless (eq major-mode 'fundamental-mode)
+    (set (make-local-variable 'company-backends) (+company--backends)))
+  (add-hook 'after-change-major-mode-hook #'+company|init-backends nil 'local))
+
+(put '+company|init-backends 'permanent-local-hook t)
+
+
+;;
+;; Commands
+;;
+
 ;;;###autoload
 (defun +company/toggle-auto-completion ()
   "Toggle as-you-type code completion."

modules/completion/company/config.el

@@ -15,10 +15,9 @@
         company-frontends
         '(company-pseudo-tooltip-frontend
           company-echo-metadata-frontend)
-        company-backends
-        '((:separate company-capf company-yasnippet))
         company-transformers '(company-sort-by-occurrence))
   :config
+  (add-hook 'company-mode-hook #'+company|init-backends)
   (global-company-mode +1))
 
 

modules/completion/company/test/test-company.el

@@ -6,45 +6,63 @@
     (load! "../autoload"))
 
   (describe ":company-backend"
-    :var (a)
+    :var (a +company-backend-alist backends)
     (before-each
-      (setq company-backends '(default)
+      (setq-default company-backends '(t))
-            text-mode-hook nil
+      (setq +company-backend-alist nil
             a (get-buffer-create "x"))
+      (fset 'backends
+            (lambda (mode)
+              (let ((major-mode mode))
+                (+company--backends))))
       (set-buffer a)
       (spy-on 'require))
     (after-each
-      (fmakunbound '+company|init-text-mode)
       (kill-buffer a))
 
-    (it "adds hooks and defines +company|init-MODE"
+    ;;
-      (set-company-backend! 'text-mode '(backend-1))
+    (it "sets backends for a major mode"
-      (expect (fboundp '+company|init-text-mode))
+      (set-company-backend! 'text-mode 'a)
-      (expect text-mode-hook :to-equal '(+company|init-text-mode)))
+      (expect (backends 'text-mode) :to-equal '(a)))
 
-    (it "adds grouped backends"
+    (it "sets backends for a derived-mode"
-      (set-company-backend! 'text-mode '(backend-1))
+      (set-company-backend! :derived 'prog-mode 'a)
-      (text-mode)
+      (expect (backends 'prog-mode) :to-equal '(a))
-      (expect company-backends :to-equal '((backend-1) default)))
+      (expect (backends 'emacs-lisp-mode) :to-equal '(a)))
 
-    (it "adds multiple backends"
+    (it "sets multiple backends for exact major modes"
-      (set-company-backend! 'text-mode 'backend-1 'backend-2)
+      (set-company-backend! '(text-mode emacs-lisp-mode) 'a 'b)
-      (text-mode)
+      (expect (backends 'text-mode) :to-equal (backends 'emacs-lisp-mode)))
-      (expect company-backends :to-equal '(backend-1 backend-2 default)))
 
-    (it "adds single backend"
+    (it "sets cumulative backends"
-      (set-company-backend! 'text-mode 'backend-1)
+      (set-company-backend! :derived 'prog-mode 'a)
-      (text-mode)
+      (set-company-backend! 'emacs-lisp-mode 'b)
-      (expect company-backends :to-equal '(backend-1 default)))
+      (expect (backends 'emacs-lisp-mode) :to-equal '(b a)))
 
-    (it "overwrites past values"
+    (it "overwrites past backends"
-      (set-company-backend! 'text-mode 'backend-1)
+      (set-company-backend! 'text-mode 'old 'backends)
-      (set-company-backend! 'text-mode 'backend-2)
+      (set-company-backend! 'text-mode 'new 'backends)
-      (text-mode)
+      (expect (backends 'text-mode) :to-equal '(new backends)))
-      (expect company-backends :to-equal '(backend-2 default)))
 
-    (it "unsets past values"
+    (it "unsets past backends"
-      (set-company-backend! 'text-mode 'backend-1)
+      (set-company-backend! 'text-mode 'old)
       (set-company-backend! 'text-mode nil)
-      (text-mode)
+      (expect (backends 'text-mode) :to-equal (default-value 'company-backends)))
-      (expect company-backends :to-equal '(default)))))
+
+    (it "unsets past parent backends"
+      (set-company-backend! :derived 'prog-mode 'old)
+      (set-company-backend! 'emacs-lisp-mode 'child)
+      (set-company-backend! :derived 'prog-mode nil)
+      (expect (backends 'emacs-lisp-mode) :to-equal '(child)))
+
+    (it "overwrites past cumulative backends"
+      (set-company-backend! :derived 'prog-mode 'base)
+      (set-company-backend! 'emacs-lisp-mode 'old)
+      (set-company-backend! 'emacs-lisp-mode 'new)
+      (expect (backends 'emacs-lisp-mode) :to-equal '(new base)))
+
+    (it "overwrites past parent backends"
+      (set-company-backend! :derived 'prog-mode 'base)
+      (set-company-backend! 'emacs-lisp-mode 'child)
+      (set-company-backend! :derived 'prog-mode 'new)
+      (expect (backends 'emacs-lisp-mode) :to-equal '(child new)))))