-
Notifications
You must be signed in to change notification settings - Fork 1
/
company-async-files.el
190 lines (167 loc) · 8.07 KB
/
company-async-files.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
;;; company-async-files.el --- company backend for files -*- lexical-binding: t; -*-
;; Copyright (C) 2017 by Troy Hinckley
;; Author: Troy Hinckley <[email protected]>
;; URL: https://github.com/CeleritasCelery/company-async-files
;; Version: 0.1.0
;; Package-Requires: ((company "0.9.3") (cl-lib "0.5.0") (f "0.18.2") (dash "2.12.0") (s "1.12") (emacs "25"))
;; This file is not part of GNU Emacs.
;; 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/>.
;;; Commentary:
;; async Company backend for files.
;; =company-async-files= provides the same completion as =company-files=,
;; but asynchronously uses find in the background to get the candidates.
;; This ensures that your user thread is never blocked by your completion
;; backend, which is the way it should be.
;;; Code:
(require 'company)
(require 'dash)
(require 's)
(require 'f)
(require 'cl-lib)
;;; Customizable variables
(defgroup company-async-files nil
"company back-end for async file completion"
:prefix "company-async-files-"
:group 'programming
:link '(url-link :tag "Github" "https://github.com/CeleritasCelery/company-async-files"))
(defcustom company-async-files-depth-search-timeout 0.5
"Amount of time in seconds to wait before cancelling the depth search."
:type 'number)
(defvar company-async-files--cand-dir nil)
(defun company-async-files--get-path ()
"Get the current path at point.
Returns a cons cell with directory in `car'
and prefix in `cdr'"
(--when-let (-some->> (point)
(buffer-substring-no-properties (line-beginning-position))
(s-match (rx (+ (any alnum "~/${}._-" "'\"")) eos))
(car)
(s-replace "~" "$HOME")
(s-replace "$ENV" "$") ;; perl form
substitute-env-vars
(replace-regexp-in-string (rx (any "'\"")) "")
(s-split (f-path-separator))
(-rotate 1))
(unless (equal it '(""))
(-let* (((prefix . dirs) it)
;; when we are at the root need to
;; include the root
(dir-name (if (equal '("") dirs)
(f-root)
(s-join (f-path-separator) dirs))))
(cons dir-name prefix)))))
(defun company-async-files--prefix ()
"Get the uncompleted part of the path at point."
(-let [(dir . prefix) (company-async-files--get-path)]
(when (and dir
(f-directory? dir)
(looking-back (rx (or symbol-end punctuation)) (1- (point)))
(looking-back (regexp-quote prefix)
(- (point) (length prefix)))
(->> (format "find %s -maxdepth 1 -name '%s*' 2>/dev/null | wc -l" (f-full dir) prefix)
shell-command-to-string
string-to-number
zerop
not))
(when (and company-async-files--cand-dir
(f-dirname dir)
(f-same? company-async-files--cand-dir (f-dirname dir)))
(setq prefix (concat (f-filename dir) (f-path-separator) prefix)))
(cons prefix (+ (length dir) (length prefix))))))
(defun company-async-files--candidates (callback)
"Get all files and directories at point and invoke CALLBACK.
By deafult `company-async-files--candidates' get all candidates in the current
directory and all subdirectories. If this takes longer then
`company-async-files-depth-search-timeout' it will only supply candiates in the
current directory."
(-let (((dir . prefix) (company-async-files--get-path))
(buffer-1 (get-buffer-create "*file-candiates-1*"))
(buffer-2 (get-buffer-create "*file-candiates-2*"))
(default-directory (if (file-exists-p default-directory)
default-directory user-emacs-directory))
((timeout? respond)))
(cl-loop for buffer in (list buffer-1 buffer-2)
do (let ((proc (get-buffer-process buffer)))
(when (process-live-p proc)
(kill-process proc)))
(with-current-buffer buffer
(erase-buffer)))
(setq company-async-files--cand-dir dir)
(setq dir (f-full dir))
(setq respond (lambda (buf)
(funcall callback (company-async-files--parse buf))))
(set-process-sentinel (start-process-shell-command
"file-candiates-1"
buffer-1
(s-lex-format "cd ${dir} && find -L ${prefix}* -maxdepth 0 -printf '%p\t%y\n' 2>/dev/null" ))
(lambda (_ event)
(when (string-equal event "finished\n")
(if timeout?
(funcall respond buffer-1)
(setq timeout? t)))))
(set-process-sentinel (start-process-shell-command
"file-candiates-2"
buffer-2
(s-lex-format "cd ${dir} && find -L ${prefix}* -maxdepth 1 -printf '%p\t%y\n' 2>/dev/null" ))
(lambda (_ event)
(when (string-equal event "finished\n")
(funcall respond buffer-2))))
(run-at-time company-async-files-depth-search-timeout nil
(lambda ()
(if timeout?
(funcall respond buffer-1)
(setq timeout? t))))))
(defun company-async-files--parse (buffer)
"Read the result of GNU find from BUFFER.
The results are of the form
candidate type"
(--map (-let [(file type) (s-split "\t" it)]
(if (string-equal type "d")
(concat file (f-path-separator))
file))
(s-lines
(s-trim (with-current-buffer buffer
(buffer-string))))))
(defun company-async-files--post (cand)
"Remove the trailing `f-path-separator' from CAND."
(when (s-suffix? (f-path-separator) cand)
(delete-char -1))
(setq company-async-files--cand-dir nil))
(defun company-async-files--meta (cand)
"Show the system info for CAND."
(->> (expand-file-name cand company-async-files--cand-dir)
(format "ls --directory --human-readable -l %s")
(shell-command-to-string)
(replace-regexp-in-string (rx (group-n 1
(repeat 8
(and (1+ (not space))
(1+ space))))
(1+ (not space)))
"\\1")))
;;;###autoload
(defun company-async-files (command &optional arg &rest ignored)
"Complete file paths using find. See `company's COMMAND ARG and IGNORED for details."
(interactive (list 'interactive))
(let ((default-directory (if (file-exists-p default-directory)
default-directory user-emacs-directory)))
(cl-case command
(interactive (company-begin-backend 'company-async-files))
(prefix (company-async-files--prefix))
(candidates (cons :async (lambda (callback) (company-async-files--candidates callback))))
(meta (company-async-files--meta arg))
(post-completion (company-async-files--post arg)))))
(defun company-async-files--clear-dir (_)
"Clear async files directory."
(setq company-async-files--cand-dir nil))
(add-hook 'company-completion-cancelled-hook 'company-async-files--clear-dir)
(provide 'company-async-files)
;;; company-async-files.el ends here