From 045819b4a43efac6e482457c4f6a673897c70301 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 15 Jan 2023 15:54:49 +0100 Subject: [PATCH] - [RPC] added API for generate the TOC from a gemtext; - removed duplicated code (used the class 'box:box' instead of struct 'json-rpc-communication:box). --- src/gui/server/json-rpc-communication.lisp | 13 ++- .../public-api-gemini-certificates.lisp | 6 +- src/gui/server/public-api-gemini-stream.lisp | 82 ++++++++++++++++++- src/gui/server/public-api-structs.lisp | 21 ----- src/gui/server/public-api.lisp | 6 +- src/message-window.lisp | 63 +++++++++----- src/package.lisp | 2 + tinmop.asd | 1 - 8 files changed, 133 insertions(+), 61 deletions(-) delete mode 100644 src/gui/server/public-api-structs.lisp diff --git a/src/gui/server/json-rpc-communication.lisp b/src/gui/server/json-rpc-communication.lisp index ab2b115..e4deb23 100644 --- a/src/gui/server/json-rpc-communication.lisp +++ b/src/gui/server/json-rpc-communication.lisp @@ -130,14 +130,6 @@ (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 @@ -176,5 +168,10 @@ (format t "sending ~a~%" certificates) (send-to-server certificates) (format t "returned ~s~%" (read-from-server))) + (let ((toc (rpc:encode-to-string + (rpc:make-request "gemini-toc" 1 test-iri)))) + (format t "sending ~a~%" toc) + (send-to-server toc) + (format t "returned ~s~%" (read-from-server))) (close-server)) (error (_ "Unable to create server process")))))) diff --git a/src/gui/server/public-api-gemini-certificates.lisp b/src/gui/server/public-api-gemini-certificates.lisp index ca09eda..4f470ad 100644 --- a/src/gui/server/public-api-gemini-certificates.lisp +++ b/src/gui/server/public-api-gemini-certificates.lisp @@ -17,7 +17,7 @@ (in-package :json-rpc-communication) -(defstruct (gemini-certificates (:include box))) +(defclass gemini-certificates (box) ()) (defmethod yason:encode ((object gemini-certificates) &optional (stream *standard-output*)) (let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase) @@ -25,11 +25,11 @@ (json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase)) (yason:with-output (stream) (yason:with-array () - (loop for certificate in (gemini-certificates-payload object) do + (loop for certificate in (unbox object) do (yason:encode-array-element certificate)))))) (defun gemini-certificates () - (make-gemini-certificates :payload (db:find-tls-certificates-rows))) + (make-instance 'gemini-certificates :contents (db:find-tls-certificates-rows))) (defun invalidate-cached-value (cache-key) (db:cache-invalidate cache-key) diff --git a/src/gui/server/public-api-gemini-stream.lisp b/src/gui/server/public-api-gemini-stream.lisp index af04cb4..217c20d 100644 --- a/src/gui/server/public-api-gemini-stream.lisp +++ b/src/gui/server/public-api-gemini-stream.lisp @@ -262,7 +262,7 @@ line-number))))) (first res)))))))) -(defstruct (parsed-lines-slice (:include box))) +(defclass parsed-lines-slice (box) ()) (defmethod yason:encode ((object parsed-lines-slice) &optional (stream *standard-output*)) (let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase) @@ -270,7 +270,7 @@ (json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase)) (yason:with-output (stream) (json:with-array () - (loop for parsed-line in (parsed-lines-slice-payload object) do + (loop for parsed-line in (unbox object) do (json:encode-array-element parsed-line)))))) (defun gemini-stream-parsed-line-slice (iri line-number-start line-number-end) @@ -298,7 +298,7 @@ (let ((res (rearrange-parsed-line-for-encoding (subseq parsed-lines line-number-start line-number-end)))) - (make-parsed-lines-slice :payload res)))))))) + (make-instance 'parsed-lines-slice :contents res)))))))) (defun gemini-stream-info (iri) (let ((stream-wrapper (gw:find-db-stream-url iri))) @@ -308,3 +308,79 @@ (defun gemini-all-stream-info () gw:*gemini-streams-db*) + +(defun build-gemini-toc (iri) + (a:when-let* ((ordered-headers-tag '(:h1 :h2 :h3)) + (stream-wrapper (gw:find-db-stream-url iri)) + (parsed-lines (gw:parsed-lines stream-wrapper)) + (headers (remove-if-not (lambda (a) (member (html-utils:tag a) + ordered-headers-tag)) + parsed-lines))) + (flet ((extract-level (header) + (let ((tag (html-utils:tag header))) + (1+ (position tag ordered-headers-tag)))) + (extract-gid (header) + (let ((attribute (html-utils:find-attribute :header-group-id header))) + (html-utils:attribute-value attribute))) + (extract-header-text (header) + (first (html-utils:children header))) + (find-longest-string (text-list) + (reduce (lambda (a b) + (if (>= (length a) (length b)) + a + b)) + text-list))) + (a:when-let* ((toc (message-window:gemini-sexp->toc-plist headers + #'identity + #'extract-level + #'extract-gid + #'extract-header-text)) + (toc-text (mapcar (lambda (a) (getf a :header)) toc)) + (longest-text (find-longest-string toc-text)) + (max-text-length (length longest-text)) + (toc-numbers (mapcar (lambda (a) + (let ((numbers-as-text + (mapcar (lambda (a) + (format nil "~a" a)) + (getf a :number)))) + (join-with-strings numbers-as-text "."))) + toc)) + (longest-number (find-longest-string toc-numbers)) + (max-number-length (length longest-number)) + (max-non-padded-text-size (+ max-text-length max-number-length)) + (toc-entries-text (loop for text in toc-text + for number in toc-numbers + collect + (let* ((text-length (+ (length text) + (length number))) + (padding-size (- max-non-padded-text-size + text-length)) + (padding (make-string padding-size + :initial-element (swconf:gemini-toc-padding-char)))) + (strcat number + padding + text))))) + (values + (loop for toc-entry in toc + for text in toc-entries-text + collect + (list :header-group-id (getf toc-entry :group-id) + :text text)) + toc))))) + +(defclass gemini-toc (box) ()) + +(defun encode-flat-array-of-plists (list stream) + (let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase) + (yason:*list-encoder* #'yason:encode-plist) + (json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase)) + (yason:with-output (stream) + (json:with-array () + (loop for element in list do + (json:encode-array-element element)))))) + +(defun gemini-table-of-contents (iri) + (make-instance 'gemini-toc :contents (build-gemini-toc iri))) + +(defmethod yason:encode ((object gemini-toc) &optional (stream *standard-output*)) + (encode-flat-array-of-plists (unbox object) stream)) diff --git a/src/gui/server/public-api-structs.lisp b/src/gui/server/public-api-structs.lisp deleted file mode 100644 index 7523b46..0000000 --- a/src/gui/server/public-api-structs.lisp +++ /dev/null @@ -1,21 +0,0 @@ -;; tinmop: an humble gemini and pleroma client -;; Copyright (C) 2022 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) - -(defstruct box - (payload)) diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp index d1f8185..4c3fcda 100644 --- a/src/gui/server/public-api.lisp +++ b/src/gui/server/public-api.lisp @@ -17,9 +17,6 @@ (in-package :json-rpc-communication) -(defstruct box - (payload)) - (defun make-rpc-parameters (&rest params) (loop for (a b) on params by 'cddr collect (cons a b))) @@ -66,6 +63,9 @@ (gen-rpc "gemini-delete-certificate" 'gemini-delete-certificate "cache-key" 0) + (gen-rpc "gemini-toc" + 'gemini-table-of-contents + "iri" 0) (gen-rpc "tour-shuffle" 'tour-shuffle) (gen-rpc "tour-add-link" 'tour-add-link diff --git a/src/message-window.lisp b/src/message-window.lisp index 669d9ba..64b9d0b 100644 --- a/src/message-window.lisp +++ b/src/message-window.lisp @@ -66,7 +66,7 @@ (defgeneric viewport-width (object)) -(defgeneric generate-toc (object)) +(defgeneric generate-gemini-toc (object)) (defun gemini-window-p* (window) (display-gemini-text-p window)) @@ -695,31 +695,50 @@ (row-move object line-found) (draw object))) + +(defun gemini-sexp->toc-plist (all-headers + extract-header-fn + extract-level-fn + extract-gid-fn + extract-header-line-fn) + (let* ((toc-number (make-list gemini-parser:+max-header-level+ :initial-element 0)) + (current-gid -1) + (toc (loop for row in all-headers + collect + (let* ((header (funcall extract-header-fn row)) + (level (funcall extract-level-fn header)) + (gid (funcall extract-gid-fn header))) + (when (/= gid current-gid) + (setf current-gid gid) + (incf (elt toc-number (1- level))) + (loop for i from level below (length toc-number) do + (setf (elt toc-number i) 0)) + (loop for i from (- level 2 ) downto 0 + when (= (elt toc-number i) 0) do + (setf (elt toc-number i) 1)) + (list :header (funcall extract-header-line-fn header) + :group-id gid + :number (subseq toc-number + 0 + level))))))) + (remove-if #'null toc))) + (defmethod generate-gemini-toc ((object message-window)) - (let* ((toc-number (make-list gemini-parser:+max-header-level+ :initial-element 0)) - (current-gid -1) - (all-headers (remove-if-not (lambda (a) + (let* ((all-headers (remove-if-not (lambda (a) (typep (row-get-original-object a) 'gemini-parser:header-line)) (rows object))) - (toc (loop for row in all-headers - collect - (let* ((header (row-get-original-object row)) - (level (gemini-parser:level header)) - (gid (gemini-parser:group-id header))) - (when (/= gid current-gid) - (setf current-gid gid) - (incf (elt toc-number (1- level))) - (loop for i from level below (length toc-number) do - (setf (elt toc-number i) 0)) - (loop for i from (- level 2 ) downto 0 - when (= (elt toc-number i) 0) do - (setf (elt toc-number i) 1)) - (list :header (first (gemini-parser:lines header)) - :group-id gid - :number (subseq toc-number - 0 - level))))))) + (toc (gemini-sexp->toc-plist all-headers + #'row-get-original-object + #'gemini-parser:level + #'gemini-parser:group-id + (lambda (header) + ;; just the first line + ;; contains the header + ;; text the second + ;; contains the + ;; underline + (first (gemini-parser:lines header)))))) (remove-if #'null toc))) (defun gemini-toc-header (fields) diff --git a/src/package.lisp b/src/package.lisp index 4fac355..28e90ea 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2401,6 +2401,7 @@ :scroll-previous-page :search-regex :jump-to-group-id + :gemini-sexp->toc-plist :generate-gemini-toc :gemini-toc-entry :gemini-toc-group-id @@ -3182,6 +3183,7 @@ :cl :config :constants + :box :text-utils :misc-utils) (:local-nicknames (:re :cl-ppcre) diff --git a/tinmop.asd b/tinmop.asd index 2929988..63a642d 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -149,7 +149,6 @@ (:module gui-server :pathname "gui/server" :components ((:file "main-window-server-side") - (:file "public-api-structs") (:file "public-api-gemini-stream") (:file "public-api-gemini-certificates") (:file "public-api-gemini-tour-links")