Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

206 lines
8.4 KiB

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