1
0
Fork 0

Compare commits

...

2 Commits

Author SHA1 Message Date
cage 5249910397 - removed '*use-tk-for-decoding-png*'. 2024-11-03 13:51:32 +01:00
cage ce688f59b8 - [fediverse] improved html rendering. 2024-11-03 13:49:52 +01:00
2 changed files with 115 additions and 41 deletions

View File

@ -123,30 +123,29 @@
(client-configuration:config-icons-scaling))))
(defun load-icons ()
(let ((nodgui:*use-tk-for-decoding-png* t))
(setf *search* (load-icon +search+))
(setf *back* (load-icon +back+))
(setf *open-iri* (load-icon +go+))
(setf *open-tour* (load-icon +open-tour+))
(setf *refresh* (load-icon +refresh+))
(setf *up* (load-icon +up+))
(setf *document-delete* (load-icon +document-delete+))
(setf *document-add* (load-icon +document-add+))
(setf *document-accept* (load-icon +document-accept+))
(setf *document-edit* (load-icon +document-edit+))
(setf *folder* (load-icon +folder+))
(setf *star-yellow* (load-icon +star-yellow+))
(setf *star-blue* (load-icon +star-blue+))
(setf *arrow-up* (load-icon +arrow-up+))
(setf *arrow-down* (load-icon +arrow-down+))
(setf *cross* (load-icon +cross+))
(setf *bus-go* (load-icon +bus-go+))
(setf *dice* (load-icon +dice+))
(setf *gemlog-subscribe* (load-icon +gemlog-subscribe+))
(setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+))
(setf *inline-images* (load-icon +inline-images+))
(setf *text* (load-icon +text+))
(setf *profile* (load-icon +profile+))
(setf *profile-disabled* (disable-icon +profile+))
(setf *toc* (load-icon +toc+))
(setf *toc-disabled* (disable-icon +toc+))))
(setf *search* (load-icon +search+))
(setf *back* (load-icon +back+))
(setf *open-iri* (load-icon +go+))
(setf *open-tour* (load-icon +open-tour+))
(setf *refresh* (load-icon +refresh+))
(setf *up* (load-icon +up+))
(setf *document-delete* (load-icon +document-delete+))
(setf *document-add* (load-icon +document-add+))
(setf *document-accept* (load-icon +document-accept+))
(setf *document-edit* (load-icon +document-edit+))
(setf *folder* (load-icon +folder+))
(setf *star-yellow* (load-icon +star-yellow+))
(setf *star-blue* (load-icon +star-blue+))
(setf *arrow-up* (load-icon +arrow-up+))
(setf *arrow-down* (load-icon +arrow-down+))
(setf *cross* (load-icon +cross+))
(setf *bus-go* (load-icon +bus-go+))
(setf *dice* (load-icon +dice+))
(setf *gemlog-subscribe* (load-icon +gemlog-subscribe+))
(setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+))
(setf *inline-images* (load-icon +inline-images+))
(setf *text* (load-icon +text+))
(setf *profile* (load-icon +profile+))
(setf *profile-disabled* (disable-icon +profile+))
(setf *toc* (load-icon +toc+))
(setf *toc-disabled* (disable-icon +toc+)))

View File

