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

-[gemtext] added metadata for list and link lines.

This commit is contained in:
cage 2021-04-13 17:29:25 +02:00
parent a91ec4c7ae
commit a4630f08af
3 changed files with 90 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -396,11 +396,33 @@
:group-id gid
:level level))
(defclass unordered-list-line (with-lines) ())
(defun make-unordered-list-line (text)
(make-instance 'unordered-list-line
:lines (list text)))
(defclass link-line (with-lines)
((link-name
:initarg :link-name
:initform nil
:accessor link-name)
(link-value
:initarg :link-value
:initform nil
:accessor link-value)))
(defun make-link-line (text link-name link-value)
(make-instance 'link-line
:lines (list text)
:link-name link-name
:link-value link-value))
(defun sexp->text-rows (parsed-gemini theme)
(let ((win-width (message-window:viewport-width (viewport theme)))
(pre-group-id -1)
(header-group-id -1)
(pre-alt-text ""))
(pre-alt-text ""))
(labels ((header-prefix (prefix header)
(strcat prefix header))
(header-prefix-h1 (header)
@ -444,48 +466,51 @@
(cond
((null node)
(make-instance 'vertical-space)) ;(format nil "~%"))
((html-utils:tag= :as-is node)
(let* ((truncated-line (safe-subseq (text-value node) 0 (1- win-width)))
(fg (preformatted-fg theme))
(line (tui:make-tui-string (format nil "~a" truncated-line)
:fgcolor fg)))
(make-pre-line (list line) pre-group-id pre-alt-text)))
((html-utils:tag= :text node)
(format nil "~a~%" (text-value node)))
((html-utils:tag= :h1 node)
(make-header 1
(header-prefix-h1 (text-value node))
+h1-underline+))
((html-utils:tag= :h2 node)
(make-header 2
(header-prefix-h2 (text-value node))
+h2-underline+))
((html-utils:tag= :h3 node)
(make-header 3
(header-prefix-h3 (text-value node))
+h3-underline+))
((html-utils:tag= :li node)
(format nil
"~a ~a~%"
(bullet-prefix theme)
(text-value node)))
((html-utils:tag= :quote node)
(fit-quote-lines (text-value node :trim nil)
win-width))
((html-utils:tag= :pre node)
(let ((current-alt-text (pre-alt-text node)))
(incf pre-group-id)
(setf pre-alt-text current-alt-text)
(make-pre-start current-alt-text pre-group-id)))
((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))))
(if link-name
(linkify link-name link-value)
(linkify link-value link-value))))))))
((html-utils:tag= :as-is node)
(let* ((truncated-line (safe-subseq (text-value node) 0 (1- win-width)))
(fg (preformatted-fg theme))
(line (tui:make-tui-string (format nil "~a" truncated-line)
:fgcolor fg)))
(make-pre-line (list line) pre-group-id pre-alt-text)))
((html-utils:tag= :text node)
(format nil "~a~%" (text-value node)))
((html-utils:tag= :h1 node)
(make-header 1
(header-prefix-h1 (text-value node))
+h1-underline+))
((html-utils:tag= :h2 node)
(make-header 2
(header-prefix-h2 (text-value node))
+h2-underline+))
((html-utils:tag= :h3 node)
(make-header 3
(header-prefix-h3 (text-value node))
+h3-underline+))
((html-utils:tag= :li node)
(let ((text (format nil
"~a ~a"
(bullet-prefix theme)
(text-value node))))
(make-unordered-list-line text)))
((html-utils:tag= :quote node)
(fit-quote-lines (text-value node :trim nil)
win-width))
((html-utils:tag= :pre node)
(let ((current-alt-text (pre-alt-text node)))
(incf pre-group-id)
(setf pre-alt-text current-alt-text)
(make-pre-start current-alt-text pre-group-id)))
((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)))))))
(flatten (build-rows)))))
(defun sexp->text (parsed-gemini theme)

2
src/gemini/package.lisp
View File

@ -77,6 +77,8 @@
:vertical-space
:header-line
:level
:unordered-list-line
:link-line
:sexp->text-rows
:sexp->text
:parse-gemini-response-header

25
src/message-window.lisp
View File

@ -139,12 +139,19 @@
(draw-buffer-line-mark object))
(call-next-method)))
(defun row-add-original-object (line original-object)
(defgeneric row-add-original-object (lines original-object))
(defmethod row-add-original-object ((lines line) original-object)
(push original-object
(fields line))
(fields lines))
(push :original-object
(fields line))
line)
(fields lines))
lines)
(defmethod row-add-original-object ((lines list) original-object)
(mapcar (lambda (a) (row-add-original-object a original-object))
lines)
lines)
(defun row-get-original-object (line)
(getf (fields line) :original-object))
@ -289,7 +296,7 @@
(defgeneric collect-lines-from-ir (object))
(defmethod collect-lines-from-ir ((object gemini-parser:with-lines))
(defmethod collect-lines-from-ir ((object gemini-parser:with-lines))
(let ((colorized-lines (colorize-lines (gemini-parser:lines object))))
(loop for i in colorized-lines
collect
@ -308,6 +315,14 @@
lines)))
res))
(defmethod text->rendered-lines-rows (window (text gemini-parser:unordered-list-line))
(collect-lines-from-ir text))
(defmethod text->rendered-lines-rows (window (text gemini-parser:link-line))
(let ((res (collect-lines-from-ir text)))
(row-add-original-object res text)
res)) ; even if row-add-original-object returns the modified line explicit returns for clarity
(defmethod text->rendered-lines-rows (window (text string))
(labels ((fit-lines (lines)
(let ((res ()))