]> crepu.dev Git - config.git/blame - djavu-asus/elpa/company-20230926.32/company-dabbrev.el
Configuracion en desarrollo PC pega
[config.git] / djavu-asus / elpa / company-20230926.32 / company-dabbrev.el
CommitLineData
53e6db90
DC
1;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*- lexical-binding: t -*-
2
3;; Copyright (C) 2009-2011, 2013-2018, 2021 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 <https://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.
37If `all', search all other buffers, except the ignored ones. If t, search
38buffers 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.
45Or 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.
61When it's `keep-prefix', the text before point will remain unchanged after
62candidate 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
71The value of nil means keep them as-is.
72`case-replace' means use the value of `case-replace'.
73Any other value means downcase.
74
75If 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.
84This 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 (kind 'text)
203 (ignore-case company-dabbrev-ignore-case)
204 (duplicates t)))
205
206(provide 'company-dabbrev)
207;;; company-dabbrev.el ends here