1 ;;; vmd.el --- vmd interaction mode -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2021 Omar Polo
5 ;; Author: Omar Polo <op@omarpolo.com>
8 ;; Package-Requires: ((transient "0.3.4"))
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
37 (defcustom vmd-vmctl-cmd "vmctl"
38 "Path to the vmctl command to use."
41 (defcustom vmd-console-function #'vmd-run-in-term
42 "Function to use for the `vmd-console' command.
43 It takes two arguments, the string name and the cmd arguments
44 list, and should pop a buffer with a terminal running the
48 (defun vmd-run-in-term (name cmd)
49 "Run CMD inside a term buffer called NAME."
50 (pop-to-buffer (apply #'term-ansi-make-term
52 (car cmd) nil (cdr cmd))))
54 (defun vmd--update-table ()
55 "Update the `tabulated-list-mode' with the list of virtual machines."
56 (let ((columns [("ID" 3 t)
65 (rows (mapcar (lambda (x) `(,(car x) ,(apply #'vector x)))
67 (split-string x nil t))
69 (split-string (shell-command-to-string "vmctl status")
71 (setq tabulated-list-format columns
72 tabulated-list-entries rows)
73 (tabulated-list-init-header)
74 (tabulated-list-print)))
76 (defun vmd--vm-at-point ()
77 "Return the vm name at point."
78 (unless (derived-mode-p 'vmd-mode)
79 (error "Not in vmd-mode"))
80 (let* ((row (tabulated-list-get-entry))
84 (error "No vm at point"))
87 (defun vmd--vmctl (&rest args)
88 "Run a vmctl command with ARGS."
89 (shell-command (mapconcat #'shell-quote-argument (cons "vmctl" args) " ")))
91 (defun vmd-console (vm)
92 "Open a console for the virtual machine VM at point."
93 (interactive (list (vmd--vm-at-point)) vmd-mode)
94 (funcall vmd-console-function
95 (concat "vmd console " vm)
96 (mapcar #'shell-quote-argument
97 (list vmd-vmctl-cmd "console" vm))))
100 "Pause the virtual machine VM at point."
101 (interactive (list (vmd--vm-at-point)) vmd-mode)
102 (vmd--vmctl "pause" vm)
105 (defun vmd-start (vm)
106 "Start the virtual machine VM at point."
107 (interactive (list (vmd--vm-at-point)) vmd-mode)
108 (vmd--vmctl "start" vm)
112 "Stop the virtual machine VM at point."
113 (interactive (list (vmd--vm-at-point)) vmd-mode)
114 (vmd--vmctl "stop" vm)
117 (defun vmd-unpause (vm)
118 "Unpause the virtual machine VM at point."
119 (interactive (list (vmd--vm-at-point)) vmd-mode)
120 (vmd--vmctl "unpause" vm)
123 (transient-define-prefix vmd--transient ()
126 [("c" "console" vmd-console)
127 ("P" "pause" vmd-pause)
128 ("s" "start" vmd-start)
129 ("S" "stop" vmd-stop)
130 ("u" "unpause" vmd-unpause)]])
133 (let ((m (make-sparse-keymap)))
134 (define-key m (kbd "c") #'vmd-console)
135 (define-key m (kbd "P") #'vmd-pause) ; don't conflict with previous-line
136 (define-key m (kbd "s") #'vmd-start)
137 (define-key m (kbd "S") #'vmd-stop)
138 (define-key m (kbd "u") #'vmd-unpause)
140 ;; one transient to rule them all
141 (define-key m (kbd "x") #'vmd--transient)
144 (define-derived-mode vmd-mode tabulated-list-mode "vmd"
147 (add-hook 'tabulated-list-revert-hook #'vmd--update-table nil t))
152 (switch-to-buffer "*vmd*")