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

- [modules] added backlink to generated gemlog pages; 

- [gemini] fixed rendering of links that starts with an emoji.
This commit is contained in:
cage 2022-07-13 17:08:37 +02:00
parent 5e79aa5551
commit de980b44b7
8 changed files with 67 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/default-theme.conf
View File

@ -524,7 +524,9 @@ gemini.link.attribute = bold
gemini.link.scheme.gemini.prefix = "→♊ "
gemini.link.scheme.other.prefix = "→🕸 "
gemini.link.scheme.other.prefix = "→ "
gemini.link.scheme.http.prefix = "→🕸 "
gemini.quote.prefix = "🞂 "

27
scripts/generate-gemlog.lisp
View File

@ -47,6 +47,14 @@
(defparameter *uri-prefix-path* "/")
(defparameter *post-home-backlink* "../index.gmi")
(defparameter *post-home-backlink-name* "home")
(defparameter *indices-home-backlink* "./index.gmi")
(defparameter *indices-home-backlink-name* "home")
(defun parse-date (timestring)
(local-time:parse-timestring timestring))
@ -211,6 +219,10 @@
:if-does-not-exist :create
:if-exists :supersede)
(sexp->gmi (content post) stream)
(write-sequence (geminize-link (strcat *post-home-backlink*
" "
*post-home-backlink-name*))
stream)
(notify "Processed ~a~%" (original-file-path post)))
(error (e)
(format *error-output*
@ -244,7 +256,12 @@
:if-does-not-exist :create
:if-exists :supersede)
(format gemlog-stream *gemlog-header*)
(write-links all-posts gemlog-stream))))
(write-links all-posts gemlog-stream)
(format gemlog-stream "~%")
(write-sequence (geminize-link (strcat *indices-home-backlink*
" "
*indices-home-backlink-name*))
gemlog-stream))))
(defun make-topic-index (all-posts output-directory all-topics)
(let ((topics-index-path (cat-parent-dir output-directory +archive-topic-file+)))
@ -262,8 +279,12 @@
post-topics
:test #'string-equal)))
all-posts)))
(write-links in-topic-posts stream))
(format stream "~%")))))
(write-links in-topic-posts stream)
(format stream "~%")))
(write-sequence (geminize-link (strcat *indices-home-backlink*
" "
*indices-home-backlink-name*))
stream))))
(defun generate-gemlog (bulk-posts-dir output-directory)
(multiple-value-bind (all-posts all-topics)

1
src/gemini/client.lisp
View File

@ -189,6 +189,7 @@
:viewport viewport
:link-prefix-other (swconf:gemini-link-prefix-to-other)
:link-prefix-gemini (swconf:gemini-link-prefix-to-gemini)
:link-prefix-http (swconf:gemini-link-prefix-to-http)
:link-bg link-bg
:link-fg link-fg
:link-attributes link-attributes

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

@ -359,6 +359,10 @@
:initarg :link-prefix-gemini
:initform "-> "
:accessor link-prefix-gemini)
(link-prefix-http
:initarg :link-prefix-http
:initform "-> "
:accessor link-prefix-http)
(link-prefix-other
:initarg :link-prefix-other
:initform "^ "
@ -578,17 +582,27 @@
(trim text)
text)))
(linkify (link-name link-value)
(let ((raw-link-text (if (gemini-link-iri-p link-value)
(if (text-utils:starting-emoji link-name)
(format nil "~a" link-name)
(format nil
"~a~a"
(link-prefix-gemini theme)
link-name))
(format nil
"~a~a"
(link-prefix-other theme)
link-name))))
(let ((raw-link-text (cond
((gemini-link-iri-p link-value)
(if (text-utils:starting-emoji link-name)
(format nil
"~a~a"
(text-utils:trim-blanks (link-prefix-other theme))
link-name)
(format nil
"~a~a"
(link-prefix-gemini theme)
link-name)))
((html-utils::http-link-iri-p link-value)
(format nil
"~a~a"
(link-prefix-http theme)
link-name))
(t
(format nil
"~a~a"
(link-prefix-other theme)
link-name)))))
(tui:make-tui-string raw-link-text
:attributes (link-attributes theme)
:fgcolor (link-fg theme)

1
src/gemini/package.lisp
View File

@ -67,6 +67,7 @@
:gemini-page-theme
:link-prefix-gemini
:link-prefix-other
:link-prefix-http
:h1-prefix
:h2-prefix
:h3-prefix

7
src/html-utils.lisp
View File

@ -27,6 +27,13 @@
(define-constant +attribute-url+ "href" :test #'string=)
(define-constant +http-scheme+ "http" :test #'string=)
(defun http-link-iri-p (iri)
(conditions:with-default-on-error (nil)
(or (text-utils:string-starts-with-p +http-scheme+ iri)
(null (uri:scheme (iri:iri-parse iri))))))
(defun make-tag-node (tag attributes value)
"create a node"
(if (listp value)

2
src/package.lisp
View File

@ -434,6 +434,7 @@
:config
:text-utils)
(:export
:http-link-iri-p
:make-tag-node
:tag
:attributes
@ -1209,6 +1210,7 @@
:gemini-link-colors
:gemini-link-prefix-to-gemini
:gemini-link-prefix-to-other
:gemini-link-prefix-to-http
:gemini-quote-prefix
:gemini-quote-prefix
:gemini-h1-prefix

4
src/software-configuration.lisp
View File

@ -496,6 +496,7 @@
scheme
link
links
http
creation-time
access-time
visibility
@ -737,6 +738,9 @@
(defun gemini-link-prefix-to-other ()
(gemini-link-prefix +key-other+))
(defun gemini-link-prefix-to-http ()
(gemini-link-prefix +key-http+))
(defun gemini-quote-prefix ()
(access-non-null-conf-value *software-configuration*
+key-gemini+