elisp: Implement basics of protocol

Dialog is working, answers get sent to subprocess. Only string prompot
implemented yet.

elisp/jx.el

@@ -4,21 +4,125 @@
 
 (require 'stdio)
 
-(defun jx-test ()
-  "Test the jx stuff."
+(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 "jx-test: %s" line)))))
+      (message (format "stdio-line: %s" line)))))
 
-(defun jx-text-json ()
-  "test the jx json input."
+(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 "jx-json-object: %s" object)))))
+      (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

elisp/stdio.el

@@ -27,13 +27,16 @@
 (defun stdio-call (command)
   "Call COMMAND, return stdio-process."
   (let* ((process (stdio-process-create))
+         (process-name (stdio--make-process-name))
          (emacs-process (make-process
-                         :name (stdio--make-process-name)
+                         :name process-name
                          :command command
                          :coding 'utf-8-unix
                          :noquery nil
                          :connection-type 'pipe
                          :filter (stdio-make-filter process)
+                         :stderr (get-buffer-create
+                                  (format "*%s stderr*" process-name))
                          )))
     (setf (stdio-process-emacs-process process) emacs-process)
     process))
@@ -75,5 +78,15 @@ Json elements need to be seperated by newlines."
                      json-object)))
     json-object))
 
+(defun stdio-quit (process)
+  "Kill the subprocess PROCESS."
+  (delete-process (stdio-process-emacs-process process)))
+
+(defun stdio-write-line (process string)
+  "Write STRING to PROCESS, ensure it ends with a newline character."
+  (let ((line (string-trim-right string "\r?\n?"))
+        (emacs-process (stdio-process-emacs-process process)))
+    (process-send-string emacs-process (concat line "\n"))))
+
 (provide 'stdio)
 ;;; stdio.el ends here