@ -17,6 +17,14 @@
(in-package :html-utils)
(define-constant +tag-bold+ "b" :test #'string=)
(define-constant +tag-italic+ "i" :test #'string=)
(define-constant +tag-emphasis+ "em" :test #'string=)
(define-constant +tag-strong+ "strong" :test #'string=)
(define-constant +tag-link+ "a" :test #'string=)
(define-constant +tag-break+ "br" :test #'string=)
@ -116,6 +124,8 @@
(defparameter *ordered-list-item-number* 0)
(defparameter *indentation-level* "")
(defun append-footnote-reference (text reference-number)
(strcat text
(format nil
@ -134,6 +144,17 @@
(defun strip-footnote-reference (word)
(cl-ppcre:regex-replace scanner word "")))
(defun block-tag-p (node)
(and (consp node)
(member node
(list +tag-break+
+tag-paragraph+
+tag-ordered-list+
+tag-unordered-list+
+tag-div+
+tag-blockquote+)
:test (lambda (a b) (tag= b a)))))
(defun html->text (html &key
(add-link-footnotes t) (body-footnotes-separator "")
(quote-prefix "> ") (list-item-prefix "* "))
@ -153,12 +174,46 @@ Some convenience functions are provided to works with these structures.
(footnotes (misc:make-fresh-array 0 #\a 'character nil)))
(with-output-to-string (body-stream body)
(with-output-to-string (footnotes-stream footnotes)
(format footnotes-stream "~2%")
(labels ((descend-children (node)
(loop for child in (children node) do
(descend child)))
(descend (node)
(labels ((print-line-break ()
(format body-stream "~%"))
(print-line-break-maybe ()
(format body-stream "~&"))
(wrap-bold (node)
(format body-stream "*")
(descend-children node)
(format body-stream "*"))
(wrap-italic (node)
(format body-stream "/")
(descend-children node)
(format body-stream "/"))
(wrap-emphasis (node)
(format body-stream "_")
(descend-children node)
(format body-stream "_"))
(inc-indent (&optional (size 1))
(setf *indentation-level*
(strcat *indentation-level*
(make-string size :initial-element #\space))))
(dec-indent (&optional (size 1))
(when (>= (length *indentation-level*)
size)
(setf *indentation-level*
(subseq *indentation-level* size))))
(print-indent (stream)
;; (write-string (format nil "~a" (length *indentation-level*)) stream)
(write-string *indentation-level* stream))
(descend-children (node)
(loop
for count from 0
for child in (children node) do
(if (block-tag-p node)
(descend child t)
(descend child nil))))
(descend (node &optional (print-indent t))
(when node
(when print-indent
(print-indent body-stream))
(cond
((stringp node)
(princ node body-stream))
@ -180,44 +235,61 @@ Some convenience functions are provided to works with these structures.
(when add-link-footnotes
(write-string (append-footnote-reference "" link-count)
body-stream))))
((or (tag= +tag-bold+ node)
(tag= +tag-strong+ node))
(wrap-bold node))
((tag= +tag-italic+ node)
(wrap-italic node))
((tag= +tag-emphasis+ node)
(wrap-emphasis node))
((tag= +tag-break+ node)
(let ((*block-tag* nil))
(format body-stream "~%")
(print-line-break)
(descend-children node)))
((or (tag= +tag-paragraph+ node)
(tag= +tag-div+ node))
(let ((*block-tag* t))
(format body-stream "~%")
(print-line-break)
(when *block-tag*
(loop for i from 0 below *quote-level* do
(princ *prefix-text-line* body-stream)))
(descend-children node)
(format body-stream "~%")))
(print-line-break)))
((tag= +tag-unordered-list+ node)
(let ((*ordered-list* nil)
(*unordered-list* t))
(descend-children node)))
(print-line-break-maybe)
(inc-indent)
(descend-children node)
(dec-indent)))
((tag= +tag-ordered-list+ node)
(let ((*ordered-list* t)
(*unordered-list* nil)
(*ordered-list-item-number* 0))
(descend-children node)))
(print-line-break-maybe)
(inc-indent)
(descend-children node)
(dec-indent)))
((tag= +tag-list-item+ node)
(let ((*block-tag* nil))
(cond
(*unordered-list*
(inc-indent (length list-item-prefix))
(format body-stream list-item-prefix)
(descend-children node)
(format body-stream "~%"))
(dec-indent (length list-item-prefix))
(print-line-break-maybe))
(*ordered-list*
(incf *ordered-list-item-number*)
(inc-indent (length list-item-prefix))
(format body-stream "~a." *ordered-list-item-number*)
(descend-children node)
(format body-stream "~%"))
(dec-indent (length list-item-prefix))
(print-line-break))
(t
(format body-stream "unknown list type ")
(descend-children node)
(format body-stream "~%")))))
(print-line-break)))))
((tag= +tag-blockquote+ node)
(let ((*prefix-text-line* quote-prefix)
(*quote-level* (1+ *quote-level*))
@ -227,7 +299,10 @@ Some convenience functions are provided to works with these structures.
(descend-children node))))))
(descend root)
(if add-link-footnotes
(strcat body body-footnotes-separator footnotes)
(strcat body
(format nil "~%")
body-footnotes-separator
footnotes)
body)))))))
(defun extract-shotcodes (file)