Remote control protocol

1 files changed, 88 insertions, 0 deletions

diff --git a/lisp/kitty-remote-control.el b/lisp/kitty-remote-control.el
new file mode 100644
index 0000000..a5c988a
--- /dev/null
+++ b/lisp/kitty-remote-control.el
@@ -0,0 +1,88 @@
+;;; kitty-remote-control.el --- Kitty remote control  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Ravi Kiran
+
+;; Author: Ravi Kiran <aine.marina@gmail.com>
+;; Keywords: terminals
+
+;; 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:
+
+;; Remote control of kitty terminals
+
+;;; Code:
+
+(require 'json)
+(require 'subr-x)
+
+(defconst kitty-rc-min-version [0 19 3] "Minimum kitty version used in commands")
+(defconst kitty-rc-command-prefix "\eP@kitty-cmd")
+(defconst kitty-rc-command-suffix "\e\\")
+
+(defun kitty-rc--construct-command-string (command payload min-version response)
+  (concat
+   kitty-rc-command-prefix
+   (json-encode `(("cmd" . ,command)
+                  ("version" . ,(or min-version kitty-rc-min-version))
+                  ("no_response" . ,(not response))
+                  ,@(and payload `(("payload" . ,payload)))))
+   kitty-rc-command-suffix))
+
+(defun kitty-rc--remote-control-response ()
+  (let ((str "")
+        prev-chr
+        chr
+        parsed
+        payload)
+    ;; The reply should be: \eP@kitty-cmd{"ok": true, "data": payload}\e\\
+    (while (and (setq chr (xterm--read-event-for-query))
+                (not (and (equal prev-chr ?\e) (equal chr ?\\))))
+      (when prev-chr (setq str (concat str (string prev-chr))))
+      (setq prev-chr chr))
+    (setq parsed-data (json-parse-string str))
+    (when (and (hash-table-p parsed-data) (eql (gethash "ok" parsed-data) t))
+      (setq payload (gethash "data" parsed-data)))
+    payload))
+
+(defun kitty-rc-posted-command (command payload &optional min-version)
+  (send-string-to-terminal
+   (kitty-rc--construct-command-string command payload min-version nil)))
+
+(defun kitty-rc-command (command payload handler &optional min-version)
+  (xterm--query (kitty-rc--construct-command-string command payload min-version t)
+                (list (cons kitty-rc-command-prefix
+                            (lambda ()
+                              (if-let* ((kitty-response (kitty-rc--remote-control-response))
+                                        (response-json (json-parse-string kitty-response)))
+                                  (funcall handler response-json)
+                                (user-error "Kitty response failed")))))))
+
+;; Applied commands
+(defun kitty-rc-new-window (&optional os)
+  "New kitty window (default OS, kitty if KITTY-WIN is non-nil)"
+  (interactive "P")
+  (kitty-rc-posted-command "new-window" `(("window_type" . ,(if os "os" "kitty")))))
+(defun kitty-rc-focus-window (window-id)
+  "Focus kitty window with id WINDOW-ID"
+  (interactive "N")
+  (kitty-rc-posted-command "focus-window" `(("match" . ,(format "id:%d" window-id)))))
+(defun kitty-rc-launch-background (cmd)
+  "Launch CMD (must be a vector) in kitty's background"
+  (kitty-rc-posted-command "launch"
+                           `(("type" . "background")
+                             ("args" . ,cmd))))
+
+(provide 'kitty-remote-control)
+;;; kitty-remote-control.el ends here