mirror of https://codeberg.org/cage/tinmop/
Compare commits
2 Commits
d0bcf1e33f
...
5249910397
Author | SHA1 | Date |
---|---|---|
cage | 5249910397 | |
cage | ce688f59b8 |
|
@ -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+)))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue