.emacs.d.git - Gitblit

Chizi123

2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957

commit \| author \| age
5cb5f7	1	;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -- lexical-binding: t --
C	2
	3	;; Copyright (C) 2009, 2011, 2014, 2015, 2016 Free Software Foundation, Inc.
	4
	5	;; Author: Nikolaj Schumacher
	6
	7	;; This file is part of GNU Emacs.
	8
	9	;; GNU Emacs is free software: you can redistribute it and/or modify
	10	;; it under the terms of the GNU General Public License as published by
	11	;; the Free Software Foundation, either version 3 of the License, or
	12	;; (at your option) any later version.
	13
	14	;; GNU Emacs is distributed in the hope that it will be useful,
	15	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	16	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	;; GNU General Public License for more details.
	18
	19	;; You should have received a copy of the GNU General Public License
	20	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	21
	22
	23	;;; Commentary:
	24	;;
	25
	26	;;; Code:
	27
	28	(require 'company)
	29	(require 'cl-lib)
	30
	31	(defgroup company-dabbrev nil
	32	"dabbrev-like completion backend."
	33	:group 'company)
	34
	35	(defcustom company-dabbrev-other-buffers 'all
	36	"Determines whether `company-dabbrev' should search other buffers.
	37	If `all', search all other buffers, except the ignored ones. If t, search
	38	buffers with the same major mode. See also `company-dabbrev-time-limit'."
	39	:type '(choice (const :tag "Off" nil)
	40	(const :tag "Same major mode" t)
	41	(const :tag "All" all)))
	42
	43	(defcustom company-dabbrev-ignore-buffers "\\`[ *]"
	44	"Regexp matching the names of buffers to ignore.
	45	Or a function that returns non-nil for such buffers."
	46	:type '(choice (regexp :tag "Regexp")
	47	(function :tag "Predicate"))
	48	:package-version '(company . "0.9.0"))
	49
	50	(defcustom company-dabbrev-time-limit .1
	51	"Determines how many seconds `company-dabbrev' should look for matches."
	52	:type '(choice (const :tag "Off" nil)
	53	(number :tag "Seconds")))
	54
	55	(defcustom company-dabbrev-char-regexp "\\sw"
	56	"A regular expression matching the characters `company-dabbrev' looks for."
	57	:type 'regexp)
	58
	59	(defcustom company-dabbrev-ignore-case 'keep-prefix
	60	"Non-nil to ignore case when collecting completion candidates.
	61	When it's `keep-prefix', the text before point will remain unchanged after
	62	candidate is inserted, even some of its characters have different case."
	63	:type '(choice
	64	(const :tag "Don't ignore case" nil)
	65	(const :tag "Ignore case" t)
	66	(const :tag "Keep case before point" keep-prefix)))
	67
	68	(defcustom company-dabbrev-downcase 'case-replace
	69	"Whether to downcase the returned candidates.
	70
	71	The value of nil means keep them as-is.
	72	`case-replace' means use the value of `case-replace'.
	73	Any other value means downcase.
	74
	75	If you set this value to nil, you may also want to set
	76	`company-dabbrev-ignore-case' to any value other than `keep-prefix'."
	77	:type '(choice
	78	(const :tag "Keep as-is" nil)
	79	(const :tag "Downcase" t)
	80	(const :tag "Use case-replace" case-replace)))
	81
	82	(defcustom company-dabbrev-minimum-length 4
	83	"The minimum length for the completion candidate to be included.
	84	This variable affects both `company-dabbrev' and `company-dabbrev-code'."
	85	:type 'integer
	86	:package-version '(company . "0.8.3"))
	87
	88	(defcustom company-dabbrev-ignore-invisible nil
	89	"Non-nil to skip invisible text."
	90	:type 'boolean
	91	:package-version '(company . "0.9.0"))
	92
	93	(defmacro company-dabbrev--time-limit-while (test start limit freq &rest body)
	94	(declare (indent 3) (debug t))
	95	`(let ((company-time-limit-while-counter 0))
	96	(catch 'done
	97	(while ,test
	98	,@body
	99	(and ,limit
	100	(= (cl-incf company-time-limit-while-counter) ,freq)
	101	(setq company-time-limit-while-counter 0)
	102	(> (float-time (time-since ,start)) ,limit)
	103	(throw 'done 'company-time-out))))))
	104
	105	(defun company-dabbrev--make-regexp ()
	106	(concat "\\(?:" company-dabbrev-char-regexp "\\)+"))
	107
	108	(defun company-dabbrev--search-buffer (regexp pos symbols start limit
	109	ignore-comments)
	110	(save-excursion
	111	(cl-labels ((maybe-collect-match
	112	()
	113	(let ((match (match-string-no-properties 0)))
	114	(when (and (>= (length match) company-dabbrev-minimum-length)
	115	(not (and company-dabbrev-ignore-invisible
	116	(invisible-p (match-beginning 0)))))
	117	(push match symbols)))))
	118	(goto-char (if pos (1- pos) (point-min)))
	119	;; Search before pos.
	120	(let ((tmp-end (point)))
	121	(company-dabbrev--time-limit-while (and (not (input-pending-p))
	122	(> tmp-end (point-min)))
	123	start limit 1
	124	(ignore-errors
	125	(forward-char -10000))
	126	(forward-line 0)
	127	(save-excursion
	128	;; Before, we used backward search, but it matches non-greedily, and
	129	;; that forced us to use the "beginning/end of word" anchors in
	130	;; `company-dabbrev--make-regexp'. It's also about 2x slower.
	131	(while (and (not (input-pending-p))
	132	(re-search-forward regexp tmp-end t))
	133	(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
	134	(re-search-forward "\\s>\\\|\\s!\\\|\\s\"" tmp-end t)
	135	(maybe-collect-match))))
	136	(setq tmp-end (point))))
	137	(goto-char (or pos (point-min)))
	138	;; Search after pos.
	139	(company-dabbrev--time-limit-while (and (not (input-pending-p))
	140	(re-search-forward regexp nil t))
	141	start limit 25
	142	(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
	143	(re-search-forward "\\s>\\\|\\s!\\\|\\s\"" nil t)
	144	(maybe-collect-match)))
	145	symbols)))
	146
	147	(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
	148	ignore-comments)
	149	(let* ((start (current-time))
	150	(symbols (company-dabbrev--search-buffer regexp (point) nil start limit
	151	ignore-comments)))
	152	(when other-buffer-modes
	153	(cl-dolist (buffer (delq (current-buffer) (buffer-list)))
	154	(unless (if (stringp company-dabbrev-ignore-buffers)
	155	(string-match-p company-dabbrev-ignore-buffers
	156	(buffer-name buffer))
	157	(funcall company-dabbrev-ignore-buffers buffer))
	158	(with-current-buffer buffer
	159	(when (or (eq other-buffer-modes 'all)
	160	(apply #'derived-mode-p other-buffer-modes))
	161	(setq symbols
	162	(company-dabbrev--search-buffer regexp nil symbols start
	163	limit ignore-comments)))))
	164	(and limit
	165	(> (float-time (time-since start)) limit)
	166	(cl-return))))
	167	symbols))
	168
	169	(defun company-dabbrev--prefix ()
	170	;; Not in the middle of a word.
	171	(unless (looking-at company-dabbrev-char-regexp)
	172	;; Emacs can't do greedy backward-search.
	173	(company-grab-line (format "\\(?:^\\\| \\)[^ ]?\\(\\(?:%s\\)\\)"
	174	company-dabbrev-char-regexp)
	175	1)))
	176
	177	(defun company-dabbrev--filter (prefix candidates)
	178	(let ((completion-ignore-case company-dabbrev-ignore-case))
	179	(all-completions prefix candidates)))
	180
	181	;;;###autoload
	182	(defun company-dabbrev (command &optional arg &rest ignored)
	183	"dabbrev-like `company-mode' completion backend."
	184	(interactive (list 'interactive))
	185	(cl-case command
	186	(interactive (company-begin-backend 'company-dabbrev))
	187	(prefix (company-dabbrev--prefix))
	188	(candidates
	189	(let* ((case-fold-search company-dabbrev-ignore-case)
	190	(words (company-dabbrev--search (company-dabbrev--make-regexp)
	191	company-dabbrev-time-limit
	192	(pcase company-dabbrev-other-buffers
	193	(`t (list major-mode))
	194	(`all `all))))
	195	(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
	196	case-replace
	197	company-dabbrev-downcase)))
	198	(setq words (company-dabbrev--filter arg words))
	199	(if downcase-p
	200	(mapcar 'downcase words)
	201	words)))
	202	(ignore-case company-dabbrev-ignore-case)
	203	(duplicates t)))
	204
	205	(provide 'company-dabbrev)
	206	;;; company-dabbrev.el ends here