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

- prevented adding a quote prefix to each element inside a blockquote tag, when converting html to text.

This commit is contained in:
cage 2023-11-17 16:08:30 +01:00
parent a2c7c1d581
commit d01b6c798f
1 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/html-utils.lisp
View File

@ -102,6 +102,8 @@
(defparameter *prefix-text-line* "")
(defparameter *block-tag* nil)
(defun html->text (html &key
(add-link-footnotes t) (body-footnotes-separator "")
(quote-prefix "> ") (list-item-prefix "* "))
@ -130,11 +132,14 @@ Some convenience functions are provided to works with these structures.
(when node
(cond
((stringp node)
(princ (strcat *prefix-text-line* node) body-stream))
(if *block-tag*
(princ (strcat *prefix-text-line* node) body-stream)
(princ node body-stream)))
((consp (car node))
(descend (car node)))
((tag= +tag-link+ node)
(let ((link (find-attribute +attribute-url+ node)))
(let ((*block-tag* nil)
(link (find-attribute +attribute-url+ node)))
(incf link-count)
(if link
(format footnotes-stream
@ -149,20 +154,25 @@ Some convenience functions are provided to works with these structures.
(when add-link-footnotes
(format body-stream " [~a] " link-count))))
((tag= +tag-break+ node)
(format body-stream "~%")
(descend-children node))
(let ((*block-tag* nil))
(format body-stream "~%")
(descend-children node)))
((or (tag= +tag-paragraph+ node)
(tag= +tag-div+ node))
(format body-stream "~%")
(descend-children node)
(format body-stream "~%"))
(let ((*block-tag* t))
(format body-stream "~%")
(descend-children node)
(format body-stream "~%")))
((tag= +tag-list-item+ node)
(format body-stream list-item-prefix)
(descend-children node)
(format body-stream "~%"))
(let ((*block-tag* nil))
(format body-stream list-item-prefix)
(descend-children node)
(format body-stream "~%")))
((tag= +tag-blockquote+ node)
(let ((*prefix-text-line* quote-prefix))
(descend-children node)))
(let ((*prefix-text-line* quote-prefix)
(*block-tag* t))
(descend-children node)
(format body-stream "~%")))
(t
(descend-children node))))))
(descend root)