daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update of packages

Browse Source
This commit is contained in:
Daniel Weschke
2023-11-04 19:26:41 +01:00
parent e162a12b58
commit 3b54a3236d
726 changed files with 297673 additions and 34585 deletions
Download Patch File Download Diff File Expand all files Collapse all files

317
lisp/company/company.el
View File

@@ -1,11 +1,11 @@
;;; company.el --- Modular text completion framework -*- lexical-binding: t -*-
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Copyright (C) 2009-2023 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; Maintainer: Dmitry Gutov <dmitry@gutov.dev>
;; URL: http://company-mode.github.io/
;; Version: 0.9.13
;; Version: 0.10.2
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "25.1"))
@@ -134,17 +134,17 @@
(defface company-tooltip-quick-access
'((default :inherit company-tooltip-annotation))
"Face used for the quick-access hints shown in the tooltip."
:package-version '(company . "0.9.14"))
:package-version '(company . "0.10.0"))
(defface company-tooltip-quick-access-selection
'((default :inherit company-tooltip-annotation-selection))
"Face used for the selected quick-access hints shown in the tooltip."
:package-version '(company . "0.9.14"))
:package-version '(company . "0.10.0"))
(define-obsolete-face-alias
'company-scrollbar-fg
'company-tooltip-scrollbar-thumb
"0.9.14")
"0.10.0")
(defface company-tooltip-scrollbar-thumb
'((((background light))
@@ -156,7 +156,7 @@
(define-obsolete-face-alias
'company-scrollbar-bg
'company-tooltip-scrollbar-track
"0.9.14")
"0.10.0")
(defface company-tooltip-scrollbar-track
'((((background light))
@@ -286,7 +286,7 @@ This doesn't include the margins and the scroll bar."
(defcustom company-tooltip-width-grow-only nil
"When non-nil, the tooltip width is not allowed to decrease."
:type 'boolean
:package-version '(company . "0.9.14"))
:package-version '(company . "0.10.0"))
(defcustom company-tooltip-margin 1
"Width of margin columns to show around the toolip."
@@ -309,6 +309,16 @@ This doesn't include the margins and the scroll bar."
:type 'boolean
:package-version '(company . "0.8.1"))
(defcustom company-tooltip-annotation-padding nil
"Non-nil to specify the padding before annotation.
Depending on the value of `company-tooltip-align-annotations', the default
padding is either 0 or 1 space. This variable allows to override that
value to increase the padding. When annotations are right-aligned, it sets
the minimum padding, and otherwise just the constant one."
:type 'number
:package-version '(company "0.10.0"))
(defvar company-safe-backends
'((company-abbrev . "Abbrev")
(company-bbdb . "BBDB")
@@ -577,12 +587,12 @@ this."
(define-obsolete-variable-alias
'company-auto-complete
'company-insertion-on-trigger
"0.9.14")
"0.10.0")
(define-obsolete-variable-alias
'company-auto-commit
'company-insertion-on-trigger
"0.9.14")
"0.10.0")
(defcustom company-insertion-on-trigger nil
"If enabled, allow triggering insertion of the selected candidate.
@@ -596,17 +606,17 @@ triggers."
(const :tag "On, if user interaction took place"
company-explicit-action-p)
(const :tag "On" t))
:package-version '(company . "0.9.14"))
:package-version '(company . "0.10.0"))
(define-obsolete-variable-alias
'company-auto-complete-chars
'company-insertion-triggers
"0.9.14")
"0.10.0")
(define-obsolete-variable-alias
'company-auto-commit-chars
'company-insertion-triggers
"0.9.14")
"0.10.0")
(defcustom company-insertion-triggers '(?\ ?\) ?.)
"Determine triggers for `company-insertion-on-trigger'.
@@ -638,7 +648,7 @@ insertion."
(const :tag "Generic string fence." ?|)
(const :tag "Generic comment fence." ?!))
(function :tag "Predicate function"))
:package-version '(company . "0.9.14"))
:package-version '(company . "0.10.0"))
(defcustom company-idle-delay .2
"The idle delay in seconds until completion starts automatically.
@@ -692,15 +702,18 @@ commands in the `company-' namespace, abort completion."
(defun company-custom--set-quick-access (option value)
"Re-bind quick-access key sequences on OPTION VALUE change."
(when (boundp 'company-active-map)
(company-keymap--unbind-quick-access company-active-map))
(when (boundp 'company-search-map)
(company-keymap--unbind-quick-access company-search-map))
;; When upgrading from an earlier version of company, might not be.
(when (fboundp #'company-keymap--unbind-quick-access)
(when (boundp 'company-active-map)
(company-keymap--unbind-quick-access company-active-map))
(when (boundp 'company-search-map)
(company-keymap--unbind-quick-access company-search-map)))
(custom-set-default option value)
(when (boundp 'company-active-map)
(company-keymap--bind-quick-access company-active-map))
(when (boundp 'company-search-map)
(company-keymap--bind-quick-access company-search-map)))
(when (fboundp #'company-keymap--bind-quick-access)
(when (boundp 'company-active-map)
(company-keymap--bind-quick-access company-active-map))
(when (boundp 'company-search-map)
(company-keymap--bind-quick-access company-search-map))))
(defcustom company-quick-access-keys '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0")
"Character strings used as a part of quick-access key sequences.
@@ -718,7 +731,7 @@ beside the candidates."
;; TODO un-comment on removal of `M-n' `company--select-next-and-warn'.
;; (const :tag "Dvorak home row" ("a" "o" "e" "u" "i" "d" "h" "t" "n" "s"))
(repeat :tag "User defined" string))
:package-version '(company . "0.9.14"))
:package-version '(company . "0.10.0"))
(defcustom company-quick-access-modifier 'meta
"Modifier key used for quick-access keys sequences.
@@ -729,7 +742,7 @@ See `company-quick-access-keys' for more details."
(const :tag "Super key" super)
(const :tag "Hyper key" hyper)
(const :tag "Control key" control))
:package-version '(company . "0.9.14"))
:package-version '(company . "0.10.0"))
(defun company-keymap--quick-access-modifier ()
"Return string representation of the `company-quick-access-modifier'."
@@ -764,7 +777,7 @@ See `company-quick-access-keys' for more details."
(define-obsolete-variable-alias
'company-show-numbers
'company-show-quick-access
"0.9.14")
"0.10.0")
(defcustom company-show-quick-access nil
"If non-nil, show quick-access hints beside the candidates.
@@ -791,7 +804,7 @@ return a string prefixed with one space."
'company-show-numbers-function
"use `company-quick-access-hint-function' instead,
but adjust the expected values appropriately."
"0.9.14")
"0.10.0")
(defcustom company-quick-access-hint-function #'company-quick-access-hint-key
"Function called to get quick-access hints for the candidates.
@@ -1031,10 +1044,10 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
(defun company-install-map ()
(unless (or (cdar company-emulation-alist)
(null company-my-keymap))
(setf (cdar company-emulation-alist) company-my-keymap)))
(setq-local company-emulation-alist `((t . ,company-my-keymap)))))
(defun company-uninstall-map ()
(setf (cdar company-emulation-alist) nil))
(kill-local-variable 'company-emulation-alist))
(defun company--company-command-p (keys)
"Checks if the keys are part of company's overriding keymap"
@@ -1051,6 +1064,10 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
(row (cdr (or (posn-actual-col-row posn)
;; When position is non-visible for some reason.
(posn-col-row posn)))))
;; posn-col-row return value relative to the left
(when (eq (current-bidi-paragraph-direction) 'right-to-left)
(let ((ww (window-body-width)))
(setq col (- ww col))))
(when (bound-and-true-p display-line-numbers)
(cl-decf col (+ 2 (line-number-display-width))))
(cons (+ col (window-hscroll)) row)))
@@ -1116,6 +1133,69 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(car (setq ppss (cdr ppss)))
(nth 3 ppss))))
(defun company-substitute-prefix (prefix strings)
(let ((len (length prefix)))
(mapcar
(lambda (s)
(if (eq t (compare-strings prefix 0 len s 0 len))
s
(concat prefix (substring s len))))
strings)))
(defun company--match-from-capf-face (str)
"Compute `match' result from a CAPF's completion fontification."
(let* ((match-start nil) (pos -1)
(prop-value nil) (faces nil)
(has-face-p nil) chunks
(limit (length str)))
(while (< pos limit)
(setq pos
(if (< pos 0) 0 (next-property-change pos str limit)))
(setq prop-value (or (get-text-property pos 'face str)
(get-text-property pos 'font-lock-face str))
faces (if (listp prop-value) prop-value (list prop-value))
has-face-p (memq 'completions-common-part faces))
(cond ((and (not match-start) has-face-p)
(setq match-start pos))
((and match-start (not has-face-p))
(push (cons match-start pos) chunks)
(setq match-start nil))))
(nreverse chunks)))
(defvar company--cache (make-hash-table :test #'equal :size 10))
(cl-defun company-cache-fetch (key
fetcher
&key expire 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-cache-expire ()
"Delete all keys from the cache that are set to be expired."
(maphash (lambda (k v)
(when (assoc-default :expire v)
(remhash k company--cache)))
company--cache))
(defun company-call-backend (&rest args)
(company--force-sync #'company-call-backend-raw args company-backend))
@@ -1151,6 +1231,9 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(error (error "Company: backend %s error \"%s\" with args %s"
company-backend (error-message-string err) args))))
(defvar-local company--multi-uncached-backends nil)
(defvar-local company--multi-min-prefix nil)
(defun company--multi-backend-adapter (backends command &rest args)
(let ((backends (cl-loop for b in backends
when (or (keywordp b)
@@ -1165,9 +1248,30 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(pcase command
(`candidates
(company--multi-backend-adapter-candidates backends (car args) separate))
(company--multi-backend-adapter-candidates backends
(car args)
(or company--multi-min-prefix 0)
separate))
(`set-min-prefix (setq company--multi-min-prefix (car args)))
(`sorted separate)
(`duplicates (not separate))
((and `no-cache
(pred (lambda (_)
(let* (found
(uncached company--multi-uncached-backends))
(dolist (backend backends)
(when
(and (member backend uncached)
(company--good-prefix-p
(let ((company-backend backend))
(company-call-backend 'prefix))
(or company--multi-min-prefix 0)))
(setq found t
company--multi-uncached-backends
(delete backend
company--multi-uncached-backends))))
found))))
t)
((or `prefix `ignore-case `no-cache `require-match)
(let (value)
(cl-dolist (backend backends)
@@ -1184,12 +1288,18 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(car backends))))
(apply backend command args))))))))
(defun company--multi-backend-adapter-candidates (backends prefix separate)
(defun company--multi-backend-adapter-candidates (backends prefix min-length separate)
(let ((pairs (cl-loop for backend in backends
when (equal (company--prefix-str
(let ((company-backend backend))
(company-call-backend 'prefix)))
prefix)
when (let ((bp (let ((company-backend backend))
(company-call-backend 'prefix))))
(and
;; It's important that the lengths match.
(equal (company--prefix-str bp) prefix)
;; One might override min-length, another not.
(if (company--good-prefix-p bp min-length)
t
(push backend company--multi-uncached-backends)
nil)))
collect (cons (funcall backend 'candidates prefix)
(company--multi-candidates-mapper
backend
@@ -1346,9 +1456,6 @@ To toggle the value of this variable, call `company-show-doc-buffer' with a
prefix argument.")
(defun company-call-frontends (command)
(when (and company-auto-update-doc
(memq command '(update show)))
(company-show-doc-buffer))
(cl-loop for frontend in company-frontends collect
(condition-case-unless-debug err
(funcall frontend command)
@@ -1448,7 +1555,9 @@ update if FORCE-UPDATE."
(and candidates
(not (cdr candidates))
(eq t (compare-strings (car candidates) nil nil
prefix nil nil ignore-case))))
prefix nil nil ignore-case))
(not (eq (company-call-backend 'kind (car candidates))
'snippet))))
(defun company--fetch-candidates (prefix)
(let* ((non-essential (not (company-explicit-action-p)))
@@ -1620,7 +1729,7 @@ end of the match."
(let ((base-size (cdr company-icon-size))
(dfh (default-font-height)))
(min
(if (> dfh (* 2 base-size))
(if (>= dfh (* 2 base-size))
(* 2 base-size)
base-size)
(* company-icon-margin dfw))))))
@@ -1633,10 +1742,21 @@ end of the match."
:background (unless (eq bkg 'unspecified)
bkg)))
(spacer-px-width (- (* company-icon-margin dfw) icon-size)))
(concat
(propertize " " 'display spec)
(propertize (company-space-string (1- company-icon-margin))
'display `(space . (:width (,spacer-px-width))))))
(cond
((<= company-icon-margin 2)
(concat
(propertize " " 'display spec)
(propertize (company-space-string (1- company-icon-margin))
'display `(space . (:width (,spacer-px-width))))))
(t
(let* ((spacer-left (/ spacer-px-width 2))
(spacer-right (- spacer-px-width spacer-left)))
(concat
(propertize (company-space-string 1)
'display `(space . (:width (,spacer-left))))
(propertize " " 'display spec)
(propertize (company-space-string (- company-icon-margin 2))
'display `(space . (:width (,spacer-right)))))))))
nil))
(defun company-vscode-dark-icons-margin (candidate selected)
@@ -1943,6 +2063,10 @@ prefix match (same case) will be prioritized."
;;;###autoload
(defun company-manual-begin ()
"Start the completion interface.
Unlike `company-complete-selection' or `company-complete', this command
doesn't cause any immediate changes to the buffer text."
(interactive)
(company-assert-enabled)
(setq company--manual-action t)
@@ -2021,16 +2145,20 @@ For more details see `company-insertion-on-trigger' and
company-candidates)
(t (company-cancel))))
(defun company--good-prefix-p (prefix)
(defun company--good-prefix-p (prefix min-length)
(and (stringp (company--prefix-str prefix)) ;excludes 'stop
(or (eq (cdr-safe prefix) t)
(let ((len (or (cdr-safe prefix) (length prefix))))
(if company--manual-prefix
(or (not company-abort-manual-when-too-short)
;; Must not be less than minimum or initial length.
(>= len (min company-minimum-prefix-length
(length company--manual-prefix))))
(>= len company-minimum-prefix-length))))))
(>= (or (cdr-safe prefix) (length prefix))
min-length))))
(defun company--prefix-min-length ()
(if company--manual-prefix
(if company-abort-manual-when-too-short
;; Must not be less than minimum or initial length.
(min company-minimum-prefix-length
(length company--manual-prefix))
0)
company-minimum-prefix-length))
(defun company--continue ()
(when (company-call-backend 'no-cache company-prefix)
@@ -2038,7 +2166,8 @@ For more details see `company-insertion-on-trigger' and
(setq company-candidates-cache nil))
(let* ((new-prefix (company-call-backend 'prefix))
(ignore-case (company-call-backend 'ignore-case))
(c (when (and (company--good-prefix-p new-prefix)
(c (when (and (company--good-prefix-p new-prefix
(company--prefix-min-length))
(setq new-prefix (company--prefix-str new-prefix))
(= (- (point) (length new-prefix))
(- company-point (length company-prefix))))
@@ -2067,7 +2196,8 @@ For more details see `company-insertion-on-trigger' and
(t (company--continue-failed new-prefix)))))
(defun company--begin-new ()
(let (prefix c)
(let ((min-prefix (company--prefix-min-length))
prefix c)
(cl-dolist (backend (if company-backend
;; prefer manual override
(list company-backend)
@@ -2080,8 +2210,10 @@ For more details see `company-insertion-on-trigger' and
(company-call-backend 'prefix)))
(company--multi-backend-adapter backend 'prefix)))
(when prefix
(when (company--good-prefix-p prefix)
(when (company--good-prefix-p prefix min-prefix)
(let ((ignore-case (company-call-backend 'ignore-case)))
;; Keep this undocumented, esp. while only 1 backend needs it.
(company-call-backend 'set-min-prefix min-prefix)
(setq company-prefix (company--prefix-str prefix)
company-backend backend
c (company-calculate-candidates company-prefix ignore-case))
@@ -2136,7 +2268,10 @@ For more details see `company-insertion-on-trigger' and
company--manual-action nil
company--manual-prefix nil
company--point-max nil
company--multi-uncached-backends nil
company--multi-min-prefix nil
company-point nil)
(company-cache-expire)
(when company-timer
(cancel-timer company-timer))
(company-echo-cancel t)
@@ -2200,7 +2335,14 @@ For more details see `company-insertion-on-trigger' and
(let (company-idle-delay) ; Against misbehavior while debugging.
(company--perform)))
(if company-candidates
(company-call-frontends 'post-command)
(progn
(company-call-frontends 'post-command)
(when company-auto-update-doc
(condition-case nil
(unless (company--electric-command-p)
(company-show-doc-buffer))
(user-error nil)
(quit nil))))
(let ((delay (company--idle-delay)))
(and (numberp delay)
(not defining-kbd-macro)
@@ -2688,12 +2830,13 @@ inserted."
(call-interactively 'company-complete-selection)
(call-interactively 'company-complete-common)
(when company-candidates
(setq this-command 'company-complete-common)))))
(setq this-command 'company-complete-common)))
this-command))
(define-obsolete-function-alias
'company-complete-number
'company-complete-tooltip-row
"0.9.14")
"0.10.0")
(defun company-complete-tooltip-row (number)
"Insert a candidate visible on the tooltip's row NUMBER.
@@ -2803,16 +2946,19 @@ from the candidates list.")
'(scroll-other-window scroll-other-window-down mwheel-scroll)
"List of Commands that won't break out of electric commands.")
(defun company--electric-command-p ()
(memq this-command company--electric-commands))
(defun company--electric-restore-window-configuration ()
"Restore window configuration (after electric commands)."
(when (and company--electric-saved-window-configuration
(not (memq this-command company--electric-commands)))
(not (company--electric-command-p)))
(set-window-configuration company--electric-saved-window-configuration)
(setq company--electric-saved-window-configuration nil)))
(defmacro company--electric-do (&rest body)
(declare (indent 0) (debug t))
`(when (company-manual-begin)
`(when company-candidates
(cl-assert (null company--electric-saved-window-configuration))
(setq company--electric-saved-window-configuration (current-window-configuration))
(let ((height (window-height))
@@ -2835,11 +2981,7 @@ from the candidates list.")
(selection (or company-selection 0)))
(let* ((selected (nth selection company-candidates))
(doc-buffer (or (company-call-backend 'doc-buffer selected)
(if company-auto-update-doc
(company-doc-buffer
(format "%s: No documentation available"
selected))
(user-error "No documentation available"))))
(user-error "No documentation available")))
start)
(when (consp doc-buffer)
(setq start (cdr doc-buffer)
@@ -2856,10 +2998,8 @@ automatically show the documentation buffer for each selection."
(interactive "P")
(when toggle-auto-update
(setq company-auto-update-doc (not company-auto-update-doc)))
(if company-auto-update-doc
(company--show-doc-buffer)
(company--electric-do
(company--show-doc-buffer))))
(company--electric-do
(company--show-doc-buffer)))
(put 'company-show-doc-buffer 'company-keep t)
(defun company-show-location ()
@@ -3072,21 +3212,23 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
(_ (setq value (company-reformat (company--pre-render value))
annotation (and annotation (company--pre-render annotation t))))
(ann-ralign company-tooltip-align-annotations)
(ann-padding (or company-tooltip-annotation-padding 0))
(ann-truncate (< width
(+ (length value) (length annotation)
(if ann-ralign 1 0))))
ann-padding)))
(ann-start (+ margin
(if ann-ralign
(if ann-truncate
(1+ (length value))
(+ (length value) ann-padding)
(- width (length annotation)))
(length value))))
(+ (length value) ann-padding))))
(ann-end (min (+ ann-start (length annotation)) (+ margin width)))
(line (concat left
(if (or ann-truncate (not ann-ralign))
(company-safe-substring
(concat value
(when (and annotation ann-ralign) " ")
(when annotation
(company-space-string ann-padding))
annotation)
0 width)
(concat
@@ -3225,7 +3367,7 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
'company--show-numbers
"use `company-quick-access-hint-key' instead,
but adjust the expected values appropriately."
"0.9.14")
"0.10.0")
(defsubst company--window-height ()
(if (fboundp 'window-screen-lines)
@@ -3314,6 +3456,9 @@ but adjust the expected values appropriately."
(defun company--create-lines (selection limit)
(let ((len company-candidates-length)
(window-width (company--window-width))
(company-tooltip-annotation-padding
(or company-tooltip-annotation-padding
(if company-tooltip-align-annotations 1 0)))
left-margins
left-margin-size
lines
@@ -3386,8 +3531,9 @@ but adjust the expected values appropriately."
(setq annotation (string-trim-left annotation))))
(push (list value annotation left) items)
(setq width (max (+ (length value)
(if (and annotation company-tooltip-align-annotations)
(1+ (length annotation))
(if annotation
(+ (length annotation)
company-tooltip-annotation-padding)
(length annotation)))
width))))
@@ -3610,7 +3756,7 @@ Returns a negative number if the tooltip should be displayed above point."
(pre-command (company-pseudo-tooltip-hide-temporarily))
(unhide
(let ((ov company-pseudo-tooltip-overlay))
(when (> (overlay-get ov 'company-height) 0)
(when (and ov (> (overlay-get ov 'company-height) 0))
;; Sleight of hand: if the current line wraps, we adjust the
;; start of the overlay so that the popup does not zig-zag,
;; but don't update the popup's background. This seems just
@@ -3730,6 +3876,10 @@ Delay is determined by `company-tooltip-idle-delay'."
(company-strip-prefix completion)
completion))
(when (string-prefix-p "\n" completion)
(setq completion (concat (propertize " " 'face 'company-preview) "\n"
(substring completion 1))))
(and (equal pos (point))
(not (equal completion ""))
(add-text-properties 0 1 '(cursor 1) completion))
@@ -3829,13 +3979,18 @@ Delay is determined by `company-tooltip-idle-delay'."
:package-version '(company . "0.9.3"))
(defun company-echo-show (&optional getter)
(when getter
(setq company-echo-last-msg (funcall getter)))
(let ((message-log-max nil)
(let ((last-msg company-echo-last-msg)
(message-log-max nil)
(message-truncate-lines company-echo-truncate-lines))
(if company-echo-last-msg
(when getter
(setq company-echo-last-msg (funcall getter)))
;; Avoid modifying the echo area if we don't have anything to say, and we
;; didn't put the previous message there (thus there's nothing to clear),
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62816#20
(if (not (member company-echo-last-msg '(nil "")))
(message "%s" company-echo-last-msg)
(message ""))))
(unless (member last-msg '(nil ""))
(message "")))))
(defun company-echo-show-soon (&optional getter delay)
(company-echo-cancel)