mirror of https://codeberg.org/cage/tinmop/
- added group-id property to all gemtext elements.
This commit is contained in:
cage
parent
0aad24a134
commit
3f27420848
|
|
@ -424,13 +424,14 @@
|
|||
(defun make-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
|
||||
:lines (split-lines text-lines)))
|
||||
:group-id group-id
|
||||
: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) ())
|
||||
|
||||
(defmethod print-object ((object pre-line) stream)
|
||||
(print-unreadable-object (object stream :type t)
|
||||
|
|
@ -447,7 +448,7 @@
|
|||
:pre-group-id pre-group-id
|
||||
:alt-text alt-text))
|
||||
|
||||
(defclass vertical-space ()
|
||||
(defclass vertical-space (with-group-id)
|
||||
((size
|
||||
:initform 1
|
||||
:initarg :size
|
||||
|
|
@ -465,13 +466,14 @@
|
|||
:group-id gid
|
||||
: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
|
||||
:group-id header-group-id
|
||||
:lines (list text)))
|
||||
|
||||
(defclass link-line ()
|
||||
(defclass link-line (with-group-id)
|
||||
((link-text
|
||||
:initarg :link-text
|
||||
:initform nil
|
||||
|
|
@ -485,12 +487,24 @@
|
|||
:initform nil
|
||||
: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
|
||||
:group-id group-id
|
||||
:link-text link-text
|
||||
:link-name link-name
|
||||
: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)
|
||||
(let ((win-width (message-window:viewport-width (viewport theme))))
|
||||
(labels ((header-prefix (prefix header)
|
||||
|
|
@ -542,8 +556,10 @@
|
|||
(lines (if justified
|
||||
(mapcar (lambda (a) (strcat quote-prefix a))
|
||||
justified)
|
||||
quote-prefix)))
|
||||
(make-quoted-lines (join-with-strings lines (format nil "~%")))))
|
||||
quote-prefix))
|
||||
(header-group-id (current-header-group-id)))
|
||||
(make-quoted-lines (join-with-strings lines (format nil "~%"))
|
||||
header-group-id)))
|
||||
(pre-alt-text (node)
|
||||
(trim (html-utils:attribute-value (html-utils:find-attribute :alt node))))
|
||||
(build-rows ()
|
||||
|
|
@ -551,20 +567,20 @@
|
|||
collect
|
||||
(cond
|
||||
((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)
|
||||
(let* ((line (text-value node :trim nil))
|
||||
(fg (preformatted-fg theme))
|
||||
(line (tui:make-tui-string (format nil
|
||||
"~a"
|
||||
line)
|
||||
(line (tui:make-tui-string (format nil "~a" line)
|
||||
:fgcolor fg)))
|
||||
(make-pre-line (list line)
|
||||
(current-header-group-id)
|
||||
(current-pre-group-id)
|
||||
(current-pre-alt-text))))
|
||||
((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)
|
||||
(make-header 1
|
||||
(header-prefix-h1 (text-value node))
|
||||
|
|
@ -582,7 +598,7 @@
|
|||
"~a ~a"
|
||||
(bullet-prefix theme)
|
||||
(text-value node))))
|
||||
(make-unordered-list-line text)))
|
||||
(make-unordered-list-line text (current-header-group-id))))
|
||||
((html-utils:tag= :quote node)
|
||||
(fit-quote-lines (text-value node :trim nil)
|
||||
win-width))
|
||||
|
|
@ -596,14 +612,15 @@
|
|||
((html-utils:tag= :pre-end node)
|
||||
(make-pre-end))
|
||||
((html-utils:tag= :a node)
|
||||
(let* ((link-name (text-value node :trim nil))
|
||||
(link-value (html-utils:attribute-value
|
||||
(html-utils:find-attribute :href
|
||||
node)))
|
||||
(link-text (if link-name
|
||||
(linkify link-name link-value)
|
||||
(linkify link-value link-value))))
|
||||
(make-link-line link-text link-name link-value)))))))
|
||||
(let* ((link-name (text-value node :trim nil))
|
||||
(link-value (html-utils:attribute-value
|
||||
(html-utils:find-attribute :href
|
||||
node)))
|
||||
(link-text (if link-name
|
||||
(linkify link-name link-value)
|
||||
(linkify link-value link-value)))
|
||||
(header-group-id (current-header-group-id)))
|
||||
(make-link-line link-text link-name link-value header-group-id)))))))
|
||||
(flatten (build-rows)))))
|
||||
|
||||
(defun parse-gemini-file (data)
|
||||
|
|
|
|||
|
|
@ -87,6 +87,8 @@
|
|||
:unordered-list-line
|
||||
:link-line
|
||||
:link-text
|
||||
:simple-line
|
||||
:text-line
|
||||
:sexp->text-rows
|
||||
:sexp->text
|
||||
:parse-gemini-response-header
|
||||
|
|
|
|||
|
|
@ -246,7 +246,8 @@
|
|||
:normal-text (make-tui-string (format nil "~%"))
|
||||
:fields (list +row-vertical-space-field-key+ 1))))
|
||||
(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)
|
||||
(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)
|
||||
&key &allow-other-keys)
|
||||
(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
|
||||
(make-instance 'line
|
||||
:normal-text i))))
|
||||
(let ((res-line (make-instance 'line
|
||||
: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))
|
||||
(collect-lines-from-ir text window))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text gemini-parser:header-line))
|
||||
(let* ((group-id (gemini-parser:group-id text))
|
||||
(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))
|
||||
(collect-lines-from-ir text window))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text gemini-parser:unordered-list-line))
|
||||
(collect-lines-from-ir text window))
|
||||
|
|
@ -398,6 +397,7 @@
|
|||
(defmethod text->rendered-lines-rows (window (text gemini-parser:link-line))
|
||||
(let ((res (make-instance 'line :normal-text (gemini-parser:link-text 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
|
||||
|
||||
(defun %fit-text (window text)
|
||||
|
|
@ -429,6 +429,16 @@
|
|||
:normal-text text-line)))
|
||||
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)
|
||||
(remove-if #'row-invisible-p rows))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue