Michael Volz
94dab46a38
Dialog is working, answers get sent to subprocess. Only string prompot implemented yet.
128 lines
4.2 KiB
EmacsLisp
128 lines
4.2 KiB
EmacsLisp
;;; jx.el -- JsonInteractiveExperience for emacs -*- lexical-binding: t; -*-
|
|
;;; Commentary:
|
|
;;; Code:
|
|
|
|
(require 'stdio)
|
|
|
|
(defun stdio-test ()
|
|
"Test stdio line based input."
|
|
(interactive)
|
|
(let ((process (stdio-call (list "cat" "testfile"))))
|
|
(while-let ((line (stdio-read-line process)))
|
|
(message (format "stdio-line: %s" line)))))
|
|
|
|
(defun stdio-test-json ()
|
|
"Test the stdio json input."
|
|
(interactive)
|
|
(let ((process (stdio-call (list "cat" "json-test"))))
|
|
(while-let ((object (stdio-read-json process
|
|
:object-type 'plist
|
|
:array-type 'list)))
|
|
(message (format "stdio-json-object: %s" object)))))
|
|
|
|
(cl-defstruct (jx-message (:constructor jx-message--create)
|
|
(:copier jx-message-copy))
|
|
"A message according to JX protocoll."
|
|
(raw nil :documentation "The raw object returned by the json decoder."))
|
|
|
|
(defun jx-message-create (json-object)
|
|
"Create a new jx-message struct from json object JSON-OBJECT."
|
|
(unless json-object
|
|
(error "Cannot create jx-message from nil object"))
|
|
(jx-message--create :raw json-object))
|
|
|
|
(defun jx-message-get (message key)
|
|
"Get the value of KEY from the json MESSAGE."
|
|
(cl-assert (jx-message-p message))
|
|
(gethash key (jx-message-raw message)))
|
|
|
|
(defun jx-message-success-p (message)
|
|
"Check if MESSAGE is a success command."
|
|
(and (jx-message-p message)
|
|
(string-equal (jx-message-get message "command")
|
|
"success")))
|
|
|
|
(defun jx-message-prompt-p (message)
|
|
"Check if MESSAGE is a prompt command."
|
|
(and (jx-message-p message)
|
|
(string-equal (jx-message-get message "command")
|
|
"prompt")))
|
|
|
|
(defun jx-message-prompt-type (message)
|
|
"Return the type of prompt in MESSAGE."
|
|
(and (jx-message-prompt-p message)
|
|
(jx-message-get message "type")))
|
|
|
|
(defun jx-message-prompt (message)
|
|
"Return the prompt in the jx MESSAGE object."
|
|
(cl-assert (jx-message-prompt-p message))
|
|
(jx-message-get message "prompt"))
|
|
|
|
(defun jx-handle-prompt (message)
|
|
"Execute the 'prompt' call in MESSAGE.
|
|
|
|
Returns a jx answer struct to be sent back to the external
|
|
process."
|
|
(pcase (jx-message-prompt-type message)
|
|
("string"
|
|
(jx-prompt-for-string message))))
|
|
|
|
(defun jx-prompt-for-string (message)
|
|
"Execute the prompt for a string in MESSAGE."
|
|
(message "jx-prompt-for-string start")
|
|
(let* ((prompt (jx-message-prompt message))
|
|
(answer (read-from-minibuffer prompt)))
|
|
(message "jx-prompt-for-string %s" prompt)
|
|
(jx-construct-answer answer)))
|
|
|
|
(defun jx-construct-answer (answer)
|
|
"Return a jx answer object with ANSWER as the user's choice."
|
|
(list :status "success" :answer answer))
|
|
|
|
(defun jx-read-message (process)
|
|
"Read next message object from stdio PROCESS."
|
|
(when-let ((raw (stdio-read-json process)))
|
|
(message "jx-read-message: %s" raw)
|
|
(jx-message-create raw)))
|
|
|
|
(defun jx-exec-dialog (process)
|
|
"Execute the jx protocol dialog with PROCESS.
|
|
|
|
Returns 't', if dialog succeeds and 'nil', if PROCESS exits
|
|
without explicit success message.
|
|
|
|
Will signal errors upon invalid messages or invalid user
|
|
interactions during dialog."
|
|
(let (success)
|
|
(message "jx-exec-dialog before loop")
|
|
(while-let ((message (jx-read-message process))
|
|
(_ (not success)))
|
|
(message "jx-exec-dialog in loop: %s" message)
|
|
(pcase message
|
|
((pred jx-message-prompt-p)
|
|
(let ((res (jx-handle-prompt message)))
|
|
(jx-answer process res)))
|
|
((pred jx-message-success-p)
|
|
(setq success t)
|
|
(jx-quit process))
|
|
(_ (error "Unknown jx message"))))
|
|
success))
|
|
|
|
(defun jx-call-python ()
|
|
"Call external python script to test jx routines."
|
|
(interactive)
|
|
(let ((process (stdio-call (list "/home/michl/code/EmacsInteractiveJson/elisp/test-jx.py"))))
|
|
(unless (jx-exec-dialog process)
|
|
(error "Process exited prematurely, action not completed"))))
|
|
|
|
(defun jx-answer (process answer)
|
|
"Send ANSWER to PROCESS as result of last command."
|
|
(stdio-write-line process (json-encode answer)))
|
|
|
|
(defun jx-quit (process)
|
|
"Quit the dialog and associated subprocess PROCESS."
|
|
(message "jx-quit")
|
|
(stdio-quit process))
|
|
|
|
(provide 'jx)
|
|
;;; jx.el ends here
|