mirror of https://codeberg.org/cage/tinmop/
- added group-id property to all gemtext elements.
This commit is contained in:
parent
0aad24a134
commit
3f27420848
|
@ -424,13 +424,14 @@
|
||||||
(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
|
||||||
: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)
|
(defmethod print-object ((object pre-line) stream)
|
||||||
(print-unreadable-object (object stream :type t)
|
(print-unreadable-object (object stream :type t)
|
||||||
|
@ -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))
|
||||||
|
@ -596,14 +612,15 @@
|
||||||
((html-utils:tag= :pre-end node)
|
((html-utils:tag= :pre-end node)
|
||||||
(make-pre-end))
|
(make-pre-end))
|
||||||
((html-utils:tag= :a node)
|
((html-utils:tag= :a node)
|
||||||
(let* ((link-name (text-value node :trim nil))
|
(let* ((link-name (text-value node :trim nil))
|
||||||
(link-value (html-utils:attribute-value
|
(link-value (html-utils:attribute-value
|
||||||
(html-utils:find-attribute :href
|
(html-utils:find-attribute :href
|
||||||
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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue