-
Notifications
You must be signed in to change notification settings - Fork 2
/
tshell.el
354 lines (305 loc) · 12.7 KB
/
tshell.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
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
;;; tshell.el --- Experimental alternative shell for Emacs
;; -*- lexical-binding: t -*-
;; Author: TatriX <[email protected]>
;; URL: https://github.com/TatriX/pomidor
;; Keywords: terminals, shell
;; Version: 0.1.0
;; Package-Requires: ((emacs "24.3") (transient "0.3"))
;; 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, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; tshell is an experimental buffer-oriented Emacs shell.
;; See https://github.com/TatriX/tshell for documentation.
;;; Code:
(require 'transient)
;;; Customs
(defgroup tshell nil
"Customs for `tshell'"
:group 'applications)
(defcustom tshell-shell-prompt "$ "
"Shell prompt."
:type 'string :group 'tshell)
(defcustom tshell-elisp-prompt "> "
"Emacs Lisp prompt.")
(defcustom tshell-internal-prompt ": "
"Internal prompt.")
;;; Vars
(defvar tshell-buffer "*tshell*")
(defvar tshell-out-buffer "*tshell-out*")
(defvar-local tshell--current-prompt tshell-shell-prompt)
(defvar * nil "Most recent value evaluated in Tshell.")
(defconst tshell-dir (file-name-directory (or load-file-name buffer-file-name))
"`tshell' installation directory.")
(defvar tshell-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'tshell-dispatch)
(define-key map (kbd "C-c SPC") #'tshell-command)
(define-key map (kbd "C-c @") #'tshell-command-region)
(define-key map (kbd "C-c C-d") #'tshell-command-cd)
(define-key map (kbd "C-c C-l") #'tshell-command-ls)
(define-key map (kbd "C-c C-y") #'tshell-yank)
(define-key map (kbd "RET") #'tshell-eval-input)
(define-key map (kbd "C-M-x") #'tshell-eval-command)
map))
(defvar tshell-font-lock-keywords '(("^$ " . font-lock-function-name-face)
("^> " . font-lock-variable-name-face)
("^[$>:] \\_<\\(.*?\\)\\_>" . (1 font-lock-type-face))))
(define-derived-mode tshell-mode fundamental-mode "Tshell"
"Major mode for editing text written for humans to read.
In this mode, paragraphs are delimited only by blank or white lines.
You can thus get the full benefit of adaptive filling
(see the variable `adaptive-fill-mode').
\\{tshell-mode-map}
Turning on Text mode runs the normal hook `text-mode-hook'."
(setq-local tshell-mode t)
(setq-local font-lock-defaults '(tshell-font-lock-keywords))
(setq-local * nil)
(setq-local inhibit-read-only t)
(setq header-line-format '(:eval (format "%s %s"
(propertize
(directory-file-name (abbreviate-file-name default-directory))
'face 'font-lock-variable-name-face)
tshell--current-prompt)))
(when (fboundp 'fish-completion--list-completions)
(add-hook 'completion-at-point-functions #'tshell-completion-at-point nil t)))
(defun tshell ()
(interactive)
;; Create shell and out buffers first.
(let ((buffer (get-buffer-create tshell-buffer))
(out-buffer (get-buffer-create tshell-out-buffer)))
(pop-to-buffer buffer)
(unless (get-buffer-window out-buffer)
(split-window-below 16)
(switch-to-buffer-other-window out-buffer)
(select-window (get-buffer-window buffer)))
(with-current-buffer tshell-buffer
(unless (and (boundp 'tshell-mode) tshell-mode)
(tshell-mode)
(tshell--insert-welcome-note)
(tshell--insert-current-prompt)))))
(defun tshell--insert-current-prompt ()
"Insert current prompt."
(insert tshell--current-prompt))
;;; Public stuff
(defun tshell-eval-input ()
"Either eval current input line."
(interactive)
;; TODO: only eval if line starts with a prompt?
(if (not (eobp))
(tshell-eval-command)
(tshell-eval-command)
(insert "\n")
(tshell--insert-current-prompt)))
;; TODO: Include lines without a prompt to the current command.
(defun tshell-eval-command ()
"Evaluate current command (right now command means line)."
(interactive)
(let ((line (string-trim-right (thing-at-point 'line))))
(cond
;; : help
((string-prefix-p tshell-internal-prompt line)
(tshell-internal-eval (string-remove-prefix tshell-internal-prompt line)))
;; $ shell eval
((string-prefix-p tshell-shell-prompt line)
(tshell-shell-eval (string-remove-prefix tshell-shell-prompt line))
(tshell--set-current-prompt tshell-shell-prompt))
;; > elisp eval
((string-prefix-p tshell-elisp-prompt line)
(tshell-elisp-eval (string-remove-prefix tshell-elisp-prompt line))
(tshell--set-current-prompt tshell-elisp-prompt)
(display-buffer tshell-out-buffer 'other-window))
((= (length line) 1)
;; Do nothing if there is just a prompt or any other single character
)
(t (message "Unknown prompt")))))
(defun tshell-shell-eval (line)
"Evaluate LINE in the shell mode."
;; Some elementary preprocessing.
(cond
((string-equal "cd" line)
(cd "~")
(force-mode-line-update))
((string-prefix-p "cd " line)
(cd (expand-file-name (string-remove-prefix "cd " line)))
(force-mode-line-update))
((string-prefix-p "e " line)
(let ((file (expand-file-name (string-remove-prefix "e " line))))
(with-current-buffer (window-buffer (other-window 1))
(find-file file))))
;; Send out buffer as stdin
((string-prefix-p "> " line)
(tshell-shell-kill)
(with-current-buffer tshell-out-buffer
(shell-command-on-region (point-min)
(point-max)
(string-remove-prefix "> " line)
tshell-out-buffer)))
(t
(let* ((buffer (tshell--extract-buffer line))
(processed-line (if (equal buffer tshell-out-buffer)
line
(string-trim-left line "^.+?> "))))
(tshell-shell-kill buffer)
(async-shell-command processed-line buffer)))))
(defun tshell-elisp-eval (line)
"Evaluate LINE in the elisp mode."
;; Save last shell output to "*" in case it's used in `line'.
(when (equal tshell--current-prompt tshell-shell-prompt)
(setq * (with-current-buffer tshell-out-buffer
(buffer-substring-no-properties (point-min) (point-max)))))
(let ((result (eval (car (read-from-string line)))))
(setq * result)
(with-current-buffer tshell-out-buffer
(erase-buffer)
(insert (pp-to-string result)))))
(defun tshell-internal-eval (line)
"Evaluate LINE as internal command.
Currently available commands are:
: undo
: help"
(pcase line
("undo" (tshell-undo))
("help" (tshell-help))
(_ (tshell-error (format "unknown internal command: '%s'" line)))))
(defun tshell-out-insert (str)
"Insert STR into `tshell-out-buffer'."
(with-current-buffer tshell-out-buffer
(insert str)))
(defun tshell-shell-kill (&optional buffer)
"Kill out buffer process if it's running."
(when (process-live-p (get-buffer-process (or buffer tshell-out-buffer)))
(when (yes-or-no-p "A command is running. Kill it?")
(kill-process (get-buffer-process (or buffer tshell-out-buffer)))
;; wait a bit for process to die
(sit-for 0.1))))
(defun tshell-help ()
"Show tshell help."
(with-current-buffer tshell-out-buffer
(erase-buffer)
(let ((readme (concat tshell-dir "README.md")))
(when (file-exists-p readme)
(insert-file-contents readme)
(set-window-point (get-buffer-window (current-buffer) 'visible) (point-min))
(when (fboundp #'markdown-mode)
(markdown-mode))))))
(defun tshell-undo ()
"Undo changes in out buffer."
(with-current-buffer tshell-out-buffer
(undo 1)
;; Reset "*"
(cond
((string-equal tshell--current-prompt tshell-shell-prompt)
(setq * (buffer-substring-no-properties (point-min) (point-max))))
((string-equal tshell--current-prompt tshell-elisp-prompt)
(setq * (car (read-from-string (buffer-substring-no-properties (point-min) (point-max)))))))))
(defun tshell-error (error)
(with-current-buffer tshell-out-buffer
(erase-buffer)
(insert (format "tshell error: %s" error))))
;;; Private stuff
(defun tshell-completion-at-point ()
"tshell's `completion-at-point' function."
;; FIXME: this is very unreliable
(let* ((start (save-excursion (beginning-of-line) (+ (point) 2)))
(end (point))
(line (buffer-substring-no-properties start end))
(bounds (bounds-of-thing-at-point 'symbol)))
(list (car bounds)
(cdr bounds)
(completion-table-dynamic
`(lambda (_)
(fish-completion--list-completions ,line))))))
(defun tshell--insert-welcome-note ()
"Print welcome note."
(let ((help-url "https://github.com/TatriX/tshell/discussions"))
(insert tshell-shell-prompt "# Welcome to *tshell*\n")
(insert tshell-shell-prompt (substitute-command-keys "# Use `\\[tshell-eval-input]' to run any line\n"))
(insert tshell-internal-prompt "help\n")
(insert tshell-shell-prompt "# Have feature requests, bugreports or general feedback?\n")
(insert tshell-shell-prompt (format "xdg-open %s\n" help-url))
(insert tshell-elisp-prompt (format "(browse-url \"%s\")\n" help-url))
(insert tshell-shell-prompt "ls\n")))
(defun tshell--extract-buffer (line)
"Extract buffer name from the command LINE.
Recognized syntax looks like this: `$ <*buffer-name*>'
Defaults to the value `tshell-out-buffer'"
(if (string-match "^<\\(.+?\\)> " line)
(match-string 1 line)
tshell-out-buffer))
(defun tshell--set-current-prompt (prompt)
"Set current prompt to PROMPT"
(setq-local tshell--current-prompt prompt))
;;; Transient interface
(transient-define-prefix tshell-dispatch ()
"Invoke a tshell command from a list of available commands."
["Transient and dwim commands"
[("d" "cd" tshell-command-cd)
("l" "ls" tshell-command-ls)
("x" "xargs" (lambda () (interactive) (tshell-command-region "xargs ")))
("SPC" "run" (lambda () (interactive) (tshell-command)))
("C-SPC" "run-region" (lambda () (interactive) (tshell-command-region)))]])
(defun tshell-command-cd ()
"Change directory."
(interactive)
(call-interactively #'cd))
(defun tshell-command-ls ()
"Run `ls'."
(interactive)
(async-shell-command "ls -1" tshell-out-buffer))
(defvar tshell--command-history nil)
(defun tshell-command (&optional initial-content)
(interactive)
(let ((cmd (read-shell-command (if shell-command-prompt-show-cwd
(format-message "Tshell command in `%s': "
(abbreviate-file-name
default-directory))
"Tshell command: ")
initial-content nil
(let ((filename
(cond
(buffer-file-name)
((eq major-mode 'dired-mode)
(dired-get-filename nil t)))))
(and filename (file-relative-name filename))))))
(when cmd
(async-shell-command cmd tshell-out-buffer))))
(defun tshell-command-region (&optional initial-content)
(interactive)
(let ((cmd (read-shell-command (if shell-command-prompt-show-cwd
(format-message "Tshell on region command in `%s': "
(abbreviate-file-name
default-directory))
"Tshell command on region: ")
initial-content nil
(let ((filename
(cond
(buffer-file-name)
((eq major-mode 'dired-mode)
(dired-get-filename nil t)))))
(and filename (file-relative-name filename))))))
(when cmd
(with-current-buffer tshell-out-buffer
(shell-command-on-region (if (region-active-p)
(region-beginning)
(point-min))
(if (region-active-p)
(region-end)
(point-max))
cmd
(current-buffer))))))
(defun tshell-yank ()
"Yank contents of the output buffer at point."
(interactive)
(insert-buffer tshell-out-buffer))
(provide 'tshell)
;;; tshell.el ends here