1
0
Fork 0

- [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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -27,6 +27,13 @@
(define-constant +attribute-url+ "href" :test #'string=) (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) (defun make-tag-node (tag attributes value)
"create a node" "create a node"
(if (listp value) (if (listp value)

View File

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

View File

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