cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- added group-id property to all gemtext elements.

This commit is contained in:
cage 2021-09-04 14:17:25 +02:00
parent 0aad24a134
commit 3f27420848
3 changed files with 65 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
src/gemini/gemini-parser.lisp
View File

@ -424,10 +424,11 @@
(defun make-pre-end () (defun make-pre-end ()
(make-instance 'pre-end)) (make-instance 'pre-end))
(defclass quoted-lines (with-lines) ()) (defclass quoted-lines (with-group-id with-lines) ())
(defun make-quoted-lines (text-lines) (defun make-quoted-lines (text-lines group-id)
(make-instance 'quoted-lines (make-instance 'quoted-lines
:group-id group-id
:lines (split-lines text-lines))) :lines (split-lines text-lines)))
(defclass pre-line (with-group-id with-pre-group-id with-lines with-alt-text) ()) (defclass pre-line (with-group-id with-pre-group-id with-lines with-alt-text) ())
@ -447,7 +448,7 @@
:pre-group-id pre-group-id :pre-group-id pre-group-id
:alt-text alt-text)) :alt-text alt-text))
(defclass vertical-space () (defclass vertical-space (with-group-id)
((size ((size
:initform 1 :initform 1
:initarg :size :initarg :size
@ -465,13 +466,14 @@
:group-id gid :group-id gid
:level level)) :level level))
(defclass unordered-list-line (with-lines) ()) (defclass unordered-list-line (with-group-id with-lines) ())
(defun make-unordered-list-line (text) (defun make-unordered-list-line (text header-group-id)
(make-instance 'unordered-list-line (make-instance 'unordered-list-line
:group-id header-group-id
:lines (list text))) :lines (list text)))
(defclass link-line () (defclass link-line (with-group-id)
((link-text ((link-text
:initarg :link-text :initarg :link-text
:initform nil :initform nil
@ -485,12 +487,24 @@
:initform nil :initform nil
:accessor link-value))) :accessor link-value)))
(defun make-link-line (link-text link-name link-value) (defun make-link-line (link-text link-name link-value group-id)
(make-instance 'link-line (make-instance 'link-line
:group-id group-id
:link-text link-text :link-text link-text
:link-name link-name :link-name link-name
:link-value link-value)) :link-value link-value))
(defclass simple-line (with-group-id)
((text-line
:initarg :text-line
:initform nil
:accessor text-line)))
(defun make-simple-line (text header-group-id)
(make-instance 'simple-line
:text-line text
:group-id header-group-id))
(defun sexp->text-rows (parsed-gemini theme) (defun sexp->text-rows (parsed-gemini theme)
(let ((win-width (message-window:viewport-width (viewport theme)))) (let ((win-width (message-window:viewport-width (viewport theme))))
(labels ((header-prefix (prefix header) (labels ((header-prefix (prefix header)
@ -542,8 +556,10 @@
(lines (if justified (lines (if justified
(mapcar (lambda (a) (strcat quote-prefix a)) (mapcar (lambda (a) (strcat quote-prefix a))
justified) justified)
quote-prefix))) quote-prefix))
(make-quoted-lines (join-with-strings lines (format nil "~%"))))) (header-group-id (current-header-group-id)))
(make-quoted-lines (join-with-strings lines (format nil "~%"))
header-group-id)))
(pre-alt-text (node) (pre-alt-text (node)
(trim (html-utils:attribute-value (html-utils:find-attribute :alt node)))) (trim (html-utils:attribute-value (html-utils:find-attribute :alt node))))
(build-rows () (build-rows ()
@ -551,20 +567,20 @@
collect collect
(cond (cond
((null node) ((null node)
(make-instance 'vertical-space)) ;(format nil "~%")) (make-instance 'vertical-space
:group-id (current-header-group-id))) ;(format nil "~%"))
((html-utils:tag= :as-is node) ((html-utils:tag= :as-is node)
(let* ((line (text-value node :trim nil)) (let* ((line (text-value node :trim nil))
(fg (preformatted-fg theme)) (fg (preformatted-fg theme))
(line (tui:make-tui-string (format nil (line (tui:make-tui-string (format nil "~a" line)
"~a"
line)
:fgcolor fg))) :fgcolor fg)))
(make-pre-line (list line) (make-pre-line (list line)
(current-header-group-id) (current-header-group-id)
(current-pre-group-id) (current-pre-group-id)
(current-pre-alt-text)))) (current-pre-alt-text))))
((html-utils:tag= :text node) ((html-utils:tag= :text node)
(format nil "~a~%" (text-value node))) (make-simple-line (format nil "~a~%" (text-value node))
(current-header-group-id)))
((html-utils:tag= :h1 node) ((html-utils:tag= :h1 node)
(make-header 1 (make-header 1
(header-prefix-h1 (text-value node)) (header-prefix-h1 (text-value node))
@ -582,7 +598,7 @@
"~a ~a" "~a ~a"
(bullet-prefix theme) (bullet-prefix theme)
(text-value node)))) (text-value node))))
(make-unordered-list-line text))) (make-unordered-list-line text (current-header-group-id))))
((html-utils:tag= :quote node) ((html-utils:tag= :quote node)
(fit-quote-lines (text-value node :trim nil) (fit-quote-lines (text-value node :trim nil)
win-width)) win-width))
@ -602,8 +618,9 @@
node))) node)))
(link-text (if link-name (link-text (if link-name
(linkify link-name link-value) (linkify link-name link-value)
(linkify link-value link-value)))) (linkify link-value link-value)))
(make-link-line link-text link-name link-value))))))) (header-group-id (current-header-group-id)))
(make-link-line link-text link-name link-value header-group-id)))))))
(flatten (build-rows))))) (flatten (build-rows)))))
(defun parse-gemini-file (data) (defun parse-gemini-file (data)

2
src/gemini/package.lisp
View File

@ -87,6 +87,8 @@
:unordered-list-line :unordered-list-line
:link-line :link-line
:link-text :link-text
:simple-line
:text-line
:sexp->text-rows :sexp->text-rows
:sexp->text :sexp->text
:parse-gemini-response-header :parse-gemini-response-header

32
src/message-window.lisp
View File

@ -246,7 +246,8 @@
:normal-text (make-tui-string (format nil "~%")) :normal-text (make-tui-string (format nil "~%"))
:fields (list +row-vertical-space-field-key+ 1)))) :fields (list +row-vertical-space-field-key+ 1))))
(row-add-original-object res original-object) (row-add-original-object res original-object)
res)) ; even if row-add-original-object returns the modified line explicit returns for clarity (row-add-group-id res (gemini-parser:group-id original-object))
res))
(defun row-vertical-space-p (row) (defun row-vertical-space-p (row)
(getf (fields row) +row-vertical-space-field-key+)) (getf (fields row) +row-vertical-space-field-key+))
@ -375,22 +376,20 @@
(defmethod collect-lines-from-ir ((object gemini-parser:with-lines) (window message-window) (defmethod collect-lines-from-ir ((object gemini-parser:with-lines) (window message-window)
&key &allow-other-keys) &key &allow-other-keys)
(let ((colorized-lines (colorize-lines (%fit-lines window (gemini-parser:lines object))))) (let ((colorized-lines (colorize-lines (%fit-lines window (gemini-parser:lines object)))))
(loop for i in colorized-lines (loop for text in colorized-lines
collect collect
(make-instance 'line (let ((res-line (make-instance 'line
:normal-text i)))) :normal-text text))
(group-id (gemini-parser:group-id object)))
(row-add-original-object res-line object)
(row-add-group-id res-line group-id)
res-line))))
(defmethod text->rendered-lines-rows (window (text gemini-parser:quoted-lines)) (defmethod text->rendered-lines-rows (window (text gemini-parser:quoted-lines))
(collect-lines-from-ir text window)) (collect-lines-from-ir text window))
(defmethod text->rendered-lines-rows (window (text gemini-parser:header-line)) (defmethod text->rendered-lines-rows (window (text gemini-parser:header-line))
(let* ((group-id (gemini-parser:group-id text)) (collect-lines-from-ir text window))
(lines (collect-lines-from-ir text window))
(res (mapcar (lambda (a)
(let ((line (row-add-original-object a text)))
(row-add-group-id line group-id)))
lines)))
res))
(defmethod text->rendered-lines-rows (window (text gemini-parser:unordered-list-line)) (defmethod text->rendered-lines-rows (window (text gemini-parser:unordered-list-line))
(collect-lines-from-ir text window)) (collect-lines-from-ir text window))
@ -398,6 +397,7 @@
(defmethod text->rendered-lines-rows (window (text gemini-parser:link-line)) (defmethod text->rendered-lines-rows (window (text gemini-parser:link-line))
(let ((res (make-instance 'line :normal-text (gemini-parser:link-text text)))) (let ((res (make-instance 'line :normal-text (gemini-parser:link-text text))))
(row-add-original-object res text) (row-add-original-object res text)
(row-add-group-id res (gemini-parser:group-id text))
res)) ; even if row-add-original-object returns the modified line explicit returns for clarity res)) ; even if row-add-original-object returns the modified line explicit returns for clarity
(defun %fit-text (window text) (defun %fit-text (window text)
@ -429,6 +429,16 @@
:normal-text text-line))) :normal-text text-line)))
new-rows))) new-rows)))
(defmethod text->rendered-lines-rows (window (text gemini-parser:simple-line))
(let* ((fitted-lines (%fit-text window (gemini-parser:text-line text)))
(new-rows (colorize-lines fitted-lines)))
(mapcar (lambda (text-line)
(let ((res (make-instance 'line
:normal-text text-line)))
(row-add-original-object res text)
(row-add-group-id res (gemini-parser:group-id text))))
new-rows)))
(defun remove-invisible-rows (rows) (defun remove-invisible-rows (rows)
(remove-if #'row-invisible-p rows)) (remove-if #'row-invisible-p rows))