From 746b2e01ac52be2bc6b6e8adbcb15ccb7061b8b4 Mon Sep 17 00:00:00 2001 From: cage Date: Fri, 6 Jan 2023 13:50:33 +0100 Subject: [PATCH] - [RPC] added representation of the main gemini window in the server; - [RPC] added two IRI's history manipulation functions. --- src/gemini-viewer-metadata.lisp | 6 ++-- src/gui/json-rpc-communication.lisp | 21 +++++++++++++ src/gui/main-window-server-side.lisp | 46 ++++++++++++++++++++++++++++ src/gui/public-api.lisp | 9 ++++-- src/message-window.lisp | 6 ++-- src/package.lisp | 3 ++ src/ui-goodies.lisp | 4 +-- tinmop.asd | 3 +- 8 files changed, 87 insertions(+), 11 deletions(-) create mode 100644 src/gui/main-window-server-side.lisp diff --git a/src/gemini-viewer-metadata.lisp b/src/gemini-viewer-metadata.lisp index 09f7cef..eaef276 100644 --- a/src/gemini-viewer-metadata.lisp +++ b/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 () - (when (message-window:gemini-window-p) +(defun current-gemini-url (&optional (window specials:*message-window*)) + (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))) diff --git a/src/gui/json-rpc-communication.lisp b/src/gui/json-rpc-communication.lisp index 49e75bd..b4308fe 100644 --- a/src/gui/json-rpc-communication.lisp +++ b/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")))))) diff --git a/src/gui/main-window-server-side.lisp b/src/gui/main-window-server-side.lisp new file mode 100644 index 0000000..286bade --- /dev/null +++ b/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*)) diff --git a/src/gui/public-api.lisp b/src/gui/public-api.lisp index 80d6ac1..940ce09 100644 --- a/src/gui/public-api.lisp +++ b/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" - 'gemini-all-stream-info) + (gen-rpc "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)) diff --git a/src/message-window.lisp b/src/message-window.lisp index 83fe37a..81b993a 100644 --- a/src/message-window.lisp +++ b/src/message-window.lisp @@ -74,8 +74,10 @@ (defun gemini-window-p* (window) (display-gemini-text-p window)) -(defun gemini-window-p () - (gemini-window-p* specials:*message-window*)) +(defgeneric gemini-window-p (win)) + +(defmethod gemini-window-p ((win message-window)) + (gemini-window-p* win)) (defun display-gemini-text-p (window) (eq (keybindings window) diff --git a/src/package.lisp b/src/package.lisp index 37d03d8..4a92caf 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3081,6 +3081,9 @@ (:json :yason) (:gw :gemini-viewer)) (:export + :gemini-window + :metadata + :init-gemini-window :start-server :start-client)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index a82f826..0ef8f59 100644 --- a/src/ui-goodies.lisp +++ b/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"))) diff --git a/tinmop.asd b/tinmop.asd index b931b45..4a2602e 100644 --- a/tinmop.asd +++ b/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