my-emacs-d/elpa/helm-20160925.2152/helm-dabbrev.el
2016-09-26 19:08:35 +02:00

328 lines
14 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2016 Thierry Volpiatto <thierry.volpiatto@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'helm)
(require 'helm-lib)
(require 'helm-help)
(require 'helm-elisp) ; For show-completion.
(defgroup helm-dabbrev nil
"Dabbrev related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-dabbrev-always-search-all t
"Always search in all buffers when non--nil.
Note that even if nil, a search in all buffers
will occur if the length of candidates is <= than
`helm-dabbrev-max-length-result'."
:group 'helm-dabbrev
:type 'boolean)
(defcustom helm-dabbrev-max-length-result 20
"Max length of candidates before searching in all buffers.
If number of candidates found in current-buffer is <= to this,
search in all buffers.
Have no effect when `helm-dabbrev-always-search-all' is non--nil."
:group 'helm-dabbrev
:type 'integer)
(defcustom helm-dabbrev-ignored-buffers-regexps
'("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List")
"List of regexps matching names of buffers that helm-dabbrev should not check."
:group 'helm-dabbrev
:type '(repeat regexp))
(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
"A function that decide if a buffer to search in is related to `current-buffer'.
This is actually determined by comparing `major-mode' of the buffer to search
and the `current-buffer'.
The function take one arg, the buffer which is current, look at
`helm-dabbrev--same-major-mode-p' for example.
When nil all buffers are considered related to `current-buffer'."
:group 'helm-dabbrev
:type 'function)
(defcustom helm-dabbrev-major-mode-assoc nil
"Major mode association alist.
This allow helm-dabbrev searching in buffers with the associated `major-mode'.
e.g \(emacs-lisp-mode . lisp-interaction-mode\)
will allow searching in the lisp-interaction-mode buffer when `current-buffer'
is an `emacs-lisp-mode' buffer and vice versa i.e
no need to provide \(lisp-interaction-mode . emacs-lisp-mode\) association.
When nil check is the searched buffer have same `major-mode'
than the `current-buffer'.
This have no effect when `helm-dabbrev-related-buffer-fn' is nil or of course
bound to a function that doesn't handle this var."
:type '(alist :key-type symbol :value-type symbol)
:group 'helm-dabbrev)
(defcustom helm-dabbrev-lineno-around 30
"Search first in this number of lines before an after point."
:group 'helm-dabbrev
:type 'integer)
(defcustom helm-dabbrev-cycle-threshold nil
"Number of time helm-dabbrev cycle before displaying helm completion.
When nil or 0 disable cycling."
:group 'helm-dabbrev
:type '(choice (const :tag "Cycling disabled" nil) integer))
(defcustom helm-dabbrev-case-fold-search 'smart
"Set `case-fold-search' in `helm-dabbrev'.
Same as `helm-case-fold-search' but for `helm-dabbrev'.
Note that this is not affecting searching in helm buffer,
but the initial search for all candidates in buffer(s)."
:group 'helm-dabbrev
:type '(choice (const :tag "Ignore case" t)
(const :tag "Respect case" nil)
(other :tag "Smart" 'smart)))
(defvar helm-dabbrev-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-/") 'helm-next-line)
(define-key map (kbd "M-:") 'helm-previous-line)
map))
;; Internal
(defvar helm-dabbrev--exclude-current-buffer-flag nil)
(defvar helm-dabbrev--cache nil)
(defvar helm-dabbrev--data nil)
(defvar helm-dabbrev--regexp "\\s-\\|\t\\|[(\[\{\"'`=<$;.]\\|\\s\\\\|^")
(cl-defstruct helm-dabbrev-info dabbrev limits iterator)
(defun helm-dabbrev--buffer-list ()
(cl-loop with lst = (buffer-list)
for buf in (if helm-dabbrev--exclude-current-buffer-flag
(cdr lst) lst)
unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps
thereis (string-match r (buffer-name buf)))
collect buf))
(defun helm-dabbrev--same-major-mode-p (start-buffer)
"Decide if current-buffer is related to START-BUFFER."
(helm-same-major-mode-p start-buffer helm-dabbrev-major-mode-assoc))
(defun helm-dabbrev--collect (str limit ignore-case all)
(let* ((case-fold-search ignore-case)
(buffer1 (current-buffer)) ; start buffer.
(minibuf (minibufferp buffer1))
result pos-before pos-after
(search-and-store
(lambda (pattern direction)
(while (cl-case direction
(1 (search-forward pattern nil t))
(-1 (search-backward pattern nil t))
(2 (let ((pos
(save-excursion
(forward-line
helm-dabbrev-lineno-around)
(point))))
(setq pos-after pos)
(search-forward pattern pos t)))
(-2 (let ((pos
(save-excursion
(forward-line
(- helm-dabbrev-lineno-around))
(point))))
(setq pos-before pos)
(search-backward pattern pos t))))
(let* ((replace-regexp (concat "\\(" helm-dabbrev--regexp "\\)\\'"))
(match-1 (helm-aif (thing-at-point 'symbol)
;; `thing-at-point' returns
;; the quote outside of e-lisp mode,
;; e.g in message mode,
;; `foo' => foo'
;; but in e-lisp like modes:
;; `foo' => foo
;; so remove it [1].
(replace-regexp-in-string
replace-regexp
"" (substring-no-properties it))))
(match-2 (helm-aif (thing-at-point 'filename)
;; Same as in [1].
(replace-regexp-in-string
replace-regexp
"" (substring-no-properties it))))
(lst (if (string= match-1 match-2)
(list match-1)
(list match-1 match-2))))
(cl-loop for match in lst
unless (or (string= str match)
(member match result))
do (push match result)))))))
(cl-loop for buf in (if all (helm-dabbrev--buffer-list)
(list (current-buffer)))
do (with-current-buffer buf
(when (or minibuf ; check against all buffers when in minibuffer.
(if helm-dabbrev-related-buffer-fn
(funcall helm-dabbrev-related-buffer-fn buffer1)
t))
(save-excursion
;; Start searching before thing before point.
(goto-char (- (point) (length str)))
;; Search the last 30 lines before point.
(funcall search-and-store str -2)) ; store pos [1]
(save-excursion
;; Search the next 30 lines after point.
(funcall search-and-store str 2)) ; store pos [2]
(save-excursion
;; Search all before point.
(goto-char pos-before) ; start from [1]
(funcall search-and-store str -1))
(save-excursion
;; Search all after point.
(goto-char pos-after) ; start from [2]
(funcall search-and-store str 1))))
when (> (length result) limit) return (nreverse result)
finally return (nreverse result))))
(defun helm-dabbrev--get-candidates (abbrev)
(cl-assert abbrev nil "[No Match]")
(with-current-buffer (current-buffer)
(let* ((dabbrev-get (lambda (str all-bufs)
(helm-dabbrev--collect
str helm-candidate-number-limit
(cl-case helm-dabbrev-case-fold-search
(smart (helm-set-case-fold-search-1 abbrev))
(t helm-dabbrev-case-fold-search))
all-bufs)))
(lst (funcall dabbrev-get abbrev helm-dabbrev-always-search-all)))
(if (and (not helm-dabbrev-always-search-all)
(<= (length lst) helm-dabbrev-max-length-result))
;; Search all but don't recompute current-buffer.
(let ((helm-dabbrev--exclude-current-buffer-flag t))
(append lst (funcall dabbrev-get abbrev 'all-bufs)))
lst))))
(defun helm-dabbrev-default-action (candidate)
(with-helm-current-buffer
(let* ((limits (helm-bounds-of-thing-before-point
helm-dabbrev--regexp))
(beg (car limits))
(end (point)))
(run-with-timer
0.01 nil
'helm-insert-completion-at-point
beg end candidate))))
;;;###autoload
(defun helm-dabbrev ()
"Preconfigured helm for dynamic abbreviations."
(interactive)
(let ((dabbrev (helm-thing-before-point nil helm-dabbrev--regexp))
(limits (helm-bounds-of-thing-before-point helm-dabbrev--regexp))
(enable-recursive-minibuffers t)
(cycling-disabled-p (or (null helm-dabbrev-cycle-threshold)
(zerop helm-dabbrev-cycle-threshold)))
(helm-execute-action-at-once-if-one t)
(helm-quit-if-no-candidate
(lambda ()
(message "[Helm-dabbrev: No expansion found]"))))
(cl-assert (and (stringp dabbrev) (not (string= dabbrev "")))
nil "[Helm-dabbrev: Nothing found before point]")
(when (and
;; have been called at least once.
(helm-dabbrev-info-p helm-dabbrev--data)
;; But user have moved with some other command
;; in the meaning time.
(not (eq last-command 'helm-dabbrev)))
(setq helm-dabbrev--data nil))
(when cycling-disabled-p
(setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)))
(unless (or cycling-disabled-p
(helm-dabbrev-info-p helm-dabbrev--data))
(setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev))
(setq helm-dabbrev--data
(make-helm-dabbrev-info
:dabbrev dabbrev
:limits limits
:iterator
(helm-iter-list
(cl-loop for i in helm-dabbrev--cache when
(and i (string-match
(concat "^" (regexp-quote dabbrev)) i))
collect i into selection
when (and selection
(= (length selection)
helm-dabbrev-cycle-threshold))
;; When selection len reach
;; `helm-dabbrev-cycle-threshold'
;; return selection.
return selection
;; selection len never reach
;; `helm-dabbrev-cycle-threshold'
;; return selection.
finally return selection)))))
(let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data)
(helm-dabbrev-info-iterator helm-dabbrev--data)))
deactivate-mark)
;; Cycle until iterator is consumed.
(helm-aif (and iter (helm-iter-next iter))
(progn
(helm-insert-completion-at-point
(car (helm-dabbrev-info-limits helm-dabbrev--data))
(cdr limits) it)
;; Move already tried candidates to end of list.
(setq helm-dabbrev--cache (append (remove it helm-dabbrev--cache)
(list it))))
;; If the length of candidates is only one when computed
;; that's mean the unique matched item have already been
;; inserted by the iterator, so no need to reinsert the old dabbrev,
;; just let helm exiting with "No expansion found".
(let ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data)
(helm-dabbrev-info-dabbrev helm-dabbrev--data)
dabbrev)))
(unless (cdr (all-completions old-dabbrev helm-dabbrev--cache))
(setq cycling-disabled-p t))
;; Iterator is now empty, reset dabbrev to initial value
;; and start helm completion.
(unless cycling-disabled-p
(setq dabbrev old-dabbrev
limits (helm-dabbrev-info-limits helm-dabbrev--data))
(setq helm-dabbrev--data nil)
(delete-region (car limits) (point))
(insert dabbrev))
(with-helm-show-completion (car limits) (cdr limits)
(helm :sources (helm-build-in-buffer-source "Dabbrev Expand"
:data helm-dabbrev--cache
:persistent-action 'ignore
:persistent-help "DoNothing"
:keymap helm-dabbrev-map
:action 'helm-dabbrev-default-action)
:buffer "*helm dabbrev*"
:input (concat "^" dabbrev " ")
:resume 'noresume
:allow-nest t)))))))
(provide 'helm-dabbrev)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions obsolete)
;; coding: utf-8
;; indent-tabs-mode: nil
;; End:
;;; helm-dabbrev.el ends here