- [RPC] added representation of the main gemini window in the server;

- [RPC] added two IRI's history manipulation functions.

src/gemini-viewer-metadata.lisp

@@ -53,7 +53,7 @@
            (new-history  (misc:safe-all-but-last-elt  history)))
       (setf (gemini-metadata-history metadata)
             new-history)
-      history)))
+     (misc:safe-last-elt history))))
 
 (defun maybe-initialize-metadata (window)
   (when (not (gemini-metadata-p (message-window:metadata window)))
@@ -61,8 +61,8 @@
           (make-gemini-metadata)))
   (message-window:metadata window))
 
-(defun current-gemini-url ()
+(defun current-gemini-url (&optional (window specials:*message-window*))
-  (when (message-window:gemini-window-p)
+  (when (message-window:gemini-window-p window)
     (when-let* ((metadata (message-window:metadata specials:*message-window*))
                 (history  (gemini-viewer:gemini-metadata-history metadata))
                 (link     (last-elt  history)))

src/gui/json-rpc-communication.lisp

@@ -57,6 +57,7 @@
   (os-utils:exit-program))
 
 (defun start-server ()
+  (init-gemini-window)
   (prepare-rpc
     (loop while (not *stop-server*) do
       (handler-case
@@ -129,6 +130,14 @@
                 (format t "sending ~a~%" request)
                 (send-to-server request)
                 (format t "returned ~s~%" (read-from-server))))
+            (loop repeat 2 do
+              (let ((request (rpc:encode-to-string (rpc:make-request "gemini-request"
+                                                                     1
+                                                                     (strcat test-iri "/~cage/")
+                                                                     t))))
+                (format t "sending ~a~%" request)
+                (send-to-server request)
+                (format t "returned ~s~%" (read-from-server))))
             (sleep 3)
             (let ((info-request (rpc:encode-to-string (rpc:make-request "gemini-stream-info"
                                                                          1
@@ -152,5 +161,17 @@
               (format t "sending ~a~%" lines-request)
               (send-to-server lines-request)
               (format t "returned ~s~%" (read-from-server)))
+            (let ((all-info-request (rpc:encode-to-string
+                                     (rpc:make-request "gemini-all-stream-info"
+                                                       1))))
+              (format t "sending ~a~%" all-info-request)
+              (send-to-server all-info-request)
+              (format t "returned ~s~%" (read-from-server)))
+            (let ((pop-history-request (rpc:encode-to-string
+                                     (rpc:make-request "gemini-pop-url-from-history"
+                                                       1))))
+              (format t "sending ~a~%" pop-history-request)
+              (send-to-server pop-history-request)
+              (format t "returned ~s~%" (read-from-server)))
             (close-server))
           (error (_ "Unable to create server process"))))))

src/gui/main-window-server-side.lisp

@@ -0,0 +1,46 @@
+;; tinmop: an humble gemini and pleroma client
+;; Copyright (C) 2023  cage
+
+;; 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 [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
+
+(in-package :json-rpc-communication)
+
+(defclass gemini-window ()
+  ((metadata
+    :initform nil
+    :initarg  :metadata
+    :accessor metadata)))
+
+(defparameter *gemini-window* nil)
+
+(defmethod message-window:metadata ((object gemini-window))
+  (slot-value object 'metadata))
+
+(defmethod (setf message-window:metadata) (value (object gemini-window))
+  (setf (slot-value object 'metadata) value))
+
+(defun init-gemini-window ()
+  (setf *gemini-window*
+        (make-instance 'gemini-window))
+  (gw:maybe-initialize-metadata *gemini-window*))
+
+(defmethod gemini-window-p ((win gemini-window))
+  t)
+
+(defun gemini-current-url ()
+  (gw:current-gemini-url *gemini-window*))
+
+(defun gemini-pop-url-from-history ()
+  (gw:pop-url-from-history *gemini-window*))

src/gui/public-api.lisp

@@ -70,6 +70,7 @@
       (cond
         ((gemini-client:gemini-file-stream-p meta)
          (gemini-client:debug-gemini "response is a gemini document stream")
+         (gemini-viewer:push-url-to-history *gemini-window* actual-iri)
          (make-text-based-stream t)
          (make-gemini-response gemini-client:+success+ meta actual-iri))
         ((gemini-client:text-file-stream-p meta)
@@ -161,6 +162,7 @@
                   (if (gemini-viewer:find-db-stream-url actual-iri)
                       (progn
                         (gemini-client:debug-gemini  "caching found for ~a" actual-iri)
+                        (gemini-viewer:push-url-to-history *gemini-window* actual-iri)
                         (make-gemini-response gemini-client:+success+ nil
                                               actual-iri
                                               :cached t))
@@ -226,7 +228,6 @@
                    (fragment                 gw:fragment)
                    (host                     gw:host)) object
     (let* ((actual-start-time   (db-utils:decode-datetime-string start-time))
-           (actual-parsed-lines (rearrange-parsed-line-for-encoding parsed-lines))
            (info-alist          (list (cons "stream-status"           stream-status)
                                       (cons "download-iri"            download-iri)
                                       (cons "start-time"              actual-start-time)
@@ -342,6 +343,8 @@
               "iri" 0
               "line-number-start" 1
               "line-number-end"   2)
-     (gen-rpc "gemini-all-stream-info"
+     (gen-rpc "gemini-all-stream-info"      'gemini-all-stream-info)
-              'gemini-all-stream-info)
+     (gen-rpc "gemini-current-url"          'gemini-current-url)
+     (gen-rpc "gemini-pop-url-from-history" 'gemini-pop-url-from-history)
+
      ,@body))

src/message-window.lisp

@@ -74,8 +74,10 @@
 (defun gemini-window-p* (window)
   (display-gemini-text-p window))
 
-(defun gemini-window-p ()
+(defgeneric gemini-window-p (win))
-  (gemini-window-p* specials:*message-window*))
+
+(defmethod gemini-window-p ((win message-window))
+  (gemini-window-p* win))
 
 (defun display-gemini-text-p (window)
   (eq (keybindings window)

src/package.lisp

@@ -3081,6 +3081,9 @@
                     (:json :yason)
                     (:gw   :gemini-viewer))
   (:export
+   :gemini-window
+   :metadata
+   :init-gemini-window
    :start-server
    :start-client))
 

src/ui-goodies.lisp

@@ -687,7 +687,7 @@ along the focused window."
                      *message-window*
                      :documentation      "Move focus on message window"
                      :info-change-focus-message
-                     (if (message-window:gemini-window-p)
+                     (if (message-window:gemini-window-p *message-window*)
                          (_ "Focus passed on gemini stream window")
                          (_ "Focus passed on message window")))
 
@@ -2800,7 +2800,7 @@ gemini page the program is rendering."
 
 (defun bookmark-gemini-page ()
   (cond
-    ((not (message-window:gemini-window-p))
+    ((not (message-window:gemini-window-p specials:*message-window*))
      (error-message (_ "The window is not displaying a gemini document")))
     ((not (gemini-viewer:current-gemini-url))
      (error-message (_ "This page can not be added to bookmarks")))

tinmop.asd

@@ -147,7 +147,8 @@
                (:file "modules")
                (:file "json-rpc2")
                (:module gui
-                :components ((:file "public-api")
+                :components ((:file "main-window-server-side")
+                             (:file "public-api")
                              (:file "json-rpc-communication")))
                (:file "main")
                (:module tests