1 56142b9f 2021-05-26 op ;;; vmd.el --- vmd interaction mode -*- lexical-binding: t; -*-
3 56142b9f 2021-05-26 op ;; Copyright (C) 2021 Omar Polo
5 56142b9f 2021-05-26 op ;; Author: Omar Polo <op@omarpolo.com>
6 56142b9f 2021-05-26 op ;; Keywords: tools
7 56142b9f 2021-05-26 op ;; Version: 0.1.0
8 56142b9f 2021-05-26 op ;; Package-Requires: ((transient "0.3.4"))
10 56142b9f 2021-05-26 op ;; This program is free software; you can redistribute it and/or modify
11 56142b9f 2021-05-26 op ;; it under the terms of the GNU General Public License as published by
12 56142b9f 2021-05-26 op ;; the Free Software Foundation, either version 3 of the License, or
13 56142b9f 2021-05-26 op ;; (at your option) any later version.
15 56142b9f 2021-05-26 op ;; This program is distributed in the hope that it will be useful,
16 56142b9f 2021-05-26 op ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 56142b9f 2021-05-26 op ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 56142b9f 2021-05-26 op ;; GNU General Public License for more details.
20 56142b9f 2021-05-26 op ;; You should have received a copy of the GNU General Public License
21 56142b9f 2021-05-26 op ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
23 56142b9f 2021-05-26 op ;;; Commentary:
29 56142b9f 2021-05-26 op (require 'term)
30 56142b9f 2021-05-26 op (require 'transient)
32 56142b9f 2021-05-26 op (defgroup vmd nil
34 56142b9f 2021-05-26 op :prefix "vmd-"
37 56142b9f 2021-05-26 op (defcustom vmd-vmctl-cmd "vmctl"
38 56142b9f 2021-05-26 op "Path to the vmctl command to use."
39 56142b9f 2021-05-26 op :type 'string)
41 56142b9f 2021-05-26 op (defcustom vmd-console-function #'vmd-run-in-term
42 56142b9f 2021-05-26 op "Function to use for the `vmd-console' command.
43 56142b9f 2021-05-26 op It takes two arguments, the string name and the cmd arguments
44 56142b9f 2021-05-26 op list, and should pop a buffer with a terminal running the
45 56142b9f 2021-05-26 op commands in cmd."
46 56142b9f 2021-05-26 op :type 'function)
48 56142b9f 2021-05-26 op (defun vmd-run-in-term (name cmd)
49 56142b9f 2021-05-26 op "Run CMD inside a term buffer called NAME."
50 56142b9f 2021-05-26 op (pop-to-buffer (apply #'term-ansi-make-term
51 56142b9f 2021-05-26 op (concat "*" name "*")
52 56142b9f 2021-05-26 op (car cmd) nil (cdr cmd))))
54 56142b9f 2021-05-26 op (defun vmd--update-table ()
55 56142b9f 2021-05-26 op "Update the `tabulated-list-mode' with the list of virtual machines."
56 56142b9f 2021-05-26 op (let ((columns [("ID" 3 t)
58 56142b9f 2021-05-26 op ("VCPUS" 5 nil)
59 56142b9f 2021-05-26 op ("MAXMEM" 6 nil)
60 56142b9f 2021-05-26 op ("CURMEM" 6 nil)
64 56142b9f 2021-05-26 op ("NAME" 30 t)])
65 56142b9f 2021-05-26 op (rows (mapcar (lambda (x) `(,(car x) ,(apply #'vector x)))
66 56142b9f 2021-05-26 op (mapcar (lambda (x)
67 56142b9f 2021-05-26 op (split-string x nil t))
69 36267e0b 2021-05-26 op (split-string (shell-command-to-string
70 36267e0b 2021-05-26 op (concat vmd-vmctl-cmd " status"))
72 56142b9f 2021-05-26 op (setq tabulated-list-format columns
73 56142b9f 2021-05-26 op tabulated-list-entries rows)
74 56142b9f 2021-05-26 op (tabulated-list-init-header)
75 56142b9f 2021-05-26 op (tabulated-list-print)))
77 56142b9f 2021-05-26 op (defun vmd--vm-at-point ()
78 56142b9f 2021-05-26 op "Return the vm name at point."
79 56142b9f 2021-05-26 op (unless (derived-mode-p 'vmd-mode)
80 56142b9f 2021-05-26 op (error "Not in vmd-mode"))
81 56142b9f 2021-05-26 op (let* ((row (tabulated-list-get-entry))
82 56142b9f 2021-05-26 op (len (length row)))
83 56142b9f 2021-05-26 op (when (or (null row)
85 56142b9f 2021-05-26 op (error "No vm at point"))
86 56142b9f 2021-05-26 op (aref row (1- len))))
88 56142b9f 2021-05-26 op (defun vmd--vmctl (&rest args)
89 56142b9f 2021-05-26 op "Run a vmctl command with ARGS."
90 36267e0b 2021-05-26 op (shell-command (mapconcat #'shell-quote-argument (cons vmd-vmctl-cmd args) " ")))
92 56142b9f 2021-05-26 op (defun vmd-console (vm)
93 123035ff 2021-05-26 op "Open a console for the VM at point."
94 56142b9f 2021-05-26 op (interactive (list (vmd--vm-at-point)) vmd-mode)
95 56142b9f 2021-05-26 op (funcall vmd-console-function
96 56142b9f 2021-05-26 op (concat "vmd console " vm)
97 56142b9f 2021-05-26 op (mapcar #'shell-quote-argument
98 56142b9f 2021-05-26 op (list vmd-vmctl-cmd "console" vm))))
100 56142b9f 2021-05-26 op (defun vmd-pause (vm)
101 123035ff 2021-05-26 op "Pause the VM at point."
102 56142b9f 2021-05-26 op (interactive (list (vmd--vm-at-point)) vmd-mode)
103 56142b9f 2021-05-26 op (vmd--vmctl "pause" vm)
104 56142b9f 2021-05-26 op (vmd--update-table))
106 56142b9f 2021-05-26 op (defun vmd-start (vm)
107 123035ff 2021-05-26 op "Start the VM at point."
108 56142b9f 2021-05-26 op (interactive (list (vmd--vm-at-point)) vmd-mode)
109 56142b9f 2021-05-26 op (vmd--vmctl "start" vm)
110 56142b9f 2021-05-26 op (vmd--update-table))
112 56142b9f 2021-05-26 op (defun vmd-stop (vm)
113 123035ff 2021-05-26 op "Stop the VM at point."
114 56142b9f 2021-05-26 op (interactive (list (vmd--vm-at-point)) vmd-mode)
115 56142b9f 2021-05-26 op (vmd--vmctl "stop" vm)
116 56142b9f 2021-05-26 op (vmd--update-table))
118 56142b9f 2021-05-26 op (defun vmd-unpause (vm)
119 123035ff 2021-05-26 op "Unpause the VM at point."
120 56142b9f 2021-05-26 op (interactive (list (vmd--vm-at-point)) vmd-mode)
121 56142b9f 2021-05-26 op (vmd--vmctl "unpause" vm)
122 56142b9f 2021-05-26 op (vmd--update-table))
124 56142b9f 2021-05-26 op (transient-define-prefix vmd--transient ()
127 56142b9f 2021-05-26 op [("c" "console" vmd-console)
128 56142b9f 2021-05-26 op ("P" "pause" vmd-pause)
129 56142b9f 2021-05-26 op ("s" "start" vmd-start)
130 56142b9f 2021-05-26 op ("S" "stop" vmd-stop)
131 56142b9f 2021-05-26 op ("u" "unpause" vmd-unpause)]])
133 56142b9f 2021-05-26 op (defvar vmd-mode-map
134 56142b9f 2021-05-26 op (let ((m (make-sparse-keymap)))
135 56142b9f 2021-05-26 op (define-key m (kbd "c") #'vmd-console)
136 56142b9f 2021-05-26 op (define-key m (kbd "P") #'vmd-pause) ; don't conflict with previous-line
137 56142b9f 2021-05-26 op (define-key m (kbd "s") #'vmd-start)
138 56142b9f 2021-05-26 op (define-key m (kbd "S") #'vmd-stop)
139 56142b9f 2021-05-26 op (define-key m (kbd "u") #'vmd-unpause)
141 56142b9f 2021-05-26 op ;; one transient to rule them all
142 56142b9f 2021-05-26 op (define-key m (kbd "x") #'vmd--transient)
145 56142b9f 2021-05-26 op (define-derived-mode vmd-mode tabulated-list-mode "vmd"
147 56142b9f 2021-05-26 op (vmd--update-table)
148 56142b9f 2021-05-26 op (add-hook 'tabulated-list-revert-hook #'vmd--update-table nil t))
150 56142b9f 2021-05-26 op (defun vmd ()
152 56142b9f 2021-05-26 op (interactive)
153 56142b9f 2021-05-26 op (switch-to-buffer "*vmd*")
156 56142b9f 2021-05-26 op (provide 'vmd)
157 56142b9f 2021-05-26 op ;;; vmd.el ends here
