- [RPC] added function to close server;

- [JSON-RPC] allowed API to signal a custom 'jsonrpc-error'.

src/gui/server/json-rpc-communication.lisp

@@ -103,7 +103,7 @@
   (finish-output *server-stream*))
 
 (defun close-server ()
-  (send-to-server +command-delimiter+))
+  (send-to-server (rpc:encode-to-string (rpc:make-request "quit-program" 1))))
 
 (defun start-client ()
   (with-output-to-string (stream)

src/gui/server/public-api.lisp

@@ -360,6 +360,12 @@
 (defun clear-tour ()
   (clear-tour-link *gemini-window*))
 
+(defun quit-program ()
+  (fs:clean-temporary-directories)
+  (fs:clean-temporary-files)
+  (db-utils:close-db)
+  (os-utils:exit-program))
+
 (defmacro prepare-rpc (&body body)
   `(let ((rpc:*function-db* '()))
      (gen-rpc "add"
@@ -401,5 +407,6 @@
      (gen-rpc "tour-delete-link"
               'tour-delete-link
               "url" 0)
-     (gen-rpc "clear-tour" 'clear-tour)
+     (gen-rpc "clear-tour"   'clear-tour)
+     (gen-rpc "quit-program" 'quit-program)
      ,@body))

src/json-rpc2.lisp

@@ -122,6 +122,11 @@
              (format stream "~a" (text condition))))
   (:documentation "Error for all jsonrpc related problems"))
 
+(defmacro make-json-rpc-error (code message)
+  `(progn
+     (assert (< -32000 code -32099))
+     (error 'json-rpc-error  :text ,message :code ,code)))
+
 (defparameter *function-db* '())
 
 (defun make-fun-params (name position)
@@ -409,10 +414,11 @@
   (misc:dbg m))
 
 (defun elaborate-single-request (request)
-  (flet ((make-rpc-error (e)
+  (flet ((make-rpc-error (e id)
            (maybe-log-message (format nil "jsonrpc request failed: ~a" e))
            (make-response nil
-                          (transaction-id e)
+                          (or (transaction-id e)
+                              id)
                           :error-object (make-response-error (or (code e)
                                                                  (response-error-code +error-invalid-request+))
                                                              (text e))))
@@ -433,18 +439,21 @@
         (handler-case
             (let* ((request      (apply #'make-request method id params))
                    (elaborated   (call-function request)))
-              (maybe-log-message (format nil "jsonrpc request ~s results ~s" request elaborated))
+              (maybe-log-message (format nil
+                                         "jsonrpc request ~s results ~s"
+                                         request
+                                         elaborated))
               (when id
                 ;; if id is null is  a notification (i.e. the client
                 ;; does not care about an answer)
                 (make-response elaborated id :error-object nil)))
           (json-rpc-error (e)
-            (make-rpc-error e))
+            (make-rpc-error e id))
           (error (e)
             (maybe-log-message (format nil "jsonrpc request failed: ~a" e))
             (make-failed-function-error e id nil))))
     (json-rpc-error (e)
-      (make-rpc-error e))
+      (make-rpc-error e nil))
     (error (e)
       (maybe-log-message (format nil "jsonrpc request failed with internal error!: ~a" e))
       (make-internal-error e)))))

src/package.lisp

@@ -3158,6 +3158,7 @@
    :make-response
    :encode-to-string
    :json-rpc-error
+   :make-rpc-error
    :elaborate-request
    :transaction-id
    :code