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
70 (concat vmd-vmctl-cmd " status"))
72 (setq tabulated-list-format columns
73 tabulated-list-entries rows)
74 (tabulated-list-init-header)
75 (tabulated-list-print)))
77 (defun vmd--vm-at-point ()
78 "Return the vm name at point."
79 (unless (derived-mode-p 'vmd-mode)
80 (error "Not in vmd-mode"))
81 (let* ((row (tabulated-list-get-entry))
85 (error "No vm at point"))
88 (defun vmd--vmctl (&rest args)
89 "Run a vmctl command with ARGS."
90 (shell-command (mapconcat #'shell-quote-argument (cons vmd-vmctl-cmd args) " ")))
92 (defun vmd-console (vm)
93 "Open a console for the virtual machine VM at point."
94 (interactive (list (vmd--vm-at-point)) vmd-mode)
95 (funcall vmd-console-function
96 (concat "vmd console " vm)
97 (mapcar #'shell-quote-argument
98 (list vmd-vmctl-cmd "console" vm))))
100 (defun vmd-pause (vm)
101 "Pause the virtual machine VM at point."
102 (interactive (list (vmd--vm-at-point)) vmd-mode)
103 (vmd--vmctl "pause" vm)
106 (defun vmd-start (vm)
107 "Start the virtual machine VM at point."
108 (interactive (list (vmd--vm-at-point)) vmd-mode)
109 (vmd--vmctl "start" vm)
113 "Stop the virtual machine VM at point."
114 (interactive (list (vmd--vm-at-point)) vmd-mode)
115 (vmd--vmctl "stop" vm)
118 (defun vmd-unpause (vm)
119 "Unpause the virtual machine VM at point."
120 (interactive (list (vmd--vm-at-point)) vmd-mode)
121 (vmd--vmctl "unpause" vm)
124 (transient-define-prefix vmd--transient ()
127 [("c" "console" vmd-console)
128 ("P" "pause" vmd-pause)
129 ("s" "start" vmd-start)
130 ("S" "stop" vmd-stop)
131 ("u" "unpause" vmd-unpause)]])
134 (let ((m (make-sparse-keymap)))
135 (define-key m (kbd "c") #'vmd-console)
136 (define-key m (kbd "P") #'vmd-pause) ; don't conflict with previous-line
137 (define-key m (kbd "s") #'vmd-start)
138 (define-key m (kbd "S") #'vmd-stop)
139 (define-key m (kbd "u") #'vmd-unpause)
141 ;; one transient to rule them all
142 (define-key m (kbd "x") #'vmd--transient)
145 (define-derived-mode vmd-mode tabulated-list-mode "vmd"
148 (add-hook 'tabulated-list-revert-hook #'vmd--update-table nil t))
153 (switch-to-buffer "*vmd*")