.emacs.d.git - Gitblit

Chizi123

2018-11-21 e75a20334813452c6912c090d70a0de2c805f94d

commit \| author \| age
5cb5f7	1	;;; company.el --- Modular text completion framework -- lexical-binding: t --
C	2
	3	;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
	4
	5	;; Author: Nikolaj Schumacher
	6	;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
	7	;; URL: http://company-mode.github.io/
	8	;; Version: 0.9.7
	9	;; Keywords: abbrev, convenience, matching
	10	;; Package-Requires: ((emacs "24.3"))
	11
	12	;; This file is part of GNU Emacs.
	13
	14	;; GNU Emacs is free software: you can redistribute it and/or modify
	15	;; it under the terms of the GNU General Public License as published by
	16	;; the Free Software Foundation, either version 3 of the License, or
	17	;; (at your option) any later version.
	18
	19	;; GNU Emacs is distributed in the hope that it will be useful,
	20	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	21	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	22	;; GNU General Public License for more details.
	23
	24	;; You should have received a copy of the GNU General Public License
	25	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	26
	27	;;; Commentary:
	28	;;
	29	;; Company is a modular completion framework. Modules for retrieving completion
	30	;; candidates are called backends, modules for displaying them are frontends.
	31	;;
	32	;; Company comes with many backends, e.g. `company-etags'. These are
	33	;; distributed in separate files and can be used individually.
	34	;;
	35	;; Enable `company-mode' in all buffers with M-x global-company-mode. For
	36	;; further information look at the documentation for `company-mode' (C-h f
	37	;; company-mode RET).
	38	;;
	39	;; If you want to start a specific backend, call it interactively or use
	40	;; `company-begin-backend'. For example:
	41	;; M-x company-abbrev will prompt for and insert an abbrev.
	42	;;
	43	;; To write your own backend, look at the documentation for `company-backends'.
	44	;; Here is a simple example completing "foo":
	45	;;
	46	;; (defun company-my-backend (command &optional arg &rest ignored)
	47	;; (interactive (list 'interactive))
	48	;; (pcase command
	49	;; (`interactive (company-begin-backend 'company-my-backend))
	50	;; (`prefix (company-grab-symbol))
	51	;; (`candidates (list "foobar" "foobaz" "foobarbaz"))
	52	;; (`meta (format "This value is named %s" arg))))
	53	;;
	54	;; Sometimes it is a good idea to mix several backends together, for example to
	55	;; enrich gtags with dabbrev-code results (to emulate local variables). To do
	56	;; this, add a list with both backends as an element in `company-backends'.
	57	;;
	58	;;; Change Log:
	59	;;
	60	;; See NEWS.md in the repository.
	61
	62	;;; Code:
	63
	64	(require 'cl-lib)
	65	(require 'newcomment)
	66	(require 'pcase)
	67
	68	;;; Compatibility
	69	(eval-and-compile
	70	;; Defined in Emacs 24.4
	71	(unless (fboundp 'string-suffix-p)
	72	(defun string-suffix-p (suffix string &optional ignore-case)
	73	"Return non-nil if SUFFIX is a suffix of STRING.
	74	If IGNORE-CASE is non-nil, the comparison is done without paying
	75	attention to case differences."
	76	(let ((start-pos (- (length string) (length suffix))))
	77	(and (>= start-pos 0)
	78	(eq t (compare-strings suffix nil nil
	79	string start-pos nil ignore-case)))))))
	80
	81	(defgroup company nil
	82	"Extensible inline text completion mechanism"
	83	:group 'abbrev
	84	:group 'convenience
	85	:group 'matching)
	86
	87	(defface company-tooltip
	88	'((default :foreground "black")
	89	(((class color) (min-colors 88) (background light))
	90	(:background "cornsilk"))
	91	(((class color) (min-colors 88) (background dark))
	92	(:background "yellow")))
	93	"Face used for the tooltip.")
	94
	95	(defface company-tooltip-selection
	96	'((((class color) (min-colors 88) (background light))
	97	(:background "light blue"))
	98	(((class color) (min-colors 88) (background dark))
	99	(:background "orange1"))
	100	(t (:background "green")))
	101	"Face used for the selection in the tooltip.")
	102
	103	(defface company-tooltip-search
	104	'((default :inherit highlight))
	105	"Face used for the search string in the tooltip.")
	106
	107	(defface company-tooltip-search-selection
	108	'((default :inherit highlight))
	109	"Face used for the search string inside the selection in the tooltip.")
	110
	111	(defface company-tooltip-mouse
	112	'((default :inherit highlight))
	113	"Face used for the tooltip item under the mouse.")
	114
	115	(defface company-tooltip-common
	116	'((((background light))
	117	:foreground "darkred")
	118	(((background dark))
	119	:foreground "red"))
	120	"Face used for the common completion in the tooltip.")
	121
	122	(defface company-tooltip-common-selection
	123	'((default :inherit company-tooltip-common))
	124	"Face used for the selected common completion in the tooltip.")
	125
	126	(defface company-tooltip-annotation
	127	'((((background light))
	128	:foreground "firebrick4")
	129	(((background dark))
	130	:foreground "red4"))
	131	"Face used for the completion annotation in the tooltip.")
	132
	133	(defface company-tooltip-annotation-selection
	134	'((default :inherit company-tooltip-annotation))
	135	"Face used for the selected completion annotation in the tooltip.")
	136
	137	(defface company-scrollbar-fg
	138	'((((background light))
	139	:background "darkred")
	140	(((background dark))
	141	:background "red"))
	142	"Face used for the tooltip scrollbar thumb.")
	143
	144	(defface company-scrollbar-bg
	145	'((((background light))
	146	:background "wheat")
	147	(((background dark))
	148	:background "gold"))
	149	"Face used for the tooltip scrollbar background.")
	150
	151	(defface company-preview
	152	'((((background light))
	153	:inherit (company-tooltip-selection company-tooltip))
	154	(((background dark))
	155	:background "blue4"
	156	:foreground "wheat"))
	157	"Face used for the completion preview.")
	158
	159	(defface company-preview-common
	160	'((((background light))
	161	:inherit company-tooltip-common-selection)
	162	(((background dark))
	163	:inherit company-preview
	164	:foreground "red"))
	165	"Face used for the common part of the completion preview.")
	166
	167	(defface company-preview-search
	168	'((((background light))
	169	:inherit company-tooltip-common-selection)
	170	(((background dark))
	171	:inherit company-preview
	172	:background "blue1"))
	173	"Face used for the search string in the completion preview.")
	174
	175	(defface company-echo nil
	176	"Face used for completions in the echo area.")
	177
	178	(defface company-echo-common
	179	'((((background dark)) (:foreground "firebrick1"))
	180	(((background light)) (:background "firebrick4")))
	181	"Face used for the common part of completions in the echo area.")
	182
	183	(defun company-frontends-set (variable value)
	184	;; Uniquify.
	185	(let ((value (delete-dups (copy-sequence value))))
	186	(and (or (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
	187	(memq 'company-pseudo-tooltip-frontend value))
	188	(and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
	189	(memq 'company-pseudo-tooltip-frontend value))
	190	(and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
	191	(memq 'company-pseudo-tooltip-unless-just-one-frontend value)))
	192	(user-error "Pseudo tooltip frontend cannot be used more than once"))
	193	(and (or (and (memq 'company-preview-if-just-one-frontend value)
	194	(memq 'company-preview-frontend value))
	195	(and (memq 'company-preview-if-just-one-frontend value)
	196	(memq 'company-preview-common-frontend value))
	197	(and (memq 'company-preview-frontend value)
	198	(memq 'company-preview-common-frontend value))
	199	)
	200	(user-error "Preview frontend cannot be used twice"))
	201	(and (memq 'company-echo value)
	202	(memq 'company-echo-metadata-frontend value)
	203	(user-error "Echo area cannot be used twice"))
	204	;; Preview must come last.
	205	(dolist (f '(company-preview-if-just-one-frontend company-preview-frontend company-preview-common-frontend))
	206	(when (cdr (memq f value))
	207	(setq value (append (delq f value) (list f)))))
	208	(set variable value)))
	209
	210	(defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
	211	company-preview-if-just-one-frontend
	212	company-echo-metadata-frontend)
	213	"The list of active frontends (visualizations).
	214	Each frontend is a function that takes one argument. It is called with
	215	one of the following arguments:
	216
	217	`show': When the visualization should start.
	218
	219	`hide': When the visualization should end.
	220
	221	`update': When the data has been updated.
	222
	223	`pre-command': Before every command that is executed while the
	224	visualization is active.
	225
	226	`post-command': After every command that is executed while the
	227	visualization is active.
	228
	229	The visualized data is stored in `company-prefix', `company-candidates',
	230	`company-common', `company-selection', `company-point' and
	231	`company-search-string'."
	232	:set 'company-frontends-set
	233	:type '(repeat (choice (const :tag "echo" company-echo-frontend)
	234	(const :tag "echo, strip common"
	235	company-echo-strip-common-frontend)
	236	(const :tag "show echo meta-data in echo"
	237	company-echo-metadata-frontend)
	238	(const :tag "pseudo tooltip"
	239	company-pseudo-tooltip-frontend)
	240	(const :tag "pseudo tooltip, multiple only"
	241	company-pseudo-tooltip-unless-just-one-frontend)
	242	(const :tag "pseudo tooltip, multiple only, delayed"
	243	company-pseudo-tooltip-unless-just-one-frontend-with-delay)
	244	(const :tag "preview" company-preview-frontend)
	245	(const :tag "preview, unique only"
	246	company-preview-if-just-one-frontend)
	247	(const :tag "preview, common"
	248	company-preview-common-frontend)
	249	(function :tag "custom function" nil))))
	250
	251	(defcustom company-tooltip-limit 10
	252	"The maximum number of candidates in the tooltip."
	253	:type 'integer)
	254
	255	(defcustom company-tooltip-minimum 6
	256	"The minimum height of the tooltip.
	257	If this many lines are not available, prefer to display the tooltip above."
	258	:type 'integer)
	259
	260	(defcustom company-tooltip-minimum-width 0
	261	"The minimum width of the tooltip's inner area.
	262	This doesn't include the margins and the scroll bar."
	263	:type 'integer
	264	:package-version '(company . "0.8.0"))
	265
	266	(defcustom company-tooltip-maximum-width most-positive-fixnum
	267	"The maximum width of the tooltip's inner area.
	268	This doesn't include the margins and the scroll bar."
	269	:type 'integer
	270	:package-version '(company . "0.9.5"))
	271
	272	(defcustom company-tooltip-margin 1
	273	"Width of margin columns to show around the toolip."
	274	:type 'integer)
	275
	276	(defcustom company-tooltip-offset-display 'scrollbar
	277	"Method using which the tooltip displays scrolling position.
	278	`scrollbar' means draw a scrollbar to the right of the items.
	279	`lines' means wrap items in lines with \"before\" and \"after\" counters."
	280	:type '(choice (const :tag "Scrollbar" scrollbar)
	281	(const :tag "Two lines" lines)))
	282
	283	(defcustom company-tooltip-align-annotations nil
	284	"When non-nil, align annotations to the right tooltip border."
	285	:type 'boolean
	286	:package-version '(company . "0.7.1"))
	287
	288	(defcustom company-tooltip-flip-when-above nil
	289	"Whether to flip the tooltip when it's above the current line."
	290	:type 'boolean
	291	:package-version '(company . "0.8.1"))
	292
	293	(defvar company-safe-backends
	294	'((company-abbrev . "Abbrev")
	295	(company-bbdb . "BBDB")
	296	(company-capf . "completion-at-point-functions")
	297	(company-clang . "Clang")
	298	(company-cmake . "CMake")
	299	(company-css . "CSS")
	300	(company-dabbrev . "dabbrev for plain text")
	301	(company-dabbrev-code . "dabbrev for code")
	302	(company-eclim . "Eclim (an Eclipse interface)")
	303	(company-elisp . "Emacs Lisp")
	304	(company-etags . "etags")
	305	(company-files . "Files")
	306	(company-gtags . "GNU Global")
	307	(company-ispell . "Ispell")
	308	(company-keywords . "Programming language keywords")
	309	(company-nxml . "nxml")
	310	(company-oddmuse . "Oddmuse")
	311	(company-semantic . "Semantic")
	312	(company-tempo . "Tempo templates")
	313	(company-xcode . "Xcode")))
	314	(put 'company-safe-backends 'risky-local-variable t)
	315
	316	(defun company-safe-backends-p (backends)
	317	(and (consp backends)
	318	(not (cl-dolist (backend backends)
	319	(unless (if (consp backend)
	320	(company-safe-backends-p backend)
	321	(assq backend company-safe-backends))
	322	(cl-return t))))))
	323
	324	(defcustom company-backends `(,@(unless (version< "24.3.51" emacs-version)
	325	(list 'company-elisp))
	326	company-bbdb
	327	,@(unless (version<= "26" emacs-version)
	328	(list 'company-nxml))
	329	,@(unless (version<= "26" emacs-version)
	330	(list 'company-css))
	331	company-eclim company-semantic company-clang
	332	company-xcode company-cmake
	333	company-capf
	334	company-files
	335	(company-dabbrev-code company-gtags company-etags
	336	company-keywords)
	337	company-oddmuse company-dabbrev)
	338	"The list of active backends (completion engines).
	339
	340	Only one backend is used at a time. The choice depends on the order of
	341	the items in this list, and on the values they return in response to the
	342	`prefix' command (see below). But a backend can also be a \"grouped\"
	343	one (see below).
	344
	345	`company-begin-backend' can be used to start a specific backend,
	346	`company-other-backend' will skip to the next matching backend in the list.
	347
	348	Each backend is a function that takes a variable number of arguments.
	349	The first argument is the command requested from the backend. It is one
	350	of the following:
	351
	352	`prefix': The backend should return the text to be completed. It must be
	353	text immediately before point. Returning nil from this command passes
	354	control to the next backend. The function should return `stop' if it
	355	should complete but cannot (e.g. when in the middle of a symbol).
	356	Instead of a string, the backend may return a cons (PREFIX . LENGTH)
	357	where LENGTH is a number used in place of PREFIX's length when
	358	comparing against `company-minimum-prefix-length'. LENGTH can also
	359	be just t, and in the latter case the test automatically succeeds.
	360
	361	`candidates': The second argument is the prefix to be completed. The
	362	return value should be a list of candidates that match the prefix.
	363
	364	Non-prefix matches are also supported (candidates that don't start with the
	365	prefix, but match it in some backend-defined way). Backends that use this
	366	feature must disable cache (return t to `no-cache') and might also want to
	367	respond to `match'.
	368
	369	Optional commands
	370	=================
	371
	372	`sorted': Return t here to indicate that the candidates are sorted and will
	373	not need to be sorted again.
	374
	375	`duplicates': If non-nil, company will take care of removing duplicates
	376	from the list.
	377
	378	`no-cache': Usually company doesn't ask for candidates again as completion
	379	progresses, unless the backend returns t for this command. The second
	380	argument is the latest prefix.
	381
	382	`ignore-case': Return t here if the backend returns case-insensitive
	383	matches. This value is used to determine the longest common prefix (as
	384	used in `company-complete-common'), and to filter completions when fetching
	385	them from cache.
	386
	387	`meta': The second argument is a completion candidate. Return a (short)
	388	documentation string for it.
	389
	390	`doc-buffer': The second argument is a completion candidate. Return a
	391	buffer with documentation for it. Preferably use `company-doc-buffer'. If
	392	not all buffer contents pertain to this candidate, return a cons of buffer
	393	and window start position.
	394
	395	`location': The second argument is a completion candidate. Return a cons
	396	of buffer and buffer location, or of file and line number where the
	397	completion candidate was defined.
	398
	399	`annotation': The second argument is a completion candidate. Return a
	400	string to be displayed inline with the candidate in the popup. If
	401	duplicates are removed by company, candidates with equal string values will
	402	be kept if they have different annotations. For that to work properly,
	403	backends should store the related information on candidates using text
	404	properties.
	405
	406	`match': The second argument is a completion candidate. Return a positive
	407	integer, the index after the end of text matching `prefix' within the
	408	candidate string. Alternatively, return a list of (CHUNK-START
	409	. CHUNK-END) elements, where CHUNK-START and CHUNK-END are indexes within
	410	the candidate string. The corresponding regions are be used when rendering
	411	the popup. This command only makes sense for backends that provide
	412	non-prefix completion.
	413
	414	`require-match': If this returns t, the user is not allowed to enter
	415	anything not offered as a candidate. Please don't use that value in normal
	416	backends. The default value nil gives the user that choice with
	417	`company-require-match'. Return value `never' overrides that option the
	418	other way around.
	419
	420	`init': Called once for each buffer. The backend can check for external
	421	programs and files and load any required libraries. Raising an error here
	422	will show up in message log once, and the backend will not be used for
	423	completion.
	424
	425	`post-completion': Called after a completion candidate has been inserted
	426	into the buffer. The second argument is the candidate. Can be used to
	427	modify it, e.g. to expand a snippet.
	428
	429	The backend should return nil for all commands it does not support or
	430	does not know about. It should also be callable interactively and use
	431	`company-begin-backend' to start itself in that case.
	432
	433	Grouped backends
	434	================
	435
	436	An element of `company-backends' can also be a list of backends. The
	437	completions from backends in such groups are merged, but only from those
	438	backends which return the same `prefix'.
	439
	440	If a backend command takes a candidate as an argument (e.g. `meta'), the
	441	call is dispatched to the backend the candidate came from. In other
	442	cases (except for `duplicates' and `sorted'), the first non-nil value among
	443	all the backends is returned.
	444
	445	The group can also contain keywords. Currently, `:with' and `:separate'
	446	keywords are defined. If the group contains keyword `:with', the backends
	447	listed after this keyword are ignored for the purpose of the `prefix'
	448	command. If the group contains keyword `:separate', the candidates that
	449	come from different backends are sorted separately in the combined list.
	450
	451	Asynchronous backends
	452	=====================
	453
	454	The return value of each command can also be a cons (:async . FETCHER)
	455	where FETCHER is a function of one argument, CALLBACK. When the data
	456	arrives, FETCHER must call CALLBACK and pass it the appropriate return
	457	value, as described above. That call must happen in the same buffer as
	458	where completion was initiated.
	459
	460	True asynchronous operation is only supported for command `candidates', and
	461	only during idle completion. Other commands will block the user interface,
	462	even if the backend uses the asynchronous calling convention."
	463	:type `(repeat
	464	(choice
	465	:tag "backend"
	466	,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b)))
	467	company-safe-backends)
	468	(symbol :tag "User defined")
	469	(repeat :tag "Merged backends"
	470	(choice :tag "backend"
	471	,@(mapcar (lambda (b)
	472	`(const :tag ,(cdr b) ,(car b)))
	473	company-safe-backends)
	474	(const :tag "With" :with)
	475	(symbol :tag "User defined"))))))
	476
	477	(put 'company-backends 'safe-local-variable 'company-safe-backends-p)
	478
	479	(defcustom company-transformers nil
	480	"Functions to change the list of candidates received from backends.
	481
	482	Each function gets called with the return value of the previous one.
	483	The first one gets passed the list of candidates, already sorted and
	484	without duplicates."
	485	:type '(choice
	486	(const :tag "None" nil)
	487	(const :tag "Sort by occurrence" (company-sort-by-occurrence))
	488	(const :tag "Sort by backend importance"
	489	(company-sort-by-backend-importance))
	490	(const :tag "Prefer case sensitive prefix"
	491	(company-sort-prefer-same-case-prefix))
	492	(repeat :tag "User defined" (function))))
	493
	494	(defcustom company-completion-started-hook nil
	495	"Hook run when company starts completing.
	496	The hook is called with one argument that is non-nil if the completion was
	497	started manually."
	498	:type 'hook)
	499
	500	(defcustom company-completion-cancelled-hook nil
	501	"Hook run when company cancels completing.
	502	The hook is called with one argument that is non-nil if the completion was
	503	aborted manually."
	504	:type 'hook)
	505
	506	(defcustom company-completion-finished-hook nil
	507	"Hook run when company successfully completes.
	508	The hook is called with the selected candidate as an argument.
	509
	510	If you indend to use it to post-process candidates from a specific
	511	backend, consider using the `post-completion' command instead."
	512	:type 'hook)
	513
	514	(defcustom company-minimum-prefix-length 3
	515	"The minimum prefix length for idle completion."
	516	:type '(integer :tag "prefix length"))
	517
	518	(defcustom company-abort-manual-when-too-short nil
	519	"If enabled, cancel a manually started completion when the prefix gets
	520	shorter than both `company-minimum-prefix-length' and the length of the
	521	prefix it was started from."
	522	:type 'boolean
	523	:package-version '(company . "0.8.0"))
	524
	525	(defcustom company-require-match 'company-explicit-action-p
	526	"If enabled, disallow non-matching input.
	527	This can be a function do determine if a match is required.
	528
	529	This can be overridden by the backend, if it returns t or `never' to
	530	`require-match'. `company-auto-complete' also takes precedence over this."
	531	:type '(choice (const :tag "Off" nil)
	532	(function :tag "Predicate function")
	533	(const :tag "On, if user interaction took place"
	534	'company-explicit-action-p)
	535	(const :tag "On" t)))
	536
	537	(defcustom company-auto-complete nil
	538	"Determines when to auto-complete.
	539	If this is enabled, all characters from `company-auto-complete-chars'
	540	trigger insertion of the selected completion candidate.
	541	This can also be a function."
	542	:type '(choice (const :tag "Off" nil)
	543	(function :tag "Predicate function")
	544	(const :tag "On, if user interaction took place"
	545	'company-explicit-action-p)
	546	(const :tag "On" t)))
	547
	548	(defcustom company-auto-complete-chars '(?\ ?\) ?.)
	549	"Determines which characters trigger auto-completion.
	550	See `company-auto-complete'. If this is a string, each string character
	551	tiggers auto-completion. If it is a list of syntax description characters (see
	552	`modify-syntax-entry'), all characters with that syntax auto-complete.
	553
	554	This can also be a function, which is called with the new input and should
	555	return non-nil if company should auto-complete.
	556
	557	A character that is part of a valid candidate never triggers auto-completion."
	558	:type '(choice (string :tag "Characters")
	559	(set :tag "Syntax"
	560	(const :tag "Whitespace" ?\ )
	561	(const :tag "Symbol" ?_)
	562	(const :tag "Opening parentheses" ?\()
	563	(const :tag "Closing parentheses" ?\))
	564	(const :tag "Word constituent" ?w)
	565	(const :tag "Punctuation." ?.)
	566	(const :tag "String quote." ?\")
	567	(const :tag "Paired delimiter." ?$)
	568	(const :tag "Expression quote or prefix operator." ?\')
	569	(const :tag "Comment starter." ?<)
	570	(const :tag "Comment ender." ?>)
	571	(const :tag "Character-quote." ?/)
	572	(const :tag "Generic string fence." ?\|)
	573	(const :tag "Generic comment fence." ?!))
	574	(function :tag "Predicate function")))
	575
	576	(defcustom company-idle-delay .5
	577	"The idle delay in seconds until completion starts automatically.
	578	The prefix still has to satisfy `company-minimum-prefix-length' before that
	579	happens. The value of nil means no idle completion."
	580	:type '(choice (const :tag "never (nil)" nil)
	581	(const :tag "immediate (0)" 0)
	582	(number :tag "seconds")))
	583
	584	(defcustom company-tooltip-idle-delay .5
	585	"The idle delay in seconds until tooltip is shown when using
	586	`company-pseudo-tooltip-unless-just-one-frontend-with-delay'."
	587	:type '(choice (const :tag "never (nil)" nil)
	588	(const :tag "immediate (0)" 0)
	589	(number :tag "seconds")))
	590
	591	(defcustom company-begin-commands '(self-insert-command
	592	org-self-insert-command
	593	orgtbl-self-insert-command
	594	c-scope-operator
	595	c-electric-colon
	596	c-electric-lt-gt
	597	c-electric-slash)
	598	"A list of commands after which idle completion is allowed.
	599	If this is t, it can show completions after any command except a few from a
	600	pre-defined list. See `company-idle-delay'.
	601
	602	Alternatively, any command with a non-nil `company-begin' property is
	603	treated as if it was on this list."
	604	:type '(choice (const :tag "Any command" t)
	605	(const :tag "Self insert command" '(self-insert-command))
	606	(repeat :tag "Commands" function))
	607	:package-version '(company . "0.8.4"))
	608
	609	(defcustom company-continue-commands '(not save-buffer save-some-buffers
	610	save-buffers-kill-terminal
	611	save-buffers-kill-emacs
	612	completion-at-point)
	613	"A list of commands that are allowed during completion.
	614	If this is t, or if `company-begin-commands' is t, any command is allowed.
	615	Otherwise, the value must be a list of symbols. If it starts with `not',
	616	the cdr is the list of commands that abort completion. Otherwise, all
	617	commands except those in that list, or in `company-begin-commands', or
	618	commands in the `company-' namespace, abort completion."
	619	:type '(choice (const :tag "Any command" t)
	620	(cons :tag "Any except"
	621	(const not)
	622	(repeat :tag "Commands" function))
	623	(repeat :tag "Commands" function)))
	624
	625	(defcustom company-show-numbers nil
	626	"If enabled, show quick-access numbers for the first ten candidates."
	627	:type '(choice (const :tag "off" nil)
	628	(const :tag "on" t)))
	629
	630	(defcustom company-selection-wrap-around nil
	631	"If enabled, selecting item before first or after last wraps around."
	632	:type '(choice (const :tag "off" nil)
	633	(const :tag "on" t)))
	634
	635	(defvar company-async-wait 0.03
	636	"Pause between checks to see if the value's been set when turning an
	637	asynchronous call into synchronous.")
	638
	639	(defvar company-async-timeout 2
	640	"Maximum wait time for a value to be set during asynchronous call.")
	641
	642	;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	643
	644	(defvar company-mode-map (make-sparse-keymap)
	645	"Keymap used by `company-mode'.")
	646
	647	(defvar company-active-map
	648	(let ((keymap (make-sparse-keymap)))
	649	(define-key keymap "\e\e\e" 'company-abort)
	650	(define-key keymap "\C-g" 'company-abort)
	651	(define-key keymap (kbd "M-n") 'company-select-next)
	652	(define-key keymap (kbd "M-p") 'company-select-previous)
	653	(define-key keymap (kbd "<down>") 'company-select-next-or-abort)
	654	(define-key keymap (kbd "<up>") 'company-select-previous-or-abort)
	655	(define-key keymap [remap scroll-up-command] 'company-next-page)
	656	(define-key keymap [remap scroll-down-command] 'company-previous-page)
	657	(define-key keymap [down-mouse-1] 'ignore)
	658	(define-key keymap [down-mouse-3] 'ignore)
	659	(define-key keymap [mouse-1] 'company-complete-mouse)
	660	(define-key keymap [mouse-3] 'company-select-mouse)
	661	(define-key keymap [up-mouse-1] 'ignore)
	662	(define-key keymap [up-mouse-3] 'ignore)
	663	(define-key keymap [return] 'company-complete-selection)
	664	(define-key keymap (kbd "RET") 'company-complete-selection)
	665	(define-key keymap [tab] 'company-complete-common)
	666	(define-key keymap (kbd "TAB") 'company-complete-common)
	667	(define-key keymap (kbd "<f1>") 'company-show-doc-buffer)
	668	(define-key keymap (kbd "C-h") 'company-show-doc-buffer)
	669	(define-key keymap "\C-w" 'company-show-location)
	670	(define-key keymap "\C-s" 'company-search-candidates)
	671	(define-key keymap "\C-\M-s" 'company-filter-candidates)
	672	(dotimes (i 10)
	673	(define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
	674	keymap)
	675	"Keymap that is enabled during an active completion.")
	676
	677	(defvar company--disabled-backends nil)
	678
	679	(defun company-init-backend (backend)
	680	(and (symbolp backend)
	681	(not (fboundp backend))
	682	(ignore-errors (require backend nil t)))
	683	(cond
	684	((symbolp backend)
	685	(condition-case err
	686	(progn
	687	(funcall backend 'init)
	688	(put backend 'company-init t))
	689	(error
	690	(put backend 'company-init 'failed)
	691	(unless (memq backend company--disabled-backends)
	692	(message "Company backend '%s' could not be initialized:\n%s"
	693	backend (error-message-string err)))
	694	(cl-pushnew backend company--disabled-backends)
	695	nil)))
	696	;; No initialization for lambdas.
	697	((functionp backend) t)
	698	(t ;; Must be a list.
	699	(cl-dolist (b backend)
	700	(unless (keywordp b)
	701	(company-init-backend b))))))
	702
	703	(defun company--maybe-init-backend (backend)
	704	(or (not (symbolp backend))
	705	(eq t (get backend 'company-init))
	706	(unless (get backend 'company-init)
	707	(company-init-backend backend))))
	708
	709	(defcustom company-lighter-base "company"
	710	"Base string to use for the `company-mode' lighter."
	711	:type 'string
	712	:package-version '(company . "0.8.10"))
	713
	714	(defvar company-lighter '(" "
	715	(company-candidates
	716	(:eval
	717	(if (consp company-backend)
	718	(company--group-lighter (nth company-selection
	719	company-candidates)
	720	company-lighter-base)
	721	(symbol-name company-backend)))
	722	company-lighter-base))
	723	"Mode line lighter for Company.
	724
	725	The value of this variable is a mode line template as in
	726	`mode-line-format'.")
	727
	728	(put 'company-lighter 'risky-local-variable t)
	729
	730	;;;###autoload
	731	(define-minor-mode company-mode
	732	"\"complete anything\"; is an in-buffer completion framework.
	733	Completion starts automatically, depending on the values
	734	`company-idle-delay' and `company-minimum-prefix-length'.
	735
	736	Completion can be controlled with the commands:
	737	`company-complete-common', `company-complete-selection', `company-complete',
	738	`company-select-next', `company-select-previous'. If these commands are
	739	called before `company-idle-delay', completion will also start.
	740
	741	Completions can be searched with `company-search-candidates' or
	742	`company-filter-candidates'. These can be used while completion is
	743	inactive, as well.
	744
	745	The completion data is retrieved using `company-backends' and displayed
	746	using `company-frontends'. If you want to start a specific backend, call
	747	it interactively or use `company-begin-backend'.
	748
	749	By default, the completions list is sorted alphabetically, unless the
	750	backend chooses otherwise, or `company-transformers' changes it later.
	751
	752	regular keymap (`company-mode-map'):
	753
	754	\\{company-mode-map}
	755	keymap during active completions (`company-active-map'):
	756
	757	\\{company-active-map}"
	758	nil company-lighter company-mode-map
	759	(if company-mode
	760	(progn
	761	(add-hook 'pre-command-hook 'company-pre-command nil t)
	762	(add-hook 'post-command-hook 'company-post-command nil t)
	763	(mapc 'company-init-backend company-backends))
	764	(remove-hook 'pre-command-hook 'company-pre-command t)
	765	(remove-hook 'post-command-hook 'company-post-command t)
	766	(company-cancel)
	767	(kill-local-variable 'company-point)))
	768
	769	(defcustom company-global-modes t
	770	"Modes for which `company-mode' mode is turned on by `global-company-mode'.
	771	If nil, means no modes. If t, then all major modes have it turned on.
	772	If a list, it should be a list of `major-mode' symbol names for which
	773	`company-mode' should be automatically turned on. The sense of the list is
	774	negated if it begins with `not'. For example:
	775	(c-mode c++-mode)
	776	means that `company-mode' is turned on for buffers in C and C++ modes only.
	777	(not message-mode)
	778	means that `company-mode' is always turned on except in `message-mode' buffers."
	779	:type '(choice (const :tag "none" nil)
	780	(const :tag "all" t)
	781	(set :menu-tag "mode specific" :tag "modes"
	782	:value (not)
	783	(const :tag "Except" not)
	784	(repeat :inline t (symbol :tag "mode")))))
	785
	786	;;;###autoload
	787	(define-globalized-minor-mode global-company-mode company-mode company-mode-on)
	788
	789	(defun company-mode-on ()
	790	(when (and (not (or noninteractive (eq (aref (buffer-name) 0) ?\s)))
	791	(cond ((eq company-global-modes t)
	792	t)
	793	((eq (car-safe company-global-modes) 'not)
	794	(not (memq major-mode (cdr company-global-modes))))
	795	(t (memq major-mode company-global-modes))))
	796	(company-mode 1)))
	797
	798	(defsubst company-assert-enabled ()
	799	(unless company-mode
	800	(company-uninstall-map)
	801	(user-error "Company not enabled")))
	802
	803	;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	804
	805	(defvar-local company-my-keymap nil)
	806
	807	(defvar company-emulation-alist '((t . nil)))
	808
	809	(defsubst company-enable-overriding-keymap (keymap)
	810	(company-uninstall-map)
	811	(setq company-my-keymap keymap))
	812
	813	(defun company-ensure-emulation-alist ()
	814	(unless (eq 'company-emulation-alist (car emulation-mode-map-alists))
	815	(setq emulation-mode-map-alists
	816	(cons 'company-emulation-alist
	817	(delq 'company-emulation-alist emulation-mode-map-alists)))))
	818
	819	(defun company-install-map ()
	820	(unless (or (cdar company-emulation-alist)
	821	(null company-my-keymap))
	822	(setf (cdar company-emulation-alist) company-my-keymap)))
	823
	824	(defun company-uninstall-map ()
	825	(setf (cdar company-emulation-alist) nil))
	826
	827	(defun company--company-command-p (keys)
	828	"Checks if the keys are part of company's overriding keymap"
	829	(or (equal [company-dummy-event] keys)
	830	(lookup-key company-my-keymap keys)))
	831
	832	;; Hack:
	833	;; Emacs calculates the active keymaps before reading the event. That means we
	834	;; cannot change the keymap from a timer. So we send a bogus command.
	835	;; XXX: Even in Emacs 24.4, seems to be needed in the terminal.
	836	(defun company-ignore ()
	837	(interactive)
	838	(setq this-command last-command))
	839
	840	(global-set-key '[company-dummy-event] 'company-ignore)
	841
	842	(defun company-input-noop ()
	843	(push 'company-dummy-event unread-command-events))
	844
	845	;; To avoid warnings in Emacs < 26.
	846	(declare-function line-number-display-width "indent.c")
	847
	848	(defun company--posn-col-row (posn)
	849	(let ((col (car (posn-col-row posn)))
	850	;; `posn-col-row' doesn't work well with lines of different height.
	851	;; `posn-actual-col-row' doesn't handle multiple-width characters.
	852	(row (cdr (or (posn-actual-col-row posn)
	853	;; When position is non-visible for some reason.
	854	(posn-col-row posn)))))
	855	(when (and header-line-format (version< emacs-version "24.3.93.3"))
	856	;; http://debbugs.gnu.org/18384
	857	(cl-decf row))
	858	(when (bound-and-true-p display-line-numbers)
	859	(cl-decf col (+ 2 (line-number-display-width))))
	860	(cons (+ col (window-hscroll)) row)))
	861
	862	(defun company--col-row (&optional pos)
	863	(company--posn-col-row (posn-at-point pos)))
	864
	865	(defun company--row (&optional pos)
	866	(cdr (company--col-row pos)))
	867
	868	;;; backends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	869
	870	(defvar-local company-backend nil)
	871
	872	(defun company-grab (regexp &optional expression limit)
	873	(when (looking-back regexp limit)
	874	(or (match-string-no-properties (or expression 0)) "")))
	875
	876	(defun company-grab-line (regexp &optional expression)
	877	"Return a match string for REGEXP if it matches text before point.
	878	If EXPRESSION is non-nil, return the match string for the respective
	879	parenthesized expression in REGEXP.
	880	Matching is limited to the current line."
	881	(let ((inhibit-field-text-motion t))
	882	(company-grab regexp expression (point-at-bol))))
	883
	884	(defun company-grab-symbol ()
	885	"If point is at the end of a symbol, return it.
	886	Otherwise, if point is not inside a symbol, return an empty string."
	887	(if (looking-at "\\_>")
	888	(buffer-substring (point) (save-excursion (skip-syntax-backward "w_")
	889	(point)))
	890	(unless (and (char-after) (memq (char-syntax (char-after)) '(?w ?_)))
	891	"")))
	892
	893	(defun company-grab-word ()
	894	"If point is at the end of a word, return it.
	895	Otherwise, if point is not inside a symbol, return an empty string."
	896	(if (looking-at "\\>")
	897	(buffer-substring (point) (save-excursion (skip-syntax-backward "w")
	898	(point)))
	899	(unless (and (char-after) (eq (char-syntax (char-after)) ?w))
	900	"")))
	901
	902	(defun company-grab-symbol-cons (idle-begin-after-re &optional max-len)
	903	"Return a string SYMBOL or a cons (SYMBOL . t).
	904	SYMBOL is as returned by `company-grab-symbol'. If the text before point
	905	matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
	906	(let ((symbol (company-grab-symbol)))
	907	(when symbol
	908	(save-excursion
	909	(forward-char (- (length symbol)))
	910	(if (looking-back idle-begin-after-re (if max-len
	911	(- (point) max-len)
	912	(line-beginning-position)))
	913	(cons symbol t)
	914	symbol)))))
	915
	916	(defun company-in-string-or-comment ()
	917	"Return non-nil if point is within a string or comment."
	918	(let ((ppss (syntax-ppss)))
	919	(or (car (setq ppss (nthcdr 3 ppss)))
	920	(car (setq ppss (cdr ppss)))
	921	(nth 3 ppss))))
	922
	923	(defun company-call-backend (&rest args)
	924	(company--force-sync #'company-call-backend-raw args company-backend))
	925
	926	(defun company--force-sync (fun args backend)
	927	(let ((value (apply fun args)))
	928	(if (not (eq (car-safe value) :async))
	929	value
	930	(let ((res 'trash)
	931	(start (time-to-seconds)))
	932	(funcall (cdr value)
	933	(lambda (result) (setq res result)))
	934	(while (eq res 'trash)
	935	(if (> (- (time-to-seconds) start) company-async-timeout)
	936	(error "Company: backend %s async timeout with args %s"
	937	backend args)
	938	;; XXX: Reusing the trick from company--fetch-candidates here
	939	;; doesn't work well: sit-for isn't a good fit when we want to
	940	;; ignore pending input (results in too many calls).
	941	;; FIXME: We should deal with this by standardizing on a kind of
	942	;; Future object that knows how to sync itself. In most cases (but
	943	;; not all), by calling accept-process-output, probably.
	944	(sleep-for company-async-wait)))
	945	res))))
	946
	947	(defun company-call-backend-raw (&rest args)
	948	(condition-case-unless-debug err
	949	(if (functionp company-backend)
	950	(apply company-backend args)
	951	(apply #'company--multi-backend-adapter company-backend args))
	952	(user-error (user-error
	953	"Company: backend %s user-error: %s"
	954	company-backend (error-message-string err)))
	955	(error (error "Company: backend %s error \"%s\" with args %s"
	956	company-backend (error-message-string err) args))))
	957
	958	(defun company--multi-backend-adapter (backends command &rest args)
	959	(let ((backends (cl-loop for b in backends
	960	when (or (keywordp b)
	961	(company--maybe-init-backend b))
	962	collect b))
	963	(separate (memq :separate backends)))
	964
	965	(when (eq command 'prefix)
	966	(setq backends (butlast backends (length (member :with backends)))))
	967
	968	(setq backends (cl-delete-if #'keywordp backends))
	969
	970	(pcase command
	971	(`candidates
	972	(company--multi-backend-adapter-candidates backends (car args) separate))
	973	(`sorted separate)
	974	(`duplicates (not separate))
	975	((or `prefix `ignore-case `no-cache `require-match)
	976	(let (value)
	977	(cl-dolist (backend backends)
	978	(when (setq value (company--force-sync
	979	backend (cons command args) backend))
	980	(cl-return value)))))
	981	(_
	982	(let ((arg (car args)))
	983	(when (> (length arg) 0)
	984	(let ((backend (or (get-text-property 0 'company-backend arg)
	985	(car backends))))
	986	(apply backend command args))))))))
	987
	988	(defun company--multi-backend-adapter-candidates (backends prefix separate)
	989	(let ((pairs (cl-loop for backend in backends
	990	when (equal (company--prefix-str
	991	(let ((company-backend backend))
	992	(company-call-backend 'prefix)))
	993	prefix)
	994	collect (cons (funcall backend 'candidates prefix)
	995	(company--multi-candidates-mapper
	996	backend
	997	separate
	998	;; Small perf optimization: don't tag the
	999	;; candidates received from the first
	1000	;; backend in the group.
	1001	(not (eq backend (car backends))))))))
	1002	(company--merge-async pairs (lambda (values) (apply #'append values)))))
	1003
	1004	(defun company--multi-candidates-mapper (backend separate tag)
	1005	(lambda (candidates)
	1006	(when separate
	1007	(let ((company-backend backend))
	1008	(setq candidates
	1009	(company--preprocess-candidates candidates))))
	1010	(when tag
	1011	(setq candidates
	1012	(mapcar
	1013	(lambda (str)
	1014	(propertize str 'company-backend backend))
	1015	candidates)))
	1016	candidates))
	1017
	1018	(defun company--merge-async (pairs merger)
	1019	(let ((async (cl-loop for pair in pairs
	1020	thereis
	1021	(eq :async (car-safe (car pair))))))
	1022	(if (not async)
	1023	(funcall merger (cl-loop for (val . mapper) in pairs
	1024	collect (funcall mapper val)))
	1025	(cons
	1026	:async
	1027	(lambda (callback)
	1028	(let* (lst
	1029	(pending (mapcar #'car pairs))
	1030	(finisher (lambda ()
	1031	(unless pending
	1032	(funcall callback
	1033	(funcall merger
	1034	(nreverse lst)))))))
	1035	(dolist (pair pairs)
	1036	(push nil lst)
	1037	(let* ((cell lst)
	1038	(val (car pair))
	1039	(mapper (cdr pair))
	1040	(this-finisher (lambda (res)
	1041	(setq pending (delq val pending))
	1042	(setcar cell (funcall mapper res))
	1043	(funcall finisher))))
	1044	(if (not (eq :async (car-safe val)))
	1045	(funcall this-finisher val)
	1046	(let ((fetcher (cdr val)))
	1047	(funcall fetcher this-finisher)))))))))))
	1048
	1049	(defun company--prefix-str (prefix)
	1050	(or (car-safe prefix) prefix))
	1051
	1052	;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	1053
	1054	(defvar-local company-prefix nil)
	1055
	1056	(defvar-local company-candidates nil)
	1057
	1058	(defvar-local company-candidates-length nil)
	1059
	1060	(defvar-local company-candidates-cache nil)
	1061
	1062	(defvar-local company-candidates-predicate nil)
	1063
	1064	(defvar-local company-common nil)
	1065
	1066	(defvar-local company-selection 0)
	1067
	1068	(defvar-local company-selection-changed nil)
	1069
	1070	(defvar-local company--manual-action nil
	1071	"Non-nil, if manual completion took place.")
	1072
	1073	(defvar-local company--manual-prefix nil)
	1074
	1075	(defvar company--auto-completion nil
	1076	"Non-nil when current candidate is being inserted automatically.
	1077	Controlled by `company-auto-complete'.")
	1078
	1079	(defvar-local company--point-max nil)
	1080
	1081	(defvar-local company-point nil)
	1082
	1083	(defvar company-timer nil)
	1084	(defvar company-tooltip-timer nil)
	1085
	1086	(defsubst company-strip-prefix (str)
	1087	(substring str (length company-prefix)))
	1088
	1089	(defun company--insert-candidate (candidate)
	1090	(when (> (length candidate) 0)
	1091	(setq candidate (substring-no-properties candidate))
	1092	;; XXX: Return value we check here is subject to change.
	1093	(if (eq (company-call-backend 'ignore-case) 'keep-prefix)
	1094	(insert (company-strip-prefix candidate))
	1095	(unless (equal company-prefix candidate)
	1096	(delete-region (- (point) (length company-prefix)) (point))
	1097	(insert candidate)))))
	1098
	1099	(defmacro company-with-candidate-inserted (candidate &rest body)
	1100	"Evaluate BODY with CANDIDATE temporarily inserted.
	1101	This is a tool for backends that need candidates inserted before they
	1102	can retrieve meta-data for them."
	1103	(declare (indent 1))
	1104	`(let ((inhibit-modification-hooks t)
	1105	(inhibit-point-motion-hooks t)
	1106	(modified-p (buffer-modified-p)))
	1107	(company--insert-candidate ,candidate)
	1108	(unwind-protect
	1109	(progn ,@body)
	1110	(delete-region company-point (point))
	1111	(set-buffer-modified-p modified-p))))
	1112
	1113	(defun company-explicit-action-p ()
	1114	"Return whether explicit completion action was taken by the user."
	1115	(or company--manual-action
	1116	company-selection-changed))
	1117
	1118	(defun company-reformat (candidate)
	1119	;; company-ispell needs this, because the results are always lower-case
	1120	;; It's mory efficient to fix it only when they are displayed.
	1121	;; FIXME: Adopt the current text's capitalization instead?
	1122	(if (eq (company-call-backend 'ignore-case) 'keep-prefix)
	1123	(concat company-prefix (substring candidate (length company-prefix)))
	1124	candidate))
	1125
	1126	(defun company--should-complete ()
	1127	(and (eq company-idle-delay 'now)
	1128	(not (or buffer-read-only
	1129	overriding-local-map))
	1130	;; Check if in the middle of entering a key combination.
	1131	(or (equal (this-command-keys-vector) [])
	1132	(not (keymapp (key-binding (this-command-keys-vector)))))
	1133	(not (and transient-mark-mode mark-active))))
	1134
	1135	(defun company--should-continue ()
	1136	(or (eq t company-begin-commands)
	1137	(eq t company-continue-commands)
	1138	(if (eq 'not (car company-continue-commands))
	1139	(not (memq this-command (cdr company-continue-commands)))
	1140	(or (memq this-command company-begin-commands)
	1141	(memq this-command company-continue-commands)
	1142	(and (symbolp this-command)
	1143	(string-match-p "\\`company-" (symbol-name this-command)))))))
	1144
	1145	(defun company-call-frontends (command)
	1146	(dolist (frontend company-frontends)
	1147	(condition-case-unless-debug err
	1148	(funcall frontend command)
	1149	(error (error "Company: frontend %s error \"%s\" on command %s"
	1150	frontend (error-message-string err) command)))))
	1151
	1152	(defun company-set-selection (selection &optional force-update)
	1153	(setq selection
	1154	(if company-selection-wrap-around
	1155	(mod selection company-candidates-length)
	1156	(max 0 (min (1- company-candidates-length) selection))))
	1157	(when (or force-update (not (equal selection company-selection)))
	1158	(setq company-selection selection
	1159	company-selection-changed t)
	1160	(company-call-frontends 'update)))
	1161
	1162	(defun company--group-lighter (candidate base)
	1163	(let ((backend (or (get-text-property 0 'company-backend candidate)
	1164	(cl-some (lambda (x) (and (not (keywordp x)) x))
	1165	company-backend))))
	1166	(when (and backend (symbolp backend))
	1167	(let ((name (replace-regexp-in-string "company-\\\|-company" ""
	1168	(symbol-name backend))))
	1169	(format "%s-<%s>" base name)))))
	1170
	1171	(defun company-update-candidates (candidates)
	1172	(setq company-candidates-length (length candidates))
	1173	(if company-selection-changed
	1174	;; Try to restore the selection
	1175	(let ((selected (nth company-selection company-candidates)))
	1176	(setq company-selection 0
	1177	company-candidates candidates)
	1178	(when selected
	1179	(catch 'found
	1180	(while candidates
	1181	(let ((candidate (pop candidates)))
	1182	(when (and (string= candidate selected)
	1183	(equal (company-call-backend 'annotation candidate)
	1184	(company-call-backend 'annotation selected)))
	1185	(throw 'found t)))
	1186	(cl-incf company-selection))
	1187	(setq company-selection 0
	1188	company-selection-changed nil))))
	1189	(setq company-selection 0
	1190	company-candidates candidates))
	1191	;; Calculate common.
	1192	(let ((completion-ignore-case (company-call-backend 'ignore-case)))
	1193	;; We want to support non-prefix completion, so filtering is the
	1194	;; responsibility of each respective backend, not ours.
	1195	;; On the other hand, we don't want to replace non-prefix input in
	1196	;; `company-complete-common', unless there's only one candidate.
	1197	(setq company-common
	1198	(if (cdr company-candidates)
	1199	(let ((common (try-completion "" company-candidates)))
	1200	(when (string-prefix-p company-prefix common
	1201	completion-ignore-case)
	1202	common))
	1203	(car company-candidates)))))
	1204
	1205	(defun company-calculate-candidates (prefix)
	1206	(let ((candidates (cdr (assoc prefix company-candidates-cache)))
	1207	(ignore-case (company-call-backend 'ignore-case)))
	1208	(or candidates
	1209	(when company-candidates-cache
	1210	(let ((len (length prefix))
	1211	(completion-ignore-case ignore-case)
	1212	prev)
	1213	(cl-dotimes (i (1+ len))
	1214	(when (setq prev (cdr (assoc (substring prefix 0 (- len i))
	1215	company-candidates-cache)))
	1216	(setq candidates (all-completions prefix prev))
	1217	(cl-return t)))))
	1218	(progn
	1219	;; No cache match, call the backend.
	1220	(setq candidates (company--preprocess-candidates
	1221	(company--fetch-candidates prefix)))
	1222	;; Save in cache.
	1223	(push (cons prefix candidates) company-candidates-cache)))
	1224	;; Only now apply the predicate and transformers.
	1225	(setq candidates (company--postprocess-candidates candidates))
	1226	(when candidates
	1227	(if (or (cdr candidates)
	1228	(not (eq t (compare-strings (car candidates) nil nil
	1229	prefix nil nil ignore-case))))
	1230	candidates
	1231	;; Already completed and unique; don't start.
	1232	t))))
	1233
	1234	(defun company--fetch-candidates (prefix)
	1235	(let* ((non-essential (not (company-explicit-action-p)))
	1236	(c (if (or company-selection-changed
	1237	;; FIXME: This is not ideal, but we have not managed to deal
	1238	;; with these situations in a better way yet.
	1239	(company-require-match-p))
	1240	(company-call-backend 'candidates prefix)
	1241	(company-call-backend-raw 'candidates prefix))))
	1242	(if (not (eq (car c) :async))
	1243	c
	1244	(let ((res 'none)
	1245	(inhibit-redisplay t))
	1246	(funcall
	1247	(cdr c)
	1248	(lambda (candidates)
	1249	(when (eq res 'none)
	1250	(push 'company-foo unread-command-events))
	1251	(setq res candidates)))
	1252	(if (company--flyspell-workaround-p)
	1253	(while (and (eq res 'none)
	1254	(not (input-pending-p)))
	1255	(sleep-for company-async-wait))
	1256	(while (and (eq res 'none)
	1257	(sit-for 0.5 t))))
	1258	(while (member (car unread-command-events)
	1259	'(company-foo (t . company-foo)))
	1260	(pop unread-command-events))
	1261	(prog1
	1262	(and (consp res) res)
	1263	(setq res 'exited))))))
	1264
	1265	(defun company--flyspell-workaround-p ()
	1266	;; https://debbugs.gnu.org/23980
	1267	(and (bound-and-true-p flyspell-mode)
	1268	(version< emacs-version "27")))
	1269
	1270	(defun company--preprocess-candidates (candidates)
	1271	(cl-assert (cl-every #'stringp candidates))
	1272	(unless (company-call-backend 'sorted)
	1273	(setq candidates (sort candidates 'string<)))
	1274	(when (company-call-backend 'duplicates)
	1275	(company--strip-duplicates candidates))
	1276	candidates)
	1277
	1278	(defun company--postprocess-candidates (candidates)
	1279	(when (or company-candidates-predicate company-transformers)
	1280	(setq candidates (copy-sequence candidates)))
	1281	(when company-candidates-predicate
	1282	(setq candidates (cl-delete-if-not company-candidates-predicate candidates)))
	1283	(company--transform-candidates candidates))
	1284
	1285	(defun company--strip-duplicates (candidates)
	1286	(let ((c2 candidates)
	1287	(annos 'unk))
	1288	(while c2
	1289	(setcdr c2
	1290	(let ((str (pop c2)))
	1291	(while (let ((str2 (car c2)))
	1292	(if (not (equal str str2))
	1293	(progn
	1294	(setq annos 'unk)
	1295	nil)
	1296	(when (eq annos 'unk)
	1297	(setq annos (list (company-call-backend
	1298	'annotation str))))
	1299	(let ((anno2 (company-call-backend
	1300	'annotation str2)))
	1301	(if (member anno2 annos)
	1302	t
	1303	(push anno2 annos)
	1304	nil))))
	1305	(pop c2))
	1306	c2)))))
	1307
	1308	(defun company--transform-candidates (candidates)
	1309	(let ((c candidates))
	1310	(dolist (tr company-transformers)
	1311	(setq c (funcall tr c)))
	1312	c))
	1313
	1314	(defcustom company-occurrence-weight-function
	1315	#'company-occurrence-prefer-closest-above
	1316	"Function to weigh matches in `company-sort-by-occurrence'.
	1317	It's called with three arguments: cursor position, the beginning and the
	1318	end of the match."
	1319	:type '(choice
	1320	(const :tag "First above point, then below point"
	1321	company-occurrence-prefer-closest-above)
	1322	(const :tag "Prefer closest in any direction"
	1323	company-occurrence-prefer-any-closest)))
	1324
	1325	(defun company-occurrence-prefer-closest-above (pos match-beg match-end)
	1326	"Give priority to the matches above point, then those below point."
	1327	(if (< match-beg pos)
	1328	(- pos match-end)
	1329	(- match-beg (window-start))))
	1330
	1331	(defun company-occurrence-prefer-any-closest (pos _match-beg match-end)
	1332	"Give priority to the matches closest to the point."
	1333	(abs (- pos match-end)))
	1334
	1335	(defun company-sort-by-occurrence (candidates)
	1336	"Sort CANDIDATES according to their occurrences.
	1337	Searches for each in the currently visible part of the current buffer and
	1338	prioritizes the matches according to `company-occurrence-weight-function'.
	1339	The rest of the list is appended unchanged.
	1340	Keywords and function definition names are ignored."
	1341	(let* ((w-start (window-start))
	1342	(w-end (window-end))
	1343	(start-point (point))
	1344	occurs
	1345	(noccurs
	1346	(save-excursion
	1347	(cl-delete-if
	1348	(lambda (candidate)
	1349	(when (catch 'done
	1350	(goto-char w-start)
	1351	(while (search-forward candidate w-end t)
	1352	(when (and (not (eq (point) start-point))
	1353	(save-match-data
	1354	(company--occurrence-predicate)))
	1355	(throw 'done t))))
	1356	(push
	1357	(cons candidate
	1358	(funcall company-occurrence-weight-function
	1359	start-point
	1360	(match-beginning 0)
	1361	(match-end 0)))
	1362	occurs)
	1363	t))
	1364	candidates))))
	1365	(nconc
	1366	(mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2)))))
	1367	noccurs)))
	1368
	1369	(defun company--occurrence-predicate ()
	1370	(defvar comint-last-prompt)
	1371	(let ((beg (match-beginning 0))
	1372	(end (match-end 0))
	1373	(comint-last-prompt (bound-and-true-p comint-last-prompt)))
	1374	(save-excursion
	1375	(goto-char end)
	1376	;; Workaround for python-shell-completion-at-point's behavior:
	1377	;; https://github.com/company-mode/company-mode/issues/759
	1378	;; https://github.com/company-mode/company-mode/issues/549
	1379	(when (derived-mode-p 'inferior-python-mode)
	1380	(let ((lbp (line-beginning-position)))
	1381	(setq comint-last-prompt (cons lbp lbp))))
	1382	(and (not (memq (get-text-property (1- (point)) 'face)
	1383	'(font-lock-function-name-face
	1384	font-lock-keyword-face)))
	1385	(let ((prefix (company--prefix-str
	1386	(company-call-backend 'prefix))))
	1387	(and (stringp prefix)
	1388	(= (length prefix) (- end beg))))))))
	1389
	1390	(defun company-sort-by-backend-importance (candidates)
	1391	"Sort CANDIDATES as two priority groups.
	1392	If `company-backend' is a function, do nothing. If it's a list, move
	1393	candidates from backends before keyword `:with' to the front. Candidates
	1394	from the rest of the backends in the group, if any, will be left at the end."
	1395	(if (functionp company-backend)
	1396	candidates
	1397	(let ((low-priority (cdr (memq :with company-backend))))
	1398	(if (null low-priority)
	1399	candidates
	1400	(sort candidates
	1401	(lambda (c1 c2)
	1402	(and
	1403	(let ((b2 (get-text-property 0 'company-backend c2)))
	1404	(and b2 (memq b2 low-priority)))
	1405	(let ((b1 (get-text-property 0 'company-backend c1)))
	1406	(or (not b1) (not (memq b1 low-priority)))))))))))
	1407
	1408	(defun company-sort-prefer-same-case-prefix (candidates)
	1409	"Prefer CANDIDATES with the exact same prefix.
	1410	If a backend returns case insensitive matches, candidates with the an exact
	1411	prefix match (same case) will be prioritized."
	1412	(cl-loop for candidate in candidates
	1413	if (string-prefix-p company-prefix candidate)
	1414	collect candidate into same-case
	1415	else collect candidate into other-case
	1416	finally return (append same-case other-case)))
	1417
	1418	(defun company-idle-begin (buf win tick pos)
	1419	(and (eq buf (current-buffer))
	1420	(eq win (selected-window))
	1421	(eq tick (buffer-chars-modified-tick))
	1422	(eq pos (point))
	1423	(when (company-auto-begin)
	1424	(company-input-noop)
	1425	(let ((this-command 'company-idle-begin))
	1426	(company-post-command)))))
	1427
	1428	(defun company-auto-begin ()
	1429	(and company-mode
	1430	(not company-candidates)
	1431	(let ((company-idle-delay 'now))
	1432	(condition-case-unless-debug err
	1433	(progn
	1434	(company--perform)
	1435	;; Return non-nil if active.
	1436	company-candidates)
	1437	(error (message "Company: An error occurred in auto-begin")
	1438	(message "%s" (error-message-string err))
	1439	(company-cancel))
	1440	(quit (company-cancel))))))
	1441
	1442	;;;###autoload
	1443	(defun company-manual-begin ()
	1444	(interactive)
	1445	(company-assert-enabled)
	1446	(setq company--manual-action t)
	1447	(unwind-protect
	1448	(let ((company-minimum-prefix-length 0))
	1449	(or company-candidates
	1450	(company-auto-begin)))
	1451	(unless company-candidates
	1452	(setq company--manual-action nil))))
	1453
	1454	(defun company-other-backend (&optional backward)
	1455	(interactive (list current-prefix-arg))
	1456	(company-assert-enabled)
	1457	(let* ((after (if company-backend
	1458	(cdr (member company-backend company-backends))
	1459	company-backends))
	1460	(before (cdr (member company-backend (reverse company-backends))))
	1461	(next (if backward
	1462	(append before (reverse after))
	1463	(append after (reverse before)))))
	1464	(company-cancel)
	1465	(cl-dolist (backend next)
	1466	(when (ignore-errors (company-begin-backend backend))
	1467	(cl-return t))))
	1468	(unless company-candidates
	1469	(user-error "No other backend")))
	1470
	1471	(defun company-require-match-p ()
	1472	(let ((backend-value (company-call-backend 'require-match)))
	1473	(or (eq backend-value t)
	1474	(and (not (eq backend-value 'never))
	1475	(if (functionp company-require-match)
	1476	(funcall company-require-match)
	1477	(eq company-require-match t))))))
	1478
	1479	(defun company-auto-complete-p (input)
	1480	"Return non-nil if INPUT should trigger auto-completion."
	1481	(and (if (functionp company-auto-complete)
	1482	(funcall company-auto-complete)
	1483	company-auto-complete)
	1484	(if (functionp company-auto-complete-chars)
	1485	(funcall company-auto-complete-chars input)
	1486	(if (consp company-auto-complete-chars)
	1487	(memq (char-syntax (string-to-char input))
	1488	company-auto-complete-chars)
	1489	(string-match (regexp-quote (substring input 0 1))
	1490	company-auto-complete-chars)))))
	1491
	1492	(defun company--incremental-p ()
	1493	(and (> (point) company-point)
	1494	(> (point-max) company--point-max)
	1495	(not (eq this-command 'backward-delete-char-untabify))
	1496	(equal (buffer-substring (- company-point (length company-prefix))
	1497	company-point)
	1498	company-prefix)))
	1499
	1500	(defun company--continue-failed (new-prefix)
	1501	(cond
	1502	((and (or (not (company-require-match-p))
	1503	;; Don't require match if the new prefix
	1504	;; doesn't continue the old one, and the latter was a match.
	1505	(not (stringp new-prefix))
	1506	(<= (length new-prefix) (length company-prefix)))
	1507	(member company-prefix company-candidates))
	1508	;; Last input was a success,
	1509	;; but we're treating it as an abort + input anyway,
	1510	;; like the `unique' case below.
	1511	(company-cancel 'non-unique))
	1512	((company-require-match-p)
	1513	;; Wrong incremental input, but required match.
	1514	(delete-char (- company-point (point)))
	1515	(ding)
	1516	(message "Matching input is required")
	1517	company-candidates)
	1518	(t (company-cancel))))
	1519
	1520	(defun company--good-prefix-p (prefix)
	1521	(and (stringp (company--prefix-str prefix)) ;excludes 'stop
	1522	(or (eq (cdr-safe prefix) t)
	1523	(let ((len (or (cdr-safe prefix) (length prefix))))
	1524	(if company--manual-prefix
	1525	(or (not company-abort-manual-when-too-short)
	1526	;; Must not be less than minimum or initial length.
	1527	(>= len (min company-minimum-prefix-length
	1528	(length company--manual-prefix))))
	1529	(>= len company-minimum-prefix-length))))))
	1530
	1531	(defun company--continue ()
	1532	(when (company-call-backend 'no-cache company-prefix)
	1533	;; Don't complete existing candidates, fetch new ones.
	1534	(setq company-candidates-cache nil))
	1535	(let* ((new-prefix (company-call-backend 'prefix))
	1536	(c (when (and (company--good-prefix-p new-prefix)
	1537	(setq new-prefix (company--prefix-str new-prefix))
	1538	(= (- (point) (length new-prefix))
	1539	(- company-point (length company-prefix))))
	1540	(company-calculate-candidates new-prefix))))
	1541	(cond
	1542	((eq c t)
	1543	;; t means complete/unique.
	1544	;; Handle it like completion was aborted, to differentiate from user
	1545	;; calling one of Company's commands to insert the candidate,
	1546	;; not to trigger template expansion, etc.
	1547	(company-cancel 'unique))
	1548	((consp c)
	1549	;; incremental match
	1550	(setq company-prefix new-prefix)
	1551	(company-update-candidates c)
	1552	c)
	1553	((and (> (point) company-point)
	1554	(company-auto-complete-p (buffer-substring-no-properties
	1555	(point) company-point)))
	1556	;; auto-complete
	1557	(save-excursion
	1558	(goto-char company-point)
	1559	(let ((company--auto-completion t))
	1560	(company-complete-selection))
	1561	nil))
	1562	((not (company--incremental-p))
	1563	(company-cancel))
	1564	(t (company--continue-failed new-prefix)))))
	1565
	1566	(defun company--begin-new ()
	1567	(let (prefix c)
	1568	(cl-dolist (backend (if company-backend
	1569	;; prefer manual override
	1570	(list company-backend)
	1571	company-backends))
	1572	(setq prefix
	1573	(if (or (symbolp backend)
	1574	(functionp backend))
	1575	(when (company--maybe-init-backend backend)
	1576	(let ((company-backend backend))
	1577	(company-call-backend 'prefix)))
	1578	(company--multi-backend-adapter backend 'prefix)))
	1579	(when prefix
	1580	(when (company--good-prefix-p prefix)
	1581	(setq company-prefix (company--prefix-str prefix)
	1582	company-backend backend
	1583	c (company-calculate-candidates company-prefix))
	1584	(if (not (consp c))
	1585	(progn
	1586	(when company--manual-action
	1587	(message "No completion found"))
	1588	(when (eq c t)
	1589	;; t means complete/unique.
	1590	;; Run the hooks anyway, to e.g. clear the cache.
	1591	(company-cancel 'unique)))
	1592	(when company--manual-action
	1593	(setq company--manual-prefix prefix))
	1594	(company-update-candidates c)
	1595	(run-hook-with-args 'company-completion-started-hook
	1596	(company-explicit-action-p))
	1597	(company-call-frontends 'show)))
	1598	(cl-return c)))))
	1599
	1600	(defun company--perform ()
	1601	(or (and company-candidates (company--continue))
	1602	(and (company--should-complete) (company--begin-new)))
	1603	(if (not company-candidates)
	1604	(setq company-backend nil)
	1605	(setq company-point (point)
	1606	company--point-max (point-max))
	1607	(company-ensure-emulation-alist)
	1608	(company-enable-overriding-keymap company-active-map)
	1609	(company-call-frontends 'update)))
	1610
	1611	(defun company-cancel (&optional result)
	1612	(let ((prefix company-prefix)
	1613	(backend company-backend))
	1614	(setq company-backend nil
	1615	company-prefix nil
	1616	company-candidates nil
	1617	company-candidates-length nil
	1618	company-candidates-cache nil
	1619	company-candidates-predicate nil
	1620	company-common nil
	1621	company-selection 0
	1622	company-selection-changed nil
	1623	company--manual-action nil
	1624	company--manual-prefix nil
	1625	company--point-max nil
	1626	company-point nil)
	1627	(when company-timer
	1628	(cancel-timer company-timer))
	1629	(company-echo-cancel t)
	1630	(company-search-mode 0)
	1631	(company-call-frontends 'hide)
	1632	(company-enable-overriding-keymap nil)
	1633	(when prefix
	1634	;; FIXME: RESULT can also be e.g. `unique'. We should call
	1635	;; `company-completion-finished-hook' in that case, with right argument.
	1636	(if (stringp result)
	1637	(let ((company-backend backend))
	1638	(run-hook-with-args 'company-completion-finished-hook result)
	1639	(company-call-backend 'post-completion result))
	1640	(run-hook-with-args 'company-completion-cancelled-hook result))))
	1641	;; Make return value explicit.
	1642	nil)
	1643
	1644	(defun company-abort ()
	1645	(interactive)
	1646	(company-cancel 'abort))
	1647
	1648	(defun company-finish (result)
	1649	(company--insert-candidate result)
	1650	(company-cancel result))
	1651
	1652	(defsubst company-keep (command)
	1653	(and (symbolp command) (get command 'company-keep)))
	1654
	1655	(defun company-pre-command ()
	1656	(company--electric-restore-window-configuration)
	1657	(unless (company-keep this-command)
	1658	(condition-case-unless-debug err
	1659	(when company-candidates
	1660	(company-call-frontends 'pre-command)
	1661	(unless (company--should-continue)
	1662	(company-abort)))
	1663	(error (message "Company: An error occurred in pre-command")
	1664	(message "%s" (error-message-string err))
	1665	(company-cancel))))
	1666	(when company-timer
	1667	(cancel-timer company-timer)
	1668	(setq company-timer nil))
	1669	(company-echo-cancel t)
	1670	(company-uninstall-map))
	1671
	1672	(defun company-post-command ()
	1673	(when (and company-candidates
	1674	(null this-command))
	1675	;; Happens when the user presses `C-g' while inside
	1676	;; `flyspell-post-command-hook', for example.
	1677	;; Or any other `post-command-hook' function that can call `sit-for',
	1678	;; or any quittable timer function.
	1679	(company-abort)
	1680	(setq this-command 'company-abort))
	1681	(unless (company-keep this-command)
	1682	(condition-case-unless-debug err
	1683	(progn
	1684	(unless (equal (point) company-point)
	1685	(let (company-idle-delay) ; Against misbehavior while debugging.
	1686	(company--perform)))
	1687	(if company-candidates
	1688	(company-call-frontends 'post-command)
	1689	(and (or (numberp company-idle-delay)
	1690	;; Deprecated.
	1691	(eq company-idle-delay t))
	1692	(not defining-kbd-macro)
	1693	(company--should-begin)
	1694	(setq company-timer
	1695	(run-with-timer (company--idle-delay) nil
	1696	'company-idle-begin
	1697	(current-buffer) (selected-window)
	1698	(buffer-chars-modified-tick) (point))))))
	1699	(error (message "Company: An error occurred in post-command")
	1700	(message "%s" (error-message-string err))
	1701	(company-cancel))))
	1702	(company-install-map))
	1703
	1704	(defun company--idle-delay ()
	1705	(if (memql company-idle-delay '(t 0 0.0))
	1706	0.01
	1707	company-idle-delay))
	1708
	1709	(defvar company--begin-inhibit-commands '(company-abort
	1710	company-complete-mouse
	1711	company-complete
	1712	company-complete-common
	1713	company-complete-selection
	1714	company-complete-number)
	1715	"List of commands after which idle completion is (still) disabled when
	1716	`company-begin-commands' is t.")
	1717
	1718	(defun company--should-begin ()
	1719	(if (eq t company-begin-commands)
	1720	(not (memq this-command company--begin-inhibit-commands))
	1721	(or
	1722	(memq this-command company-begin-commands)
	1723	(and (symbolp this-command) (get this-command 'company-begin)))))
	1724
	1725	;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	1726
	1727	(defcustom company-search-regexp-function #'regexp-quote
	1728	"Function to construct the search regexp from input.
	1729	It's called with one argument, the current search input. It must return
	1730	either a regexp without groups, or one where groups don't intersect and
	1731	each one wraps a part of the input string."
	1732	:type '(choice
	1733	(const :tag "Exact match" regexp-quote)
	1734	(const :tag "Words separated with spaces" company-search-words-regexp)
	1735	(const :tag "Words separated with spaces, in any order"
	1736	company-search-words-in-any-order-regexp)
	1737	(const :tag "All characters in given order, with anything in between"
	1738	company-search-flex-regexp)))
	1739
	1740	(defvar-local company-search-string "")
	1741
	1742	(defvar company-search-lighter '(" "
	1743	(company-search-filtering "Filter" "Search")
	1744	": \""
	1745	company-search-string
	1746	"\""))
	1747
	1748	(defvar-local company-search-filtering nil
	1749	"Non-nil to filter the completion candidates by the search string")
	1750
	1751	(defvar-local company--search-old-selection 0)
	1752
	1753	(defvar-local company--search-old-changed nil)
	1754
	1755	(defun company-search-words-regexp (input)
	1756	(mapconcat (lambda (word) (format "\$%s\$" (regexp-quote word)))
	1757	(split-string input " +" t) ".*"))
	1758
	1759	(defun company-search-words-in-any-order-regexp (input)
	1760	(let* ((words (mapcar (lambda (word) (format "\$%s\$" (regexp-quote word)))
	1761	(split-string input " +" t)))
	1762	(permutations (company--permutations words)))
	1763	(mapconcat (lambda (words)
	1764	(mapconcat #'identity words ".*"))
	1765	permutations
	1766	"\\\|")))
	1767
	1768	(defun company-search-flex-regexp (input)
	1769	(if (zerop (length input))
	1770	""
	1771	(concat (regexp-quote (string (aref input 0)))
	1772	(mapconcat (lambda (c)
	1773	(concat "[^" (string c) "]*"
	1774	(regexp-quote (string c))))
	1775	(substring input 1) ""))))
	1776
	1777	(defun company--permutations (lst)
	1778	(if (not lst)
	1779	'(nil)
	1780	(cl-mapcan
	1781	(lambda (e)
	1782	(mapcar (lambda (perm) (cons e perm))
	1783	(company--permutations (cl-remove e lst :count 1))))
	1784	lst)))
	1785
	1786	(defun company--search (text lines)
	1787	(let ((re (funcall company-search-regexp-function text))
	1788	(i 0))
	1789	(cl-dolist (line lines)
	1790	(when (string-match-p re line (length company-prefix))
	1791	(cl-return i))
	1792	(cl-incf i))))
	1793
	1794	(defun company-search-keypad ()
	1795	(interactive)
	1796	(let* ((name (symbol-name last-command-event))
	1797	(last-command-event (aref name (1- (length name)))))
	1798	(company-search-printing-char)))
	1799
	1800	(defun company-search-printing-char ()
	1801	(interactive)
	1802	(company--search-assert-enabled)
	1803	(let ((ss (concat company-search-string (string last-command-event))))
	1804	(when company-search-filtering
	1805	(company--search-update-predicate ss))
	1806	(company--search-update-string ss)))
	1807
	1808	(defun company--search-update-predicate (ss)
	1809	(let* ((re (funcall company-search-regexp-function ss))
	1810	(company-candidates-predicate
	1811	(and (not (string= re ""))
	1812	company-search-filtering
	1813	(lambda (candidate) (string-match re candidate))))
	1814	(cc (company-calculate-candidates company-prefix)))
	1815	(unless cc (user-error "No match"))
	1816	(company-update-candidates cc)))
	1817
	1818	(defun company--search-update-string (new)
	1819	(let* ((pos (company--search new (nthcdr company-selection company-candidates))))
	1820	(if (null pos)
	1821	(ding)
	1822	(setq company-search-string new)
	1823	(company-set-selection (+ company-selection pos) t))))
	1824
	1825	(defun company--search-assert-input ()
	1826	(company--search-assert-enabled)
	1827	(when (string= company-search-string "")
	1828	(user-error "Empty search string")))
	1829
	1830	(defun company-search-repeat-forward ()
	1831	"Repeat the incremental search in completion candidates forward."
	1832	(interactive)
	1833	(company--search-assert-input)
	1834	(let ((pos (company--search company-search-string
	1835	(cdr (nthcdr company-selection
	1836	company-candidates)))))
	1837	(if (null pos)
	1838	(ding)
	1839	(company-set-selection (+ company-selection pos 1) t))))
	1840
	1841	(defun company-search-repeat-backward ()
	1842	"Repeat the incremental search in completion candidates backwards."
	1843	(interactive)
	1844	(company--search-assert-input)
	1845	(let ((pos (company--search company-search-string
	1846	(nthcdr (- company-candidates-length
	1847	company-selection)
	1848	(reverse company-candidates)))))
	1849	(if (null pos)
	1850	(ding)
	1851	(company-set-selection (- company-selection pos 1) t))))
	1852
	1853	(defun company-search-toggle-filtering ()
	1854	"Toggle `company-search-filtering'."
	1855	(interactive)
	1856	(company--search-assert-enabled)
	1857	(setq company-search-filtering (not company-search-filtering))
	1858	(let ((ss company-search-string))
	1859	(company--search-update-predicate ss)
	1860	(company--search-update-string ss)))
	1861
	1862	(defun company-search-abort ()
	1863	"Abort searching the completion candidates."
	1864	(interactive)
	1865	(company--search-assert-enabled)
	1866	(company-search-mode 0)
	1867	(company-set-selection company--search-old-selection t)
	1868	(setq company-selection-changed company--search-old-changed))
	1869
	1870	(defun company-search-other-char ()
	1871	(interactive)
	1872	(company--search-assert-enabled)
	1873	(company-search-mode 0)
	1874	(company--unread-this-command-keys))
	1875
	1876	(defun company-search-delete-char ()
	1877	(interactive)
	1878	(company--search-assert-enabled)
	1879	(if (string= company-search-string "")
	1880	(ding)
	1881	(let ((ss (substring company-search-string 0 -1)))
	1882	(when company-search-filtering
	1883	(company--search-update-predicate ss))
	1884	(company--search-update-string ss))))
	1885
	1886	(defvar company-search-map
	1887	(let ((i 0)
	1888	(keymap (make-keymap)))
	1889	(if (fboundp 'max-char)
	1890	(set-char-table-range (nth 1 keymap) (cons #x100 (max-char))
	1891	'company-search-printing-char)
	1892	(with-no-warnings
	1893	;; obsolete in Emacs 23
	1894	(let ((l (generic-character-list))
	1895	(table (nth 1 keymap)))
	1896	(while l
	1897	(set-char-table-default table (car l) 'company-search-printing-char)
	1898	(setq l (cdr l))))))
	1899	(define-key keymap [t] 'company-search-other-char)
	1900	(while (< i ?\s)
	1901	(define-key keymap (make-string 1 i) 'company-search-other-char)
	1902	(cl-incf i))
	1903	(while (< i 256)
	1904	(define-key keymap (vector i) 'company-search-printing-char)
	1905	(cl-incf i))
	1906	(dotimes (i 10)
	1907	(define-key keymap (read (format "[kp-%s]" i)) 'company-search-keypad))
	1908	(let ((meta-map (make-sparse-keymap)))
	1909	(define-key keymap (char-to-string meta-prefix-char) meta-map)
	1910	(define-key keymap [escape] meta-map))
	1911	(define-key keymap (vector meta-prefix-char t) 'company-search-other-char)
	1912	(define-key keymap (kbd "M-n") 'company-select-next)
	1913	(define-key keymap (kbd "M-p") 'company-select-previous)
	1914	(define-key keymap (kbd "<down>") 'company-select-next-or-abort)
	1915	(define-key keymap (kbd "<up>") 'company-select-previous-or-abort)
	1916	(define-key keymap "\e\e\e" 'company-search-other-char)
	1917	(define-key keymap [escape escape escape] 'company-search-other-char)
	1918	(define-key keymap (kbd "DEL") 'company-search-delete-char)
	1919	(define-key keymap [backspace] 'company-search-delete-char)
	1920	(define-key keymap "\C-g" 'company-search-abort)
	1921	(define-key keymap "\C-s" 'company-search-repeat-forward)
	1922	(define-key keymap "\C-r" 'company-search-repeat-backward)
	1923	(define-key keymap "\C-o" 'company-search-toggle-filtering)
	1924	(dotimes (i 10)
	1925	(define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
	1926	keymap)
	1927	"Keymap used for incrementally searching the completion candidates.")
	1928
	1929	(define-minor-mode company-search-mode
	1930	"Search mode for completion candidates.
	1931	Don't start this directly, use `company-search-candidates' or
	1932	`company-filter-candidates'."
	1933	nil company-search-lighter nil
	1934	(if company-search-mode
	1935	(if (company-manual-begin)
	1936	(progn
	1937	(setq company--search-old-selection company-selection
	1938	company--search-old-changed company-selection-changed)
	1939	(company-call-frontends 'update)
	1940	(company-enable-overriding-keymap company-search-map))
	1941	(setq company-search-mode nil))
	1942	(kill-local-variable 'company-search-string)
	1943	(kill-local-variable 'company-search-filtering)
	1944	(kill-local-variable 'company--search-old-selection)
	1945	(kill-local-variable 'company--search-old-changed)
	1946	(when company-backend
	1947	(company--search-update-predicate "")
	1948	(company-call-frontends 'update))
	1949	(company-enable-overriding-keymap company-active-map)))
	1950
	1951	(defun company--search-assert-enabled ()
	1952	(company-assert-enabled)
	1953	(unless company-search-mode
	1954	(company-uninstall-map)
	1955	(user-error "Company not in search mode")))
	1956
	1957	(defun company-search-candidates ()
	1958	"Start searching the completion candidates incrementally.
	1959
	1960	\\<company-search-map>Search can be controlled with the commands:
	1961	- `company-search-repeat-forward' (\\[company-search-repeat-forward])
	1962	- `company-search-repeat-backward' (\\[company-search-repeat-backward])
	1963	- `company-search-abort' (\\[company-search-abort])
	1964	- `company-search-delete-char' (\\[company-search-delete-char])
	1965
	1966	Regular characters are appended to the search string.
	1967
	1968	Customize `company-search-regexp-function' to change how the input
	1969	is interpreted when searching.
	1970
	1971	The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering])
	1972	uses the search string to filter the completion candidates."
	1973	(interactive)
	1974	(company-search-mode 1))
	1975
	1976	(defvar company-filter-map
	1977	(let ((keymap (make-keymap)))
	1978	(define-key keymap [remap company-search-printing-char]
	1979	'company-filter-printing-char)
	1980	(set-keymap-parent keymap company-search-map)
	1981	keymap)
	1982	"Keymap used for incrementally searching the completion candidates.")
	1983
	1984	(defun company-filter-candidates ()
	1985	"Start filtering the completion candidates incrementally.
	1986	This works the same way as `company-search-candidates' immediately
	1987	followed by `company-search-toggle-filtering'."
	1988	(interactive)
	1989	(company-search-mode 1)
	1990	(setq company-search-filtering t))
	1991
	1992	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	1993
	1994	(defun company-select-next (&optional arg)
	1995	"Select the next candidate in the list.
	1996
	1997	With ARG, move by that many elements."
	1998	(interactive "p")
	1999	(when (company-manual-begin)
	2000	(company-set-selection (+ (or arg 1) company-selection))))
	2001
	2002	(defun company-select-previous (&optional arg)
	2003	"Select the previous candidate in the list.
	2004
	2005	With ARG, move by that many elements."
	2006	(interactive "p")
	2007	(company-select-next (if arg (- arg) -1)))
	2008
	2009	(defun company-select-next-or-abort (&optional arg)
	2010	"Select the next candidate if more than one, else abort
	2011	and invoke the normal binding.
	2012
	2013	With ARG, move by that many elements."
	2014	(interactive "p")
	2015	(if (> company-candidates-length 1)
	2016	(company-select-next arg)
	2017	(company-abort)
	2018	(company--unread-this-command-keys)))
	2019
	2020	(defun company-select-previous-or-abort (&optional arg)
	2021	"Select the previous candidate if more than one, else abort
	2022	and invoke the normal binding.
	2023
	2024	With ARG, move by that many elements."
	2025	(interactive "p")
	2026	(if (> company-candidates-length 1)
	2027	(company-select-previous arg)
	2028	(company-abort)
	2029	(company--unread-this-command-keys)))
	2030
	2031	(defun company-next-page ()
	2032	"Select the candidate one page further."
	2033	(interactive)
	2034	(when (company-manual-begin)
	2035	(if (and company-selection-wrap-around
	2036	(= company-selection (1- company-candidates-length)))
	2037	(company-set-selection 0)
	2038	(let (company-selection-wrap-around)
	2039	(company-set-selection (+ company-selection
	2040	company-tooltip-limit))))))
	2041
	2042	(defun company-previous-page ()
	2043	"Select the candidate one page earlier."
	2044	(interactive)
	2045	(when (company-manual-begin)
	2046	(if (and company-selection-wrap-around
	2047	(zerop company-selection))
	2048	(company-set-selection (1- company-candidates-length))
	2049	(let (company-selection-wrap-around)
	2050	(company-set-selection (- company-selection
	2051	company-tooltip-limit))))))
	2052
	2053	(defvar company-pseudo-tooltip-overlay)
	2054
	2055	(defvar company-tooltip-offset)
	2056
	2057	(defun company--inside-tooltip-p (event-col-row row height)
	2058	(let* ((ovl company-pseudo-tooltip-overlay)
	2059	(column (overlay-get ovl 'company-column))
	2060	(width (overlay-get ovl 'company-width))
	2061	(evt-col (car event-col-row))
	2062	(evt-row (cdr event-col-row)))
	2063	(and (>= evt-col column)
	2064	(< evt-col (+ column width))
	2065	(if (> height 0)
	2066	(and (> evt-row row)
	2067	(<= evt-row (+ row height) ))
	2068	(and (< evt-row row)
	2069	(>= evt-row (+ row height)))))))
	2070
	2071	(defun company--event-col-row (event)
	2072	(company--posn-col-row (event-start event)))
	2073
	2074	(defun company-select-mouse (event)
	2075	"Select the candidate picked by the mouse."
	2076	(interactive "e")
	2077	(let ((event-col-row (company--event-col-row event))
	2078	(ovl-row (company--row))
	2079	(ovl-height (and company-pseudo-tooltip-overlay
	2080	(min (overlay-get company-pseudo-tooltip-overlay
	2081	'company-height)
	2082	company-candidates-length))))
	2083	(if (and ovl-height
	2084	(company--inside-tooltip-p event-col-row ovl-row ovl-height))
	2085	(progn
	2086	(company-set-selection (+ (cdr event-col-row)
	2087	(1- company-tooltip-offset)
	2088	(if (and (eq company-tooltip-offset-display 'lines)
	2089	(not (zerop company-tooltip-offset)))
	2090	-1 0)
	2091	(- ovl-row)
	2092	(if (< ovl-height 0)
	2093	(- 1 ovl-height)
	2094	0)))
	2095	t)
	2096	(company-abort)
	2097	(company--unread-this-command-keys)
	2098	nil)))
	2099
	2100	(defun company-complete-mouse (event)
	2101	"Insert the candidate picked by the mouse."
	2102	(interactive "e")
	2103	(when (company-select-mouse event)
	2104	(company-complete-selection)))
	2105
	2106	(defun company-complete-selection ()
	2107	"Insert the selected candidate."
	2108	(interactive)
	2109	(when (company-manual-begin)
	2110	(let ((result (nth company-selection company-candidates)))
	2111	(company-finish result))))
	2112
	2113	(defun company-complete-common ()
	2114	"Insert the common part of all candidates."
	2115	(interactive)
	2116	(when (company-manual-begin)
	2117	(if (and (not (cdr company-candidates))
	2118	(equal company-common (car company-candidates)))
	2119	(company-complete-selection)
	2120	(company--insert-candidate company-common))))
	2121
	2122	(defun company-complete-common-or-cycle (&optional arg)
	2123	"Insert the common part of all candidates, or select the next one.
	2124
	2125	With ARG, move by that many elements."
	2126	(interactive "p")
	2127	(when (company-manual-begin)
	2128	(let ((tick (buffer-chars-modified-tick)))
	2129	(call-interactively 'company-complete-common)
	2130	(when (eq tick (buffer-chars-modified-tick))
	2131	(let ((company-selection-wrap-around t)
	2132	(current-prefix-arg arg))
	2133	(call-interactively 'company-select-next))))))
	2134
	2135	(defun company-indent-or-complete-common ()
	2136	"Indent the current line or region, or complete the common part."
	2137	(interactive)
	2138	(cond
	2139	((use-region-p)
	2140	(indent-region (region-beginning) (region-end)))
	2141	((memq indent-line-function
	2142	'(indent-relative indent-relative-maybe))
	2143	(company-complete-common))
	2144	((let ((old-point (point))
	2145	(old-tick (buffer-chars-modified-tick))
	2146	(tab-always-indent t))
	2147	(call-interactively #'indent-for-tab-command)
	2148	(when (and (eq old-point (point))
	2149	(eq old-tick (buffer-chars-modified-tick)))
	2150	(company-complete-common))))))
	2151
	2152	(defun company-select-next-if-tooltip-visible-or-complete-selection ()
	2153	"Insert selection if appropriate, or select the next candidate.
	2154	Insert selection if only preview is showing or only one candidate,
	2155	otherwise select the next candidate."
	2156	(interactive)
	2157	(if (and (company-tooltip-visible-p) (> company-candidates-length 1))
	2158	(call-interactively 'company-select-next)
	2159	(call-interactively 'company-complete-selection)))
	2160
	2161	;;;###autoload
	2162	(defun company-complete ()
	2163	"Insert the common part of all candidates or the current selection.
	2164	The first time this is called, the common part is inserted, the second
	2165	time, or when the selection has been changed, the selected candidate is
	2166	inserted."
	2167	(interactive)
	2168	(when (company-manual-begin)
	2169	(if (or company-selection-changed
	2170	(eq last-command 'company-complete-common))
	2171	(call-interactively 'company-complete-selection)
	2172	(call-interactively 'company-complete-common)
	2173	(setq this-command 'company-complete-common))))
	2174
	2175	(defun company-complete-number (n)
	2176	"Insert the Nth candidate visible in the tooltip.
	2177	To show the number next to the candidates in some backends, enable
	2178	`company-show-numbers'. When called interactively, uses the last typed
	2179	character, stripping the modifiers. That character must be a digit."
	2180	(interactive
	2181	(list (let* ((type (event-basic-type last-command-event))
	2182	(char (if (characterp type)
	2183	;; Number on the main row.
	2184	type
	2185	;; Keypad number, if bound directly.
	2186	(car (last (string-to-list (symbol-name type))))))
	2187	(n (- char ?0)))
	2188	(if (zerop n) 10 n))))
	2189	(when (company-manual-begin)
	2190	(and (or (< n 1) (> n (- company-candidates-length
	2191	company-tooltip-offset)))
	2192	(user-error "No candidate number %d" n))
	2193	(cl-decf n)
	2194	(company-finish (nth (+ n company-tooltip-offset)
	2195	company-candidates))))
	2196
	2197	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	2198
	2199	(defconst company-space-strings-limit 100)
	2200
	2201	(defconst company-space-strings
	2202	(let (lst)
	2203	(dotimes (i company-space-strings-limit)
	2204	(push (make-string (- company-space-strings-limit 1 i) ?\ ) lst))
	2205	(apply 'vector lst)))
	2206
	2207	(defun company-space-string (len)
	2208	(if (< len company-space-strings-limit)
	2209	(aref company-space-strings len)
	2210	(make-string len ?\ )))
	2211
	2212	(defun company-safe-substring (str from &optional to)
	2213	(let ((bis buffer-invisibility-spec))
	2214	(if (> from (string-width str))
	2215	""
	2216	(with-temp-buffer
	2217	(setq buffer-invisibility-spec bis)
	2218	(insert str)
	2219	(move-to-column from)
	2220	(let ((beg (point)))
	2221	(if to
	2222	(progn
	2223	(move-to-column to)
	2224	(concat (buffer-substring beg (point))
	2225	(let ((padding (- to (current-column))))
	2226	(when (> padding 0)
	2227	(company-space-string padding)))))
	2228	(buffer-substring beg (point-max))))))))
	2229
	2230	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	2231
	2232	(defvar-local company-last-metadata nil)
	2233
	2234	(defun company-fetch-metadata ()
	2235	(let ((selected (nth company-selection company-candidates)))
	2236	(unless (eq selected (car company-last-metadata))
	2237	(setq company-last-metadata
	2238	(cons selected (company-call-backend 'meta selected))))
	2239	(cdr company-last-metadata)))
	2240
	2241	(defun company-doc-buffer (&optional string)
	2242	(with-current-buffer (get-buffer-create "company-documentation")
	2243	(erase-buffer)
	2244	(when string
	2245	(save-excursion
	2246	(insert string)))
	2247	(current-buffer)))
	2248
	2249	(defvar company--electric-saved-window-configuration nil)
	2250
	2251	(defvar company--electric-commands
	2252	'(scroll-other-window scroll-other-window-down mwheel-scroll)
	2253	"List of Commands that won't break out of electric commands.")
	2254
	2255	(defun company--electric-restore-window-configuration ()
	2256	"Restore window configuration (after electric commands)."
	2257	(when (and company--electric-saved-window-configuration
	2258	(not (memq this-command company--electric-commands)))
	2259	(set-window-configuration company--electric-saved-window-configuration)
	2260	(setq company--electric-saved-window-configuration nil)))
	2261
	2262	(defmacro company--electric-do (&rest body)
	2263	(declare (indent 0) (debug t))
	2264	`(when (company-manual-begin)
	2265	(cl-assert (null company--electric-saved-window-configuration))
	2266	(setq company--electric-saved-window-configuration (current-window-configuration))
	2267	(let ((height (window-height))
	2268	(row (company--row)))
	2269	,@body
	2270	(and (< (window-height) height)
	2271	(< (- (window-height) row 2) company-tooltip-limit)
	2272	(recenter (- (window-height) row 2))))))
	2273
	2274	(defun company--unread-this-command-keys ()
	2275	(when (> (length (this-command-keys)) 0)
	2276	(setq unread-command-events (nconc
	2277	(listify-key-sequence (this-command-keys))
	2278	unread-command-events))
	2279	(clear-this-command-keys t)))
	2280
	2281	(defun company-show-doc-buffer ()
	2282	"Temporarily show the documentation buffer for the selection."
	2283	(interactive)
	2284	(let (other-window-scroll-buffer)
	2285	(company--electric-do
	2286	(let* ((selected (nth company-selection company-candidates))
	2287	(doc-buffer (or (company-call-backend 'doc-buffer selected)
	2288	(user-error "No documentation available")))
	2289	start)
	2290	(when (consp doc-buffer)
	2291	(setq start (cdr doc-buffer)
	2292	doc-buffer (car doc-buffer)))
	2293	(setq other-window-scroll-buffer (get-buffer doc-buffer))
	2294	(let ((win (display-buffer doc-buffer t)))
	2295	(set-window-start win (if start start (point-min))))))))
	2296	(put 'company-show-doc-buffer 'company-keep t)
	2297
	2298	(defun company-show-location ()
	2299	"Temporarily display a buffer showing the selected candidate in context."
	2300	(interactive)
	2301	(let (other-window-scroll-buffer)
	2302	(company--electric-do
	2303	(let* ((selected (nth company-selection company-candidates))
	2304	(location (company-call-backend 'location selected))
	2305	(pos (or (cdr location) (user-error "No location available")))
	2306	(buffer (or (and (bufferp (car location)) (car location))
	2307	(find-file-noselect (car location) t))))
	2308	(setq other-window-scroll-buffer (get-buffer buffer))
	2309	(with-selected-window (display-buffer buffer t)
	2310	(save-restriction
	2311	(widen)
	2312	(if (bufferp (car location))
	2313	(goto-char pos)
	2314	(goto-char (point-min))
	2315	(forward-line (1- pos))))
	2316	(set-window-start nil (point)))))))
	2317	(put 'company-show-location 'company-keep t)
	2318
	2319	;;; package functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	2320
	2321	(defvar-local company-callback nil)
	2322
	2323	(defun company-remove-callback (&optional ignored)
	2324	(remove-hook 'company-completion-finished-hook company-callback t)
	2325	(remove-hook 'company-completion-cancelled-hook 'company-remove-callback t)
	2326	(remove-hook 'company-completion-finished-hook 'company-remove-callback t))
	2327
	2328	(defun company-begin-backend (backend &optional callback)
	2329	"Start a completion at point using BACKEND."
	2330	(interactive (let ((val (completing-read "Company backend: "
	2331	obarray
	2332	'functionp nil "company-")))
	2333	(when val
	2334	(list (intern val)))))
	2335	(when (setq company-callback callback)
	2336	(add-hook 'company-completion-finished-hook company-callback nil t))
	2337	(add-hook 'company-completion-cancelled-hook 'company-remove-callback nil t)
	2338	(add-hook 'company-completion-finished-hook 'company-remove-callback nil t)
	2339	(setq company-backend backend)
	2340	;; Return non-nil if active.
	2341	(or (company-manual-begin)
	2342	(user-error "Cannot complete at point")))
	2343
	2344	(defun company-begin-with (candidates
	2345	&optional prefix-length require-match callback)
	2346	"Start a completion at point.
	2347	CANDIDATES is the list of candidates to use and PREFIX-LENGTH is the length
	2348	of the prefix that already is in the buffer before point.
	2349	It defaults to 0.
	2350
	2351	CALLBACK is a function called with the selected result if the user
	2352	successfully completes the input.
	2353
	2354	Example: $company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"$\)"
	2355	(let ((begin-marker (copy-marker (point) t)))
	2356	(company-begin-backend
	2357	(lambda (command &optional arg &rest ignored)
	2358	(pcase command
	2359	(`prefix
	2360	(when (equal (point) (marker-position begin-marker))
	2361	(buffer-substring (- (point) (or prefix-length 0)) (point))))
	2362	(`candidates
	2363	(all-completions arg candidates))
	2364	(`require-match
	2365	require-match)))
	2366	callback)))
	2367
	2368	(declare-function find-library-name "find-func")
	2369	(declare-function lm-version "lisp-mnt")
	2370
	2371	(defun company-version (&optional show-version)
	2372	"Get the Company version as string.
	2373
	2374	If SHOW-VERSION is non-nil, show the version in the echo area."
	2375	(interactive (list t))
	2376	(with-temp-buffer
	2377	(require 'find-func)
	2378	(insert-file-contents (find-library-name "company"))
	2379	(require 'lisp-mnt)
	2380	(if show-version
	2381	(message "Company version: %s" (lm-version))
	2382	(lm-version))))
	2383
	2384	(defun company-diag ()
	2385	"Pop a buffer with information about completions at point."
	2386	(interactive)
	2387	(let* ((bb company-backends)
	2388	(mode (symbol-name major-mode))
	2389	backend
	2390	(prefix (cl-loop for b in bb
	2391	thereis (let ((company-backend b))
	2392	(setq backend b)
	2393	(company-call-backend 'prefix))))
	2394	cc annotations)
	2395	(when (or (stringp prefix) (consp prefix))
	2396	(let ((company-backend backend))
	2397	(condition-case nil
	2398	(setq cc (company-call-backend 'candidates (company--prefix-str prefix))
	2399	annotations
	2400	(mapcar
	2401	(lambda (c) (cons c (company-call-backend 'annotation c)))
	2402	cc))
	2403	(error (setq annotations 'error)))))
	2404	(pop-to-buffer (get-buffer-create "company-diag"))
	2405	(setq buffer-read-only nil)
	2406	(erase-buffer)
	2407	(insert (format "Emacs %s (%s) of %s on %s"
	2408	emacs-version system-configuration
	2409	(format-time-string "%Y-%m-%d" emacs-build-time)
	2410	emacs-build-system))
	2411	(insert "\nCompany " (company-version) "\n\n")
	2412	(insert "company-backends: " (pp-to-string bb))
	2413	(insert "\n")
	2414	(insert "Used backend: " (pp-to-string backend))
	2415	(insert "\n")
	2416	(insert "Major mode: " mode)
	2417	(insert "\n")
	2418	(insert "Prefix: " (pp-to-string prefix))
	2419	(insert "\n")
	2420	(insert (message "Completions:"))
	2421	(unless cc (insert " none"))
	2422	(if (eq annotations 'error)
	2423	(insert "(error fetching)")
	2424	(save-excursion
	2425	(dolist (c annotations)
	2426	(insert "\n " (prin1-to-string (car c)))
	2427	(when (cdr c)
	2428	(insert " " (prin1-to-string (cdr c)))))))
	2429	(special-mode)))
	2430
	2431	;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	2432
	2433	(defvar-local company-pseudo-tooltip-overlay nil)
	2434
	2435	(defvar-local company-tooltip-offset 0)
	2436
	2437	(defun company-tooltip--lines-update-offset (selection num-lines limit)
	2438	(cl-decf limit 2)
	2439	(setq company-tooltip-offset
	2440	(max (min selection company-tooltip-offset)
	2441	(- selection -1 limit)))
	2442
	2443	(when (<= company-tooltip-offset 1)
	2444	(cl-incf limit)
	2445	(setq company-tooltip-offset 0))
	2446
	2447	(when (>= company-tooltip-offset (- num-lines limit 1))
	2448	(cl-incf limit)
	2449	(when (= selection (1- num-lines))
	2450	(cl-decf company-tooltip-offset)
	2451	(when (<= company-tooltip-offset 1)
	2452	(setq company-tooltip-offset 0)
	2453	(cl-incf limit))))
	2454
	2455	limit)
	2456
	2457	(defun company-tooltip--simple-update-offset (selection _num-lines limit)
	2458	(setq company-tooltip-offset
	2459	(if (< selection company-tooltip-offset)
	2460	selection
	2461	(max company-tooltip-offset
	2462	(- selection limit -1)))))
	2463
	2464	;;; propertize
	2465
	2466	(defsubst company-round-tab (arg)
	2467	(* (/ (+ arg tab-width) tab-width) tab-width))
	2468
	2469	(defun company-plainify (str)
	2470	(let ((prefix (get-text-property 0 'line-prefix str)))
	2471	(when prefix ; Keep the original value unmodified, for no special reason.
	2472	(setq str (concat prefix str))
	2473	(remove-text-properties 0 (length str) '(line-prefix) str)))
	2474	(let* ((pieces (split-string str "\t"))
	2475	(copy pieces))
	2476	(while (cdr copy)
	2477	(setcar copy (company-safe-substring
	2478	(car copy) 0 (company-round-tab (string-width (car copy)))))
	2479	(pop copy))
	2480	(apply 'concat pieces)))
	2481
	2482	(defun company-fill-propertize (value annotation width selected left right)
	2483	(let* ((margin (length left))
	2484	(common (or (company-call-backend 'match value)
	2485	(if company-common
	2486	(string-width company-common)
	2487	0)))
	2488	(_ (setq value (company--pre-render value)
	2489	annotation (and annotation (company--pre-render annotation t))))
	2490	(ann-ralign company-tooltip-align-annotations)
	2491	(ann-truncate (< width
	2492	(+ (length value) (length annotation)
	2493	(if ann-ralign 1 0))))
	2494	(ann-start (+ margin
	2495	(if ann-ralign
	2496	(if ann-truncate
	2497	(1+ (length value))
	2498	(- width (length annotation)))
	2499	(length value))))
	2500	(ann-end (min (+ ann-start (length annotation)) (+ margin width)))
	2501	(line (concat left
	2502	(if (or ann-truncate (not ann-ralign))
	2503	(company-safe-substring
	2504	(concat value
	2505	(when (and annotation ann-ralign) " ")
	2506	annotation)
	2507	0 width)
	2508	(concat
	2509	(company-safe-substring value 0
	2510	(- width (length annotation)))
	2511	annotation))
	2512	right)))
	2513	(setq width (+ width margin (length right)))
	2514
	2515	(font-lock-append-text-property 0 width 'mouse-face
	2516	'company-tooltip-mouse
	2517	line)
	2518	(when (< ann-start ann-end)
	2519	(font-lock-append-text-property ann-start ann-end 'face
	2520	(if selected
	2521	'company-tooltip-annotation-selection
	2522	'company-tooltip-annotation)
	2523	line))
	2524	(cl-loop
	2525	with width = (- width (length right))
	2526	for (comp-beg . comp-end) in (if (integerp common) `((0 . ,common)) common)
	2527	for inline-beg = (+ margin comp-beg)
	2528	for inline-end = (min (+ margin comp-end) width)
	2529	when (< inline-beg width)
	2530	do (font-lock-prepend-text-property inline-beg inline-end 'face
	2531	(if selected
	2532	'company-tooltip-common-selection
	2533	'company-tooltip-common)
	2534	line))
	2535	(when (let ((re (funcall company-search-regexp-function
	2536	company-search-string)))
	2537	(and (not (string= re ""))
	2538	(string-match re value (length company-prefix))))
	2539	(pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
	2540	(let ((beg (+ margin mbeg))
	2541	(end (+ margin mend))
	2542	(width (- width (length right))))
	2543	(when (< beg width)
	2544	(font-lock-prepend-text-property beg (min end width) 'face
	2545	(if selected
	2546	'company-tooltip-search-selection
	2547	'company-tooltip-search)
	2548	line)))))
	2549	(when selected
	2550	(font-lock-append-text-property 0 width 'face
	2551	'company-tooltip-selection
	2552	line))
	2553	(font-lock-append-text-property 0 width 'face
	2554	'company-tooltip
	2555	line)
	2556	line))
	2557
	2558	(defun company--search-chunks ()
	2559	(let ((md (match-data t))
	2560	res)
	2561	(if (<= (length md) 2)
	2562	(push (cons (nth 0 md) (nth 1 md)) res)
	2563	(while (setq md (nthcdr 2 md))
	2564	(when (car md)
	2565	(push (cons (car md) (cadr md)) res))))
	2566	res))
	2567
	2568	(defun company--pre-render (str &optional annotation-p)
	2569	(or (company-call-backend 'pre-render str annotation-p)
	2570	(progn
	2571	(when (or (text-property-not-all 0 (length str) 'face nil str)
	2572	(text-property-not-all 0 (length str) 'mouse-face nil str))
	2573	(setq str (copy-sequence str))
	2574	(remove-text-properties 0 (length str)
	2575	'(face nil font-lock-face nil mouse-face nil)
	2576	str))
	2577	str)))
	2578
	2579	(defun company--clean-string (str)
	2580	(replace-regexp-in-string
	2581	"\$[^[:graph:] ]\$\\\|\$\ufeff\$\\\|[[:multibyte:]]"
	2582	(lambda (match)
	2583	(cond
	2584	((match-beginning 1)
	2585	;; FIXME: Better char for 'non-printable'?
	2586	;; We shouldn't get any of these, but sometimes we might.
	2587	"\u2017")
	2588	((match-beginning 2)
	2589	;; Zero-width non-breakable space.
	2590	"")
	2591	((> (string-width match) 1)
	2592	(concat
	2593	(make-string (1- (string-width match)) ?\ufeff)
	2594	match))
	2595	(t match)))
	2596	str))
	2597
	2598	;;; replace
	2599
	2600	(defun company-buffer-lines (beg end)
	2601	(goto-char beg)
	2602	(let (lines lines-moved)
	2603	(while (and (not (eobp)) ; http://debbugs.gnu.org/19553
	2604	(> (setq lines-moved (vertical-motion 1)) 0)
	2605	(<= (point) end))
	2606	(let ((bound (min end (point))))
	2607	;; A visual line can contain several physical lines (e.g. with outline's
	2608	;; folding overlay). Take only the first one.
	2609	(push (buffer-substring beg
	2610	(save-excursion
	2611	(goto-char beg)
	2612	(re-search-forward "$" bound 'move)
	2613	(point)))
	2614	lines))
	2615	;; One physical line can be displayed as several visual ones as well:
	2616	;; add empty strings to the list, to even the count.
	2617	(dotimes (_ (1- lines-moved))
	2618	(push "" lines))
	2619	(setq beg (point)))
	2620	(unless (eq beg end)
	2621	(push (buffer-substring beg end) lines))
	2622	(nreverse lines)))
	2623
	2624	(defun company-modify-line (old new offset)
	2625	(concat (company-safe-substring old 0 offset)
	2626	new
	2627	(company-safe-substring old (+ offset (length new)))))
	2628
	2629	(defsubst company--window-height ()
	2630	(if (fboundp 'window-screen-lines)
	2631	(floor (window-screen-lines))
	2632	(window-body-height)))
	2633
	2634	(defun company--window-width ()
	2635	(let ((ww (window-body-width)))
	2636	;; Account for the line continuation column.
	2637	(when (zerop (cadr (window-fringes)))
	2638	(cl-decf ww))
	2639	(when (bound-and-true-p display-line-numbers)
	2640	(cl-decf ww (+ 2 (line-number-display-width))))
	2641	(unless (or (display-graphic-p)
	2642	(version< "24.3.1" emacs-version))
	2643	;; Emacs 24.3 and earlier included margins
	2644	;; in window-width when in TTY.
	2645	(cl-decf ww
	2646	(let ((margins (window-margins)))
	2647	(+ (or (car margins) 0)
	2648	(or (cdr margins) 0)))))
	2649	(when (and word-wrap
	2650	(version< emacs-version "24.4.51.5"))
	2651	;; http://debbugs.gnu.org/19300
	2652	(cl-decf ww))
	2653	;; whitespace-mode with newline-mark
	2654	(when (and buffer-display-table
	2655	(aref buffer-display-table ?\n))
	2656	(cl-decf ww (1- (length (aref buffer-display-table ?\n)))))
	2657	ww))
	2658
	2659	(defun company--replacement-string (lines old column nl &optional align-top)
	2660	(cl-decf column company-tooltip-margin)
	2661
	2662	(when (and align-top company-tooltip-flip-when-above)
	2663	(setq lines (reverse lines)))
	2664
	2665	(let ((width (length (car lines)))
	2666	(remaining-cols (- (+ (company--window-width) (window-hscroll))
	2667	column)))
	2668	(when (> width remaining-cols)
	2669	(cl-decf column (- width remaining-cols))))
	2670
	2671	(let ((offset (and (< column 0) (- column)))
	2672	new)
	2673	(when offset
	2674	(setq column 0))
	2675	(when align-top
	2676	;; untouched lines first
	2677	(dotimes (_ (- (length old) (length lines)))
	2678	(push (pop old) new)))
	2679	;; length into old lines.
	2680	(while old
	2681	(push (company-modify-line (pop old)
	2682	(company--offset-line (pop lines) offset)
	2683	column)
	2684	new))
	2685	;; Append whole new lines.
	2686	(while lines
	2687	(push (concat (company-space-string column)
	2688	(company--offset-line (pop lines) offset))
	2689	new))
	2690
	2691	(let ((str (concat (when nl " \n")
	2692	(mapconcat 'identity (nreverse new) "\n")
	2693	"\n")))
	2694	(font-lock-append-text-property 0 (length str) 'face 'default str)
	2695	(when nl (put-text-property 0 1 'cursor t str))
	2696	str)))
	2697
	2698	(defun company--offset-line (line offset)
	2699	(if (and offset line)
	2700	(substring line offset)
	2701	line))
	2702
	2703	(defun company--create-lines (selection limit)
	2704	(let ((len company-candidates-length)
	2705	(window-width (company--window-width))
	2706	lines
	2707	width
	2708	lines-copy
	2709	items
	2710	previous
	2711	remainder
	2712	scrollbar-bounds)
	2713
	2714	;; Maybe clear old offset.
	2715	(when (< len (+ company-tooltip-offset limit))
	2716	(setq company-tooltip-offset 0))
	2717
	2718	;; Scroll to offset.
	2719	(if (eq company-tooltip-offset-display 'lines)
	2720	(setq limit (company-tooltip--lines-update-offset selection len limit))
	2721	(company-tooltip--simple-update-offset selection len limit))
	2722
	2723	(cond
	2724	((eq company-tooltip-offset-display 'scrollbar)
	2725	(setq scrollbar-bounds (company--scrollbar-bounds company-tooltip-offset
	2726	limit len)))
	2727	((eq company-tooltip-offset-display 'lines)
	2728	(when (> company-tooltip-offset 0)
	2729	(setq previous (format "...(%d)" company-tooltip-offset)))
	2730	(setq remainder (- len limit company-tooltip-offset)
	2731	remainder (when (> remainder 0)
	2732	(setq remainder (format "...(%d)" remainder))))))
	2733
	2734	(cl-decf selection company-tooltip-offset)
	2735	(setq width (max (length previous) (length remainder))
	2736	lines (nthcdr company-tooltip-offset company-candidates)
	2737	len (min limit len)
	2738	lines-copy lines)
	2739
	2740	(cl-decf window-width (* 2 company-tooltip-margin))
	2741	(when scrollbar-bounds (cl-decf window-width))
	2742
	2743	(dotimes (_ len)
	2744	(let* ((value (pop lines-copy))
	2745	(annotation (company-call-backend 'annotation value)))
	2746	(setq value (company--clean-string (company-reformat value)))
	2747	(when annotation
	2748	(setq annotation (company--clean-string annotation))
	2749	(when company-tooltip-align-annotations
	2750	;; `lisp-completion-at-point' adds a space.
	2751	(setq annotation (comment-string-strip annotation t nil))))
	2752	(push (cons value annotation) items)
	2753	(setq width (max (+ (length value)
	2754	(if (and annotation company-tooltip-align-annotations)
	2755	(1+ (length annotation))
	2756	(length annotation)))
	2757	width))))
	2758
	2759	(setq width (min window-width
	2760	company-tooltip-maximum-width
	2761	(max company-tooltip-minimum-width
	2762	(if company-show-numbers
	2763	(+ 2 width)
	2764	width))))
	2765
	2766	(let ((items (nreverse items))
	2767	(numbered (if company-show-numbers 0 99999))
	2768	new)
	2769	(when previous
	2770	(push (company--scrollpos-line previous width) new))
	2771
	2772	(dotimes (i len)
	2773	(let* ((item (pop items))
	2774	(str (car item))
	2775	(annotation (cdr item))
	2776	(right (company-space-string company-tooltip-margin))
	2777	(width width))
	2778	(when (< numbered 10)
	2779	(cl-decf width 2)
	2780	(cl-incf numbered)
	2781	(setq right (concat (format " %d" (mod numbered 10)) right)))
	2782	(push (concat
	2783	(company-fill-propertize str annotation
	2784	width (equal i selection)
	2785	(company-space-string
	2786	company-tooltip-margin)
	2787	right)
	2788	(when scrollbar-bounds
	2789	(company--scrollbar i scrollbar-bounds)))
	2790	new)))
	2791
	2792	(when remainder
	2793	(push (company--scrollpos-line remainder width) new))
	2794
	2795	(nreverse new))))
	2796
	2797	(defun company--scrollbar-bounds (offset limit length)
	2798	(when (> length limit)
	2799	(let* ((size (ceiling (* limit (float limit)) length))
	2800	(lower (floor (* limit (float offset)) length))
	2801	(upper (+ lower size -1)))
	2802	(cons lower upper))))
	2803
	2804	(defun company--scrollbar (i bounds)
	2805	(propertize " " 'face
	2806	(if (and (>= i (car bounds)) (<= i (cdr bounds)))
	2807	'company-scrollbar-fg
	2808	'company-scrollbar-bg)))
	2809
	2810	(defun company--scrollpos-line (text width)
	2811	(propertize (concat (company-space-string company-tooltip-margin)
	2812	(company-safe-substring text 0 width)
	2813	(company-space-string company-tooltip-margin))
	2814	'face 'company-tooltip))
	2815
	2816	;; show
	2817
	2818	(defun company--pseudo-tooltip-height ()
	2819	"Calculate the appropriate tooltip height.
	2820	Returns a negative number if the tooltip should be displayed above point."
	2821	(let* ((lines (company--row))
	2822	(below (- (company--window-height) 1 lines)))
	2823	(if (and (< below (min company-tooltip-minimum company-candidates-length))
	2824	(> lines below))
	2825	(- (max 3 (min company-tooltip-limit lines)))
	2826	(max 3 (min company-tooltip-limit below)))))
	2827
	2828	(defun company-pseudo-tooltip-show (row column selection)
	2829	(company-pseudo-tooltip-hide)
	2830
	2831	(let* ((height (company--pseudo-tooltip-height))
	2832	above)
	2833
	2834	(when (< height 0)
	2835	(setq row (+ row height -1)
	2836	above t))
	2837
	2838	(let (nl beg end ov args)
	2839	(save-excursion
	2840	(setq nl (< (move-to-window-line row) row)
	2841	beg (point)
	2842	end (save-excursion
	2843	(move-to-window-line (+ row (abs height)))
	2844	(point))
	2845	ov (make-overlay beg end nil t)
	2846	args (list (mapcar 'company-plainify
	2847	(company-buffer-lines beg end))
	2848	column nl above)))
	2849
	2850	(setq company-pseudo-tooltip-overlay ov)
	2851	(overlay-put ov 'company-replacement-args args)
	2852
	2853	(let ((lines (company--create-lines selection (abs height))))
	2854	(overlay-put ov 'company-display
	2855	(apply 'company--replacement-string lines args))
	2856	(overlay-put ov 'company-width (string-width (car lines))))
	2857
	2858	(overlay-put ov 'company-column column)
	2859	(overlay-put ov 'company-height height))))
	2860
	2861	(defun company-pseudo-tooltip-show-at-point (pos column-offset)
	2862	(let* ((col-row (company--col-row pos))
	2863	(col (- (car col-row) column-offset)))
	2864	(when (< col 0) (setq col 0))
	2865	(company-pseudo-tooltip-show (1+ (cdr col-row)) col company-selection)))
	2866
	2867	(defun company-pseudo-tooltip-edit (selection)
	2868	(let* ((height (overlay-get company-pseudo-tooltip-overlay 'company-height))
	2869	(lines (company--create-lines selection (abs height))))
	2870	(overlay-put company-pseudo-tooltip-overlay 'company-width
	2871	(string-width (car lines)))
	2872	(overlay-put company-pseudo-tooltip-overlay 'company-display
	2873	(apply 'company--replacement-string
	2874	lines
	2875	(overlay-get company-pseudo-tooltip-overlay
	2876	'company-replacement-args)))))
	2877
	2878	(defun company-pseudo-tooltip-hide ()
	2879	(when company-pseudo-tooltip-overlay
	2880	(delete-overlay company-pseudo-tooltip-overlay)
	2881	(setq company-pseudo-tooltip-overlay nil)))
	2882
	2883	(defun company-pseudo-tooltip-hide-temporarily ()
	2884	(when (overlayp company-pseudo-tooltip-overlay)
	2885	(overlay-put company-pseudo-tooltip-overlay 'invisible nil)
	2886	(overlay-put company-pseudo-tooltip-overlay 'line-prefix nil)
	2887	(overlay-put company-pseudo-tooltip-overlay 'after-string nil)
	2888	(overlay-put company-pseudo-tooltip-overlay 'display nil)))
	2889
	2890	(defun company-pseudo-tooltip-unhide ()
	2891	(when company-pseudo-tooltip-overlay
	2892	(let* ((ov company-pseudo-tooltip-overlay)
	2893	(disp (overlay-get ov 'company-display)))
	2894	;; Beat outline's folding overlays, at least.
	2895	(overlay-put ov 'priority 1)
	2896	;; No (extra) prefix for the first line.
	2897	(overlay-put ov 'line-prefix "")
	2898	;; `display' is better
	2899	;; (http://debbugs.gnu.org/18285, http://debbugs.gnu.org/20847),
	2900	;; but it doesn't work on 0-length overlays.
	2901	(if (< (overlay-start ov) (overlay-end ov))
	2902	(overlay-put ov 'display disp)
	2903	(overlay-put ov 'after-string disp)
	2904	(overlay-put ov 'invisible t))
	2905	(overlay-put ov 'window (selected-window)))))
	2906
	2907	(defun company-pseudo-tooltip-guard ()
	2908	(list
	2909	(save-excursion (beginning-of-visual-line))
	2910	(window-width)
	2911	(let ((ov company-pseudo-tooltip-overlay)
	2912	(overhang (save-excursion (end-of-visual-line)
	2913	(- (line-end-position) (point)))))
	2914	(when (>= (overlay-get ov 'company-height) 0)
	2915	(cons
	2916	(buffer-substring-no-properties (point) (overlay-start ov))
	2917	(when (>= overhang 0) overhang))))))
	2918
	2919	(defun company-pseudo-tooltip-frontend (command)
	2920	"`company-mode' frontend similar to a tooltip but based on overlays."
	2921	(cl-case command
	2922	(pre-command (company-pseudo-tooltip-hide-temporarily))
	2923	(post-command
	2924	(unless (when (overlayp company-pseudo-tooltip-overlay)
	2925	(let* ((ov company-pseudo-tooltip-overlay)
	2926	(old-height (overlay-get ov 'company-height))
	2927	(new-height (company--pseudo-tooltip-height)))
	2928	(and
	2929	(>= (* old-height new-height) 0)
	2930	(>= (abs old-height) (abs new-height))
	2931	(equal (company-pseudo-tooltip-guard)
	2932	(overlay-get ov 'company-guard)))))
	2933	;; Redraw needed.
	2934	(company-pseudo-tooltip-show-at-point (point) (length company-prefix))
	2935	(overlay-put company-pseudo-tooltip-overlay
	2936	'company-guard (company-pseudo-tooltip-guard)))
	2937	(company-pseudo-tooltip-unhide))
	2938	(hide (company-pseudo-tooltip-hide)
	2939	(setq company-tooltip-offset 0))
	2940	(update (when (overlayp company-pseudo-tooltip-overlay)
	2941	(company-pseudo-tooltip-edit company-selection)))))
	2942
	2943	(defun company-pseudo-tooltip-unless-just-one-frontend (command)
	2944	"`company-pseudo-tooltip-frontend', but not shown for single candidates."
	2945	(unless (and (eq command 'post-command)
	2946	(company--show-inline-p))
	2947	(company-pseudo-tooltip-frontend command)))
	2948
	2949	(defun company-pseudo-tooltip-unless-just-one-frontend-with-delay (command)
	2950	"`compandy-pseudo-tooltip-frontend', but shown after a delay.
	2951	Delay is determined by `company-tooltip-idle-delay'."
	2952	(defvar company-preview-overlay)
	2953	(when (and (memq command '(pre-command hide))
	2954	company-tooltip-timer)
	2955	(cancel-timer company-tooltip-timer)
	2956	(setq company-tooltip-timer nil))
	2957	(cl-case command
	2958	(post-command
	2959	(if (or company-tooltip-timer
	2960	(overlayp company-pseudo-tooltip-overlay))
	2961	(if (not (overlayp company-preview-overlay))
	2962	(company-pseudo-tooltip-unless-just-one-frontend command)
	2963	(let (company-tooltip-timer)
	2964	(company-call-frontends 'pre-command))
	2965	(company-call-frontends 'post-command))
	2966	(setq company-tooltip-timer
	2967	(run-with-timer company-tooltip-idle-delay nil
	2968	'company-pseudo-tooltip-unless-just-one-frontend-with-delay
	2969	'post-command))))
	2970	(t
	2971	(company-pseudo-tooltip-unless-just-one-frontend command))))
	2972
	2973	;;; overlay ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	2974
	2975	(defvar-local company-preview-overlay nil)
	2976
	2977	(defun company-preview-show-at-point (pos completion)
	2978	(company-preview-hide)
	2979
	2980	(setq completion (copy-sequence (company--pre-render completion)))
	2981	(font-lock-append-text-property 0 (length completion)
	2982	'face 'company-preview
	2983	completion)
	2984	(font-lock-prepend-text-property 0 (length company-common)
	2985	'face 'company-preview-common
	2986	completion)
	2987
	2988	;; Add search string
	2989	(and (string-match (funcall company-search-regexp-function
	2990	company-search-string)
	2991	completion)
	2992	(pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
	2993	(font-lock-prepend-text-property mbeg mend
	2994	'face 'company-preview-search
	2995	completion)))
	2996
	2997	(setq completion (company-strip-prefix completion))
	2998
	2999	(and (equal pos (point))
	3000	(not (equal completion ""))
	3001	(add-text-properties 0 1 '(cursor 1) completion))
	3002
	3003	(let* ((beg pos)
	3004	(pto company-pseudo-tooltip-overlay)
	3005	(ptf-workaround (and
	3006	pto
	3007	(char-before pos)
	3008	(eq pos (overlay-start pto)))))
	3009	;; Try to accomodate for the pseudo-tooltip overlay,
	3010	;; which may start at the same position if it's at eol.
	3011	(when ptf-workaround
	3012	(cl-decf beg)
	3013	(setq completion (concat (buffer-substring beg pos) completion)))
	3014
	3015	(setq company-preview-overlay (make-overlay beg pos))
	3016
	3017	(let ((ov company-preview-overlay))
	3018	(overlay-put ov (if ptf-workaround 'display 'after-string)
	3019	completion)
	3020	(overlay-put ov 'window (selected-window)))))
	3021
	3022	(defun company-preview-hide ()
	3023	(when company-preview-overlay
	3024	(delete-overlay company-preview-overlay)
	3025	(setq company-preview-overlay nil)))
	3026
	3027	(defun company-preview-frontend (command)
	3028	"`company-mode' frontend showing the selection as if it had been inserted."
	3029	(pcase command
	3030	(`pre-command (company-preview-hide))
	3031	(`post-command (company-preview-show-at-point (point)
	3032	(nth company-selection company-candidates)))
	3033	(`hide (company-preview-hide))))
	3034
	3035	(defun company-preview-if-just-one-frontend (command)
	3036	"`company-preview-frontend', but only shown for single candidates."
	3037	(when (or (not (eq command 'post-command))
	3038	(company--show-inline-p))
	3039	(company-preview-frontend command)))
	3040
	3041	(defun company--show-inline-p ()
	3042	(and (not (cdr company-candidates))
	3043	company-common
	3044	(or (eq (company-call-backend 'ignore-case) 'keep-prefix)
	3045	(string-prefix-p company-prefix company-common))))
	3046
	3047	(defun company-tooltip-visible-p ()
	3048	"Returns whether the tooltip is visible."
	3049	(when (overlayp company-pseudo-tooltip-overlay)
	3050	(not (overlay-get company-pseudo-tooltip-overlay 'invisible))))
	3051
	3052	(defun company-preview-common--show-p ()
	3053	"Returns whether the preview of common can be showed or not"
	3054	(and company-common
	3055	(or (eq (company-call-backend 'ignore-case) 'keep-prefix)
	3056	(string-prefix-p company-prefix company-common))))
	3057
	3058	(defun company-preview-common-frontend (command)
	3059	"`company-mode' frontend preview the common part of candidates."
	3060	(when (or (not (eq command 'post-command))
	3061	(company-preview-common--show-p))
	3062	(pcase command
	3063	(`pre-command (company-preview-hide))
	3064	(`post-command (company-preview-show-at-point (point) company-common))
	3065	(`hide (company-preview-hide)))))
	3066
	3067	;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	3068
	3069	(defvar-local company-echo-last-msg nil)
	3070
	3071	(defvar company-echo-timer nil)
	3072
	3073	(defvar company-echo-delay .01)
	3074
	3075	(defcustom company-echo-truncate-lines t
	3076	"Whether frontend messages written to the echo area should be truncated."
	3077	:type 'boolean
	3078	:package-version '(company . "0.9.3"))
	3079
	3080	(defun company-echo-show (&optional getter)
	3081	(when getter
	3082	(setq company-echo-last-msg (funcall getter)))
	3083	(let ((message-log-max nil)
	3084	(message-truncate-lines company-echo-truncate-lines))
	3085	(if company-echo-last-msg
	3086	(message "%s" company-echo-last-msg)
	3087	(message ""))))
	3088
	3089	(defun company-echo-show-soon (&optional getter)
	3090	(company-echo-cancel)
	3091	(setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
	3092
	3093	(defun company-echo-cancel (&optional unset)
	3094	(when company-echo-timer
	3095	(cancel-timer company-echo-timer))
	3096	(when unset
	3097	(setq company-echo-timer nil)))
	3098
	3099	(defun company-echo-show-when-idle (&optional getter)
	3100	(company-echo-cancel)
	3101	(setq company-echo-timer
	3102	(run-with-idle-timer company-echo-delay nil 'company-echo-show getter)))
	3103
	3104	(defun company-echo-format ()
	3105
	3106	(let ((limit (window-body-width (minibuffer-window)))
	3107	(len -1)
	3108	;; Roll to selection.
	3109	(candidates (nthcdr company-selection company-candidates))
	3110	(i (if company-show-numbers company-selection 99999))
	3111	comp msg)
	3112
	3113	(while candidates
	3114	(setq comp (company-reformat (pop candidates))
	3115	len (+ len 1 (length comp)))
	3116	(if (< i 10)
	3117	;; Add number.
	3118	(progn
	3119	(setq comp (propertize (format "%d: %s" i comp)
	3120	'face 'company-echo))
	3121	(cl-incf len 3)
	3122	(cl-incf i)
	3123	(add-text-properties 3 (+ 3 (length company-common))
	3124	'(face company-echo-common) comp))
	3125	(setq comp (propertize comp 'face 'company-echo))
	3126	(add-text-properties 0 (length company-common)
	3127	'(face company-echo-common) comp))
	3128	(if (>= len limit)
	3129	(setq candidates nil)
	3130	(push comp msg)))
	3131
	3132	(mapconcat 'identity (nreverse msg) " ")))
	3133
	3134	(defun company-echo-strip-common-format ()
	3135
	3136	(let ((limit (window-body-width (minibuffer-window)))
	3137	(len (+ (length company-prefix) 2))
	3138	;; Roll to selection.
	3139	(candidates (nthcdr company-selection company-candidates))
	3140	(i (if company-show-numbers company-selection 99999))
	3141	msg comp)
	3142
	3143	(while candidates
	3144	(setq comp (company-strip-prefix (pop candidates))
	3145	len (+ len 2 (length comp)))
	3146	(when (< i 10)
	3147	;; Add number.
	3148	(setq comp (format "%s (%d)" comp i))
	3149	(cl-incf len 4)
	3150	(cl-incf i))
	3151	(if (>= len limit)
	3152	(setq candidates nil)
	3153	(push (propertize comp 'face 'company-echo) msg)))
	3154
	3155	(concat (propertize company-prefix 'face 'company-echo-common) "{"
	3156	(mapconcat 'identity (nreverse msg) ", ")
	3157	"}")))
	3158
	3159	(defun company-echo-hide ()
	3160	(unless (equal company-echo-last-msg "")
	3161	(setq company-echo-last-msg "")
	3162	(company-echo-show)))
	3163
	3164	(defun company-echo-frontend (command)
	3165	"`company-mode' frontend showing the candidates in the echo area."
	3166	(pcase command
	3167	(`post-command (company-echo-show-soon 'company-echo-format))
	3168	(`hide (company-echo-hide))))
	3169
	3170	(defun company-echo-strip-common-frontend (command)
	3171	"`company-mode' frontend showing the candidates in the echo area."
	3172	(pcase command
	3173	(`post-command (company-echo-show-soon 'company-echo-strip-common-format))
	3174	(`hide (company-echo-hide))))
	3175
	3176	(defun company-echo-metadata-frontend (command)
	3177	"`company-mode' frontend showing the documentation in the echo area."
	3178	(pcase command
	3179	(`post-command (company-echo-show-when-idle 'company-fetch-metadata))
	3180	(`hide (company-echo-hide))))
	3181
	3182	(provide 'company)
	3183	;;; company.el ends here