commit 56142b9f5181543f7d2ac1ab314fb4f8da9c7491
from: Omar Polo <op@omarpolo.com>
date: Wed May 26 13:52:42 2021 UTC

initial commit

commit - /dev/null
commit + 56142b9f5181543f7d2ac1ab314fb4f8da9c7491
blob - /dev/null
blob + 98368893706ebf55280e6d7399adac5e1e2fb621 (mode 644)
--- /dev/null
+++ README.md
@@ -0,0 +1,6 @@
+# vmd.el
+
+vmd is an Emacs package to interact with [OpenBSD' vmd][vmd].
+
+
+[vmd]: http://man.openbsd.org/vmd
blob - /dev/null
blob + 0bf8d6dba7222606507655c16bbd34c17362b1b8 (mode 644)
--- /dev/null
+++ vmd.el
@@ -0,0 +1,156 @@
+;;; vmd.el --- vmd interaction mode                  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Omar Polo
+
+;; Author: Omar Polo <op@omarpolo.com>
+;; Keywords: tools
+;; Version: 0.1.0
+;; Package-Requires: ((transient "0.3.4"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; TODO
+
+;;; Code:
+
+(require 'term)
+(require 'transient)
+
+(defgroup vmd nil
+  "Vmd."
+  :prefix "vmd-"
+  :group 'vmd)
+
+(defcustom vmd-vmctl-cmd "vmctl"
+  "Path to the vmctl command to use."
+  :type 'string)
+
+(defcustom vmd-console-function #'vmd-run-in-term
+  "Function to use for the `vmd-console' command.
+It takes two arguments, the string name and the cmd arguments
+list, and should pop a buffer with a terminal running the
+commands in cmd."
+  :type 'function)
+
+(defun vmd-run-in-term (name cmd)
+  "Run CMD inside a term buffer called NAME."
+  (pop-to-buffer (apply #'term-ansi-make-term
+                        (concat "*" name "*")
+                        (car cmd) nil (cdr cmd))))
+
+(defun vmd--update-table ()
+  "Update the `tabulated-list-mode' with the list of virtual machines."
+  (let ((columns [("ID"     3  t)
+                  ("PID"    5  nil)
+                  ("VCPUS"  5  nil)
+                  ("MAXMEM" 6  nil)
+                  ("CURMEM" 6  nil)
+                  ("TTY"    10 t)
+                  ("OWNER"  8  t)
+                  ("STATE"  8  t)
+                  ("NAME"   30 t)])
+        (rows (mapcar (lambda (x) `(,(car x) ,(apply #'vector x)))
+                      (mapcar (lambda (x)
+                                (split-string x nil t))
+                              (cdr
+                               (split-string (shell-command-to-string "vmctl status")
+                                             "\n" t))))))
+    (setq tabulated-list-format columns
+          tabulated-list-entries rows)
+    (tabulated-list-init-header)
+    (tabulated-list-print)))
+
+(defun vmd--vm-at-point ()
+  "Return the vm name at point."
+  (unless (derived-mode-p 'vmd-mode)
+    (error "Not in vmd-mode"))
+  (let* ((row (tabulated-list-get-entry))
+         (len (length row)))
+    (when (or (null row)
+              (= len 0))
+      (error "No vm at point"))
+    (aref row (1- len))))
+
+(defun vmd--vmctl (&rest args)
+  "Run a vmctl command with ARGS."
+  (shell-command (mapconcat #'shell-quote-argument (cons "vmctl" args) " ")))
+
+(defun vmd-console (vm)
+  "Open a console for the virtual machine VM at point."
+  (interactive (list (vmd--vm-at-point)) vmd-mode)
+  (funcall vmd-console-function
+           (concat "vmd console " vm)
+           (mapcar #'shell-quote-argument
+                   (list vmd-vmctl-cmd "console" vm))))
+
+(defun vmd-pause (vm)
+  "Pause the virtual machine VM at point."
+  (interactive (list (vmd--vm-at-point)) vmd-mode)
+  (vmd--vmctl "pause" vm)
+  (vmd--update-table))
+
+(defun vmd-start (vm)
+  "Start the virtual machine VM at point."
+  (interactive (list (vmd--vm-at-point)) vmd-mode)
+  (vmd--vmctl "start" vm)
+  (vmd--update-table))
+
+(defun vmd-stop (vm)
+  "Stop the virtual machine VM at point."
+  (interactive (list (vmd--vm-at-point)) vmd-mode)
+  (vmd--vmctl "stop" vm)
+  (vmd--update-table))
+
+(defun vmd-unpause (vm)
+  "Unpause the virtual machine VM at point."
+  (interactive (list (vmd--vm-at-point)) vmd-mode)
+  (vmd--vmctl "unpause" vm)
+  (vmd--update-table))
+
+(transient-define-prefix vmd--transient ()
+  "Vmd."
+  ["Action"
+   [("c" "console"    vmd-console)
+    ("P" "pause"      vmd-pause)
+    ("s" "start"      vmd-start)
+    ("S" "stop"       vmd-stop)
+    ("u" "unpause"    vmd-unpause)]])
+
+(defvar vmd-mode-map
+  (let ((m (make-sparse-keymap)))
+    (define-key m (kbd "c") #'vmd-console)
+    (define-key m (kbd "P") #'vmd-pause) ; don't conflict with previous-line
+    (define-key m (kbd "s") #'vmd-start)
+    (define-key m (kbd "S") #'vmd-stop)
+    (define-key m (kbd "u") #'vmd-unpause)
+
+    ;; one transient to rule them all
+    (define-key m (kbd "x") #'vmd--transient)
+    m))
+
+(define-derived-mode vmd-mode tabulated-list-mode "vmd"
+  "Vmd mode."
+  (vmd--update-table)
+  (add-hook 'tabulated-list-revert-hook #'vmd--update-table nil t))
+
+(defun vmd ()
+  "Start vmd."
+  (interactive)
+  (switch-to-buffer "*vmd*")
+  (vmd-mode))
+
+(provide 'vmd)
+;;; vmd.el ends here