-
-
Notifications
You must be signed in to change notification settings - Fork 16
/
shell-utils.lisp
183 lines (156 loc) · 6.83 KB
/
shell-utils.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
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
(in-package :sbcli)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Run visual / interactive / ncurses commands.
;;;
;;; update <2024-09-04>: now all shell commands are run interactively.
;;; It works for htop, vim, sudo, emacs -nw…
;;;
;;; except in Slime, where the interactivity doesn't work.
;;; That means that the command is run synchronously and we see the output at once at the end.
;;; So this code is meant to be used in Slime:
;;; - guess a program is interactive
;;; - run it on a new and dedicated terminal emulator (xterm or even Emacs' vterm).
;;;
;;; So,
;;; How to guess a program is interactive?
;;; We currently look from a hand-made list (à la Eshell).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; all this is unused as of <2024-09-04> for the terminal CIEL repl
;; but is to be used to support visual commands in Slime.
(defparameter *visual-commands*
'(;; "emacs -nw" ;; unsupported in Slime, works on the terminal. In eshell, see the concept of visual-subcommands.
"vim" "vi"
"nano"
"htop" "top"
"man" "less" "more"
"screen" "tmux"
"lynx" "links" "mutt" "pine" "tin" "elm" "ncftp" "ncdu"
"ranger"
"mpv" "mplayer"
"ipython" "irb" "iex" ;; TBC
;; last but not least
"ciel-repl")
"List of visual/interactive/ncurses-based programs that will be run in their own terminal window.
Visual commands work by default in the terminal REPL.
This would be useful only in Slime.")
(defun vterm-terminal (cmd)
"Build a command (string) to send to emacsclient to open CMD with Emacs' vterm."
(list
"emacsclient" "--eval"
(let ((*print-case* :downcase))
(write-to-string
`(progn
(vterm)
(vterm-insert ,cmd)
(vterm-send-return))))))
(defparameter *visual-terminal-emulator-choices*
'("terminator" "x-terminal-emulator" "xterm" "gnome-terminal"
#'vterm-terminal)
"List of terminals emulators, either a string or a function (that returns a more complete command, as a string).
Used only from a dumb terminal. The goal is to use this on the Slime REPL.")
(defparameter *visual-terminal-switches* '("-e")
"Default options to the terminal. `-e' aka `--command'.")
(defvar *command-wrappers* '("sudo" "env"))
(defun find-terminal ()
"Return the first terminal emulator found on the system from the `*visual-terminal-emulator-choices*' list."
(loop for program in *visual-terminal-emulator-choices*
if (and (stringp program)
(which:which program))
return program
else if (functionp program) return program))
(defun basename (arg)
;; ARG can be any string. This fails with "(qs:?" (note the "?").
(ignore-errors
(when arg
(namestring (pathname-name arg)))))
(defun shell-command-wrapper-p (command)
"Is this command (string) a shell wrapper? (such as sudo or env)
See `*command-wrappers*'."
(find (basename command)
*command-wrappers*
:test #'string-equal))
(defun shell-flag-p (arg)
"Is this string a shell CLI flag? It starts with \"-\"."
(str:starts-with-p "-" arg))
(defun shell-variable-p (arg)
"Is this string a shell variable? It contains a \"=\" such as in \"foo=1\"."
(and (< 1 (length arg))
(str:contains? "=" (subseq arg 1))))
(defun shell-first-positional-argument (command)
"Recursively find the first command that's not a flag, not a variable setting and
not in `*command-wrappers*' (sudo etc)."
(when command
(if (or (shell-flag-p (first command))
(shell-variable-p (first command))
(shell-command-wrapper-p (first command)))
(shell-first-positional-argument (rest command))
(first command))))
(defun shell-ensure-clean-command-list (command)
"Return a list of commands, stripped out of a potential \"!\" prefix from Clesh syntax."
(unless (consp command)
(setf command (shlex:split command)))
;; remove optional ! clesh syntax.
;; and remove blank strings of the first word, in case we wrote "! command".
(setf (first command)
(string-left-trim "!" (first command)))
(remove-if #'str:blankp command))
(defun %visual-command-p (command)
;; probably from shlex.
(setf command (shell-ensure-clean-command-list command))
(let ((cmd (shell-first-positional-argument command)))
(when cmd
(find (basename cmd)
*visual-commands*
:test #'string=))))
(defun visual-command-p (command)
"Return true if COMMAND starts with '!' (clesh syntax)
and runs one of the programs in `*visual-commands*'.
COMMAND is either a list of strings or a string. `*command-wrappers*' are supported, i.e. the following works:
env FOO=BAR sudo -i powertop
Changed <2024-09-02>: shell commands must always start with a !, following the clesh syntax, that is enabled by default."
(and (str:starts-with-p "!" command)
;; The shell lexer can fail, the top level would catch the error
;; and we'll see like:
;; !echo "
;; Error: Missing closing quotation in string
(%visual-command-p command)))
(defun run-shell-command (text)
"Run this shell command."
;; XXX: not with Clesh = difference in behaviours coming.
(ignore-errors
(cmd:cmd text)))
(defun run-shell-command-in-external-terminal (text)
"Launch a new terminal emulator window to run this command (string, sans \"!\" prefix\").
The goal is to use the same \"!\" syntax for visual commands in Slime.
TODO: We have to contribute this to Clesh."
(let* ((cmd (string-left-trim "!" text))
(terminal (find-terminal)))
(if (str:emptyp terminal)
(format *error-output* "Could not find a terminal emulator amongst the list ~a: ~s"
'*visual-terminal-emulator-choices*
*visual-terminal-emulator-choices*)
(cond
((stringp terminal)
(uiop:launch-program `(,terminal
;; flatten the list of switches
,@*visual-terminal-switches*
,cmd)))
((functionp terminal)
(uiop:launch-program (funcall terminal cmd)))
(t
(format *error-output* "We cannot use a terminal designator of type ~a. Please use a string (\"xterm\") or a function that returns a string." (type-of terminal)))))))
(defun run-visual-command (text)
"Run this visual command (string, sans \"!\" prefix).
If we are in a \"DUMB\" terminal, run it in another terminal window."
(if (termp:termp)
(uiop:run-program (shell-ensure-clean-command-list text)
:output :interactive
:input :interactive)
(run-shell-command-in-external-terminal text)))
#+test-ciel
(assert (string-equal "htop"
(visual-command-p "!env rst=ldv sudo htop")))
(defun maybe-run-visual-command (cmd)
(if (visual-command-p cmd)
(run-visual-command cmd)
(run-shell-command cmd)))