|
| 1 | +(in-package :sbcli) |
| 2 | + |
| 3 | +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4 | +;;; Run visual / interactive / ncurses commands in their terminal window. |
| 5 | +;;; |
| 6 | +;;; How to guess a program is interactive? |
| 7 | +;;; We currently look from a hand-made list (à la Eshell). |
| 8 | +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 9 | + |
| 10 | +;; thanks @ambrevar: https://github.com/ruricolist/cmd/issues/10 |
| 11 | +;; for handling command wrappers (sudo) and vterm. |
| 12 | + |
| 13 | +(defparameter *visual-commands* |
| 14 | + '(;; "emacs -nw" ;; in eshell, see concept of visual-subcommands. |
| 15 | + "vim" "vi" |
| 16 | + "nano" |
| 17 | + "htop" "top" |
| 18 | + "man" "less" "more" |
| 19 | + "screen" "tmux" |
| 20 | + "lynx" "links" "mutt" "pine" "tin" "elm" "ncftp" "ncdu" |
| 21 | + "ranger" |
| 22 | + ;; last but not least |
| 23 | + "ciel-repl") |
| 24 | + "List of visual/interactive/ncurses-based programs that will be run in their own terminal window.") |
| 25 | + |
| 26 | +(defun vterm-terminal (cmd) |
| 27 | + "Build a command (string) to send to emacsclient to open CMD with Emacs' vterm." |
| 28 | + (list |
| 29 | + "emacsclient" "--eval" |
| 30 | + (let ((*print-case* :downcase)) |
| 31 | + (write-to-string |
| 32 | + `(progn |
| 33 | + (vterm) |
| 34 | + (vterm-insert ,cmd) |
| 35 | + (vterm-send-return)))))) |
| 36 | + |
| 37 | +(defparameter *visual-terminal-emulator-choices* |
| 38 | + '("terminator" "x-terminal-emulator" "xterm" "gnome-terminal" |
| 39 | + #'vterm-terminal) |
| 40 | + "List of terminals, either a string or a function (that returns a more complete command, as a string).") |
| 41 | + |
| 42 | +(defparameter *visual-terminal-switches* '("-e") |
| 43 | + "Default options to the terminal. `-e' aka `--command'.") |
| 44 | + |
| 45 | +(defvar *command-wrappers* '("sudo" "env")) |
| 46 | + |
| 47 | +(defun find-terminal () |
| 48 | + "Return the first terminal emulator found on the system from the `*visual-terminal-emulator-choices*' list." |
| 49 | + (loop for program in *visual-terminal-emulator-choices* |
| 50 | + if (and (stringp program) |
| 51 | + (which:which program)) |
| 52 | + return program |
| 53 | + else if (functionp program) return program)) |
| 54 | + |
| 55 | +(defun basename (arg) |
| 56 | + (when arg |
| 57 | + (namestring (pathname-name arg)))) |
| 58 | + |
| 59 | +(defun shell-command-wrapper-p (command) |
| 60 | + (find (basename command) |
| 61 | + *command-wrappers* |
| 62 | + :test #'string-equal)) |
| 63 | + |
| 64 | +(defun shell-flag-p (arg) |
| 65 | + (str:starts-with-p "-" arg)) |
| 66 | + |
| 67 | +(defun shell-variable-p (arg) |
| 68 | + (and (< 1 (length arg)) |
| 69 | + (str:contains? "=" (subseq arg 1)))) |
| 70 | + |
| 71 | +(defun shell-first-positional-argument (command) |
| 72 | + "Recursively find the first command that's not a flag, not a variable setting and |
| 73 | +not in `*command-wrappers*'." |
| 74 | + (when command |
| 75 | + (if (or (shell-flag-p (first command)) |
| 76 | + (shell-variable-p (first command)) |
| 77 | + (shell-command-wrapper-p (first command))) |
| 78 | + (shell-first-positional-argument (rest command)) |
| 79 | + (first command)))) |
| 80 | + |
| 81 | +(defun shell-ensure-clean-command-list (command) |
| 82 | + "Return a list of commands, stripped out of a potential \"!\" prefix from Clesh syntax." |
| 83 | + (unless (consp command) |
| 84 | + (setf command (shlex:split command))) |
| 85 | + ;; remove optional ! clesh syntax. |
| 86 | + (setf (first command) |
| 87 | + (string-left-trim "!" (first command))) |
| 88 | + ;; remove blank strings, in case we wrote "! command". |
| 89 | + (remove-if #'str:blankp command)) |
| 90 | + |
| 91 | +(defun visual-command-p (command) |
| 92 | + "Return true if COMMAND runs one of the programs in `*visual-commands*'. |
| 93 | + COMMAND is either a list of strings or a string. |
| 94 | +`*command-wrappers*' are supported, i.e. the following works: |
| 95 | +
|
| 96 | + env FOO=BAR sudo -i powertop" |
| 97 | + (setf command (shell-ensure-clean-command-list command)) |
| 98 | + (let ((cmd (shell-first-positional-argument command))) |
| 99 | + (when cmd |
| 100 | + (find (basename cmd) |
| 101 | + *visual-commands* |
| 102 | + :test #'string=)))) |
| 103 | + |
| 104 | +(defun run-visual-command (text) |
| 105 | + "Run this command (string) in another terminal window." |
| 106 | + (let* ((cmd (string-left-trim "!" text)) |
| 107 | + (terminal (find-terminal))) |
| 108 | + (if terminal |
| 109 | + (cond |
| 110 | + ((stringp terminal) |
| 111 | + (uiop:launch-program `(,terminal |
| 112 | + ;; flatten the list of switches |
| 113 | + ,@*visual-terminal-switches* |
| 114 | + ,cmd))) |
| 115 | + ((functionp terminal) |
| 116 | + (uiop:launch-program (funcall terminal cmd))) |
| 117 | + (t |
| 118 | + (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)))) |
| 119 | + ;; else no terminal found. |
| 120 | + (format *error-output* "Could not find a terminal emulator amongst the list ~a: ~s" |
| 121 | + '*visual-terminal-emulator-choices* |
| 122 | + *visual-terminal-emulator-choices*)))) |
| 123 | + |
| 124 | +#+(or) |
| 125 | +(assert (string-equal "htop" |
| 126 | + (visual-command-p "env rst=ldv sudo htop"))) |
0 commit comments