-
Notifications
You must be signed in to change notification settings - Fork 0
/
complete.lisp
129 lines (119 loc) · 4.55 KB
/
complete.lisp
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
(in-package :repl)
(defun common-prefix (items)
(subseq (car items)
0
(apply #'min
(mapcar #'(lambda (item)
(or (mismatch (car items) item)
(length item)))
(cdr items)))))
(defun package-prefix (str)
(cond ((let ((pos (search "::" str)))
(when pos
(list (subseq str (+ pos 2)) (subseq str 0 pos) nil))))
((let ((pos (position #\: str)))
(when pos
(list (subseq str (+ pos 1))
(if (zerop pos)
"KEYWORD"
(subseq str 0 pos))
t))))
(t
(list str nil nil))))
(defun symbol-complete (text start end)
(declare (ignore start end))
(let ((text (string-upcase text))
(els))
(flet ((body (sym text prefix)
(let ((name (string sym)))
(when (eql 0 (search text name))
(push (format nil "~(~a~a~)" prefix name)
els)))))
(destructuring-bind (symbol-name package external-p)
(package-prefix text)
(when (and package (not (find-package package)))
(return-from symbol-complete nil))
(cond ((and package external-p)
(do-external-symbols (sym package)
(body sym symbol-name
(if (equal (package-name :keyword)
(package-name package))
":"
(format nil "~a:" package)))))
(package
(do-symbols (sym package)
(body sym symbol-name (format nil "~a::" package))))
(t
(do-symbols (sym *package*)
(body sym symbol-name ""))
(dolist (package (list-all-packages))
(body (format nil "~a:" (package-name package))
symbol-name "")
(dolist (package-name (package-nicknames package))
(body (format nil "~a:" package-name)
symbol-name "")))))))
(if (cdr els)
(cons (common-prefix els) els)
els)))
(defun filter-filenames (path text)
(loop :with path = (probe-file path)
:for pathname :in (cl-fad:list-directory path)
:for name := (enough-namestring pathname path)
:when (eql 0 (search text name))
:collect name))
(defun file-complete (text default-directories-fn)
(if (find #\/ text)
(let* ((slash-pos (1+ (position #\/ text :from-end t)))
(dir (subseq text 0 slash-pos))
(name (subseq text slash-pos)))
(mapcar #'(lambda (name)
(format nil "~a~a" dir name))
(filter-filenames dir name)))
(mapcan #'(lambda (path)
(filter-filenames path text))
(funcall default-directories-fn))))
(defun do-filename-complete-p (text start end)
(declare (ignore text end))
(or (and (< 0 start)
(eql #\" (aref rl:*line-buffer*
(1- start))))
(let ((str (string-trim '(#\space #\tab) rl:*line-buffer*)))
(and (< 0 (length str))
(eql #\! (aref str 0))))))
(defun shell-command-complete (text)
(let ((els
(file-complete text
#'(lambda ()
(split-sequence:split-sequence
#\: (uiop:getenv "PATH"))))))
(cond ((null els)
nil)
((cdr els)
(cons (format nil "!~a" (common-prefix els)) els))
(t
(list (format nil "!~a" (car els)))))))
(defun shell-complete (text start end)
(declare (ignore end))
(when (zerop start)
(setq text
(subseq (string-trim '(#\space #\tab)
text)
1)))
(shell-command-complete text))
(defun repl-complete (text start end)
(let ((linebuf (string-trim '(#\space #\tab) rl:*line-buffer*)))
(cond ((and (zerop start)
(< 0 (length linebuf))
(eql #\! (aref linebuf 0)))
(shell-complete text start end))
((do-filename-complete-p text start end)
(let ((els
(file-complete text
#'(lambda ()
(list (uiop:getcwd))))))
(if (cdr els)
(cons (common-prefix els) els)
els)))
(t
(symbol-complete text start end)))))
(rl:register-function :complete #'repl-complete)