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))))
|
(client-configuration:config-icons-scaling))))
|
||||||
|
|
||||||
(defun load-icons ()
|
(defun load-icons ()
|
||||||
(let ((nodgui:*use-tk-for-decoding-png* t))
|
(setf *search* (load-icon +search+))
|
||||||
(setf *search* (load-icon +search+))
|
(setf *back* (load-icon +back+))
|
||||||
(setf *back* (load-icon +back+))
|
(setf *open-iri* (load-icon +go+))
|
||||||
(setf *open-iri* (load-icon +go+))
|
(setf *open-tour* (load-icon +open-tour+))
|
||||||
(setf *open-tour* (load-icon +open-tour+))
|
(setf *refresh* (load-icon +refresh+))
|
||||||
(setf *refresh* (load-icon +refresh+))
|
(setf *up* (load-icon +up+))
|
||||||
(setf *up* (load-icon +up+))
|
(setf *document-delete* (load-icon +document-delete+))
|
||||||
(setf *document-delete* (load-icon +document-delete+))
|
(setf *document-add* (load-icon +document-add+))
|
||||||
(setf *document-add* (load-icon +document-add+))
|
(setf *document-accept* (load-icon +document-accept+))
|
||||||
(setf *document-accept* (load-icon +document-accept+))
|
(setf *document-edit* (load-icon +document-edit+))
|
||||||
(setf *document-edit* (load-icon +document-edit+))
|
(setf *folder* (load-icon +folder+))
|
||||||
(setf *folder* (load-icon +folder+))
|
(setf *star-yellow* (load-icon +star-yellow+))
|
||||||
(setf *star-yellow* (load-icon +star-yellow+))
|
(setf *star-blue* (load-icon +star-blue+))
|
||||||
(setf *star-blue* (load-icon +star-blue+))
|
(setf *arrow-up* (load-icon +arrow-up+))
|
||||||
(setf *arrow-up* (load-icon +arrow-up+))
|
(setf *arrow-down* (load-icon +arrow-down+))
|
||||||
(setf *arrow-down* (load-icon +arrow-down+))
|
(setf *cross* (load-icon +cross+))
|
||||||
(setf *cross* (load-icon +cross+))
|
(setf *bus-go* (load-icon +bus-go+))
|
||||||
(setf *bus-go* (load-icon +bus-go+))
|
(setf *dice* (load-icon +dice+))
|
||||||
(setf *dice* (load-icon +dice+))
|
(setf *gemlog-subscribe* (load-icon +gemlog-subscribe+))
|
||||||
(setf *gemlog-subscribe* (load-icon +gemlog-subscribe+))
|
(setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+))
|
||||||
(setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+))
|
(setf *inline-images* (load-icon +inline-images+))
|
||||||
(setf *inline-images* (load-icon +inline-images+))
|
(setf *text* (load-icon +text+))
|
||||||
(setf *text* (load-icon +text+))
|
(setf *profile* (load-icon +profile+))
|
||||||
(setf *profile* (load-icon +profile+))
|
(setf *profile-disabled* (disable-icon +profile+))
|
||||||
(setf *profile-disabled* (disable-icon +profile+))
|
(setf *toc* (load-icon +toc+))
|
||||||
(setf *toc* (load-icon +toc+))
|
(setf *toc-disabled* (disable-icon +toc+)))
|
||||||
(setf *toc-disabled* (disable-icon +toc+))))
|
|
||||||
|
|
|
||||||
|
|
@ -17,6 +17,14 @@
|
||||||
|
|
||||||
(in-package :html-utils)
|
(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-link+ "a" :test #'string=)
|
||||||
|
|
||||||
(define-constant +tag-break+ "br" :test #'string=)
|
(define-constant +tag-break+ "br" :test #'string=)
|
||||||
|
|
@ -116,6 +124,8 @@
|
||||||
|
|
||||||
(defparameter *ordered-list-item-number* 0)
|
(defparameter *ordered-list-item-number* 0)
|
||||||
|
|
||||||
|
(defparameter *indentation-level* "")
|
||||||
|
|
||||||
(defun append-footnote-reference (text reference-number)
|
(defun append-footnote-reference (text reference-number)
|
||||||
(strcat text
|
(strcat text
|
||||||
(format nil
|
(format nil
|
||||||
|
|
@ -134,6 +144,17 @@
|
||||||
(defun strip-footnote-reference (word)
|
(defun strip-footnote-reference (word)
|
||||||
(cl-ppcre:regex-replace scanner 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
|
(defun html->text (html &key
|
||||||
(add-link-footnotes t) (body-footnotes-separator "")
|
(add-link-footnotes t) (body-footnotes-separator "")
|
||||||
(quote-prefix "> ") (list-item-prefix "* "))
|
(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)))
|
(footnotes (misc:make-fresh-array 0 #\a 'character nil)))
|
||||||
(with-output-to-string (body-stream body)
|
(with-output-to-string (body-stream body)
|
||||||
(with-output-to-string (footnotes-stream footnotes)
|
(with-output-to-string (footnotes-stream footnotes)
|
||||||
(format footnotes-stream "~2%")
|
(labels ((print-line-break ()
|
||||||
(labels ((descend-children (node)
|
(format body-stream "~%"))
|
||||||
(loop for child in (children node) do
|
(print-line-break-maybe ()
|
||||||
(descend child)))
|
(format body-stream "~&"))
|
||||||
(descend (node)
|
(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 node
|
||||||
|
(when print-indent
|
||||||
|
(print-indent body-stream))
|
||||||
(cond
|
(cond
|
||||||
((stringp node)
|
((stringp node)
|
||||||
(princ node body-stream))
|
(princ node body-stream))
|
||||||
|
|
@ -180,44 +235,61 @@ Some convenience functions are provided to works with these structures.
|
||||||
(when add-link-footnotes
|
(when add-link-footnotes
|
||||||
(write-string (append-footnote-reference "" link-count)
|
(write-string (append-footnote-reference "" link-count)
|
||||||
body-stream))))
|
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)
|
((tag= +tag-break+ node)
|
||||||
(let ((*block-tag* nil))
|
(let ((*block-tag* nil))
|
||||||
(format body-stream "~%")
|
(print-line-break)
|
||||||
(descend-children node)))
|
(descend-children node)))
|
||||||
((or (tag= +tag-paragraph+ node)
|
((or (tag= +tag-paragraph+ node)
|
||||||
(tag= +tag-div+ node))
|
(tag= +tag-div+ node))
|
||||||
(let ((*block-tag* t))
|
(let ((*block-tag* t))
|
||||||
(format body-stream "~%")
|
(print-line-break)
|
||||||
(when *block-tag*
|
(when *block-tag*
|
||||||
(loop for i from 0 below *quote-level* do
|
(loop for i from 0 below *quote-level* do
|
||||||
(princ *prefix-text-line* body-stream)))
|
(princ *prefix-text-line* body-stream)))
|
||||||
(descend-children node)
|
(descend-children node)
|
||||||
(format body-stream "~%")))
|
(print-line-break)))
|
||||||
((tag= +tag-unordered-list+ node)
|
((tag= +tag-unordered-list+ node)
|
||||||
(let ((*ordered-list* nil)
|
(let ((*ordered-list* nil)
|
||||||
(*unordered-list* t))
|
(*unordered-list* t))
|
||||||
(descend-children node)))
|
(print-line-break-maybe)
|
||||||
|
(inc-indent)
|
||||||
|
(descend-children node)
|
||||||
|
(dec-indent)))
|
||||||
((tag= +tag-ordered-list+ node)
|
((tag= +tag-ordered-list+ node)
|
||||||
(let ((*ordered-list* t)
|
(let ((*ordered-list* t)
|
||||||
(*unordered-list* nil)
|
(*unordered-list* nil)
|
||||||
(*ordered-list-item-number* 0))
|
(*ordered-list-item-number* 0))
|
||||||
(descend-children node)))
|
(print-line-break-maybe)
|
||||||
|
(inc-indent)
|
||||||
|
(descend-children node)
|
||||||
|
(dec-indent)))
|
||||||
((tag= +tag-list-item+ node)
|
((tag= +tag-list-item+ node)
|
||||||
(let ((*block-tag* nil))
|
(let ((*block-tag* nil))
|
||||||
(cond
|
(cond
|
||||||
(*unordered-list*
|
(*unordered-list*
|
||||||
|
(inc-indent (length list-item-prefix))
|
||||||
(format body-stream list-item-prefix)
|
(format body-stream list-item-prefix)
|
||||||
(descend-children node)
|
(descend-children node)
|
||||||
(format body-stream "~%"))
|
(dec-indent (length list-item-prefix))
|
||||||
|
(print-line-break-maybe))
|
||||||
(*ordered-list*
|
(*ordered-list*
|
||||||
(incf *ordered-list-item-number*)
|
(incf *ordered-list-item-number*)
|
||||||
|
(inc-indent (length list-item-prefix))
|
||||||
(format body-stream "~a." *ordered-list-item-number*)
|
(format body-stream "~a." *ordered-list-item-number*)
|
||||||
(descend-children node)
|
(descend-children node)
|
||||||
(format body-stream "~%"))
|
(dec-indent (length list-item-prefix))
|
||||||
|
(print-line-break))
|
||||||
(t
|
(t
|
||||||
(format body-stream "unknown list type ")
|
(format body-stream "unknown list type ")
|
||||||
(descend-children node)
|
(descend-children node)
|
||||||
(format body-stream "~%")))))
|
(print-line-break)))))
|
||||||
((tag= +tag-blockquote+ node)
|
((tag= +tag-blockquote+ node)
|
||||||
(let ((*prefix-text-line* quote-prefix)
|
(let ((*prefix-text-line* quote-prefix)
|
||||||
(*quote-level* (1+ *quote-level*))
|
(*quote-level* (1+ *quote-level*))
|
||||||
|
|
@ -227,7 +299,10 @@ Some convenience functions are provided to works with these structures.
|
||||||
(descend-children node))))))
|
(descend-children node))))))
|
||||||
(descend root)
|
(descend root)
|
||||||
(if add-link-footnotes
|
(if add-link-footnotes
|
||||||
(strcat body body-footnotes-separator footnotes)
|
(strcat body
|
||||||
|
(format nil "~%")
|
||||||
|
body-footnotes-separator
|
||||||
|
footnotes)
|
||||||
body)))))))
|
body)))))))
|
||||||
|
|
||||||
(defun extract-shotcodes (file)
|
(defun extract-shotcodes (file)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue