diff --git a/etc/default-theme.conf b/etc/default-theme.conf index 72ffaa8..f199b60 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -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 = "🞂 " diff --git a/scripts/generate-gemlog.lisp b/scripts/generate-gemlog.lisp index 7f07086..6109d79 100644 --- a/scripts/generate-gemlog.lisp +++ b/scripts/generate-gemlog.lisp @@ -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) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index 1e5520b..5d5e3e0 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -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 diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index df5d9c9..deb0d94 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -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) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index de0b4c6..cb76ccd 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -67,6 +67,7 @@ :gemini-page-theme :link-prefix-gemini :link-prefix-other + :link-prefix-http :h1-prefix :h2-prefix :h3-prefix diff --git a/src/html-utils.lisp b/src/html-utils.lisp index 2925c62..f93da25 100644 --- a/src/html-utils.lisp +++ b/src/html-utils.lisp @@ -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) diff --git a/src/package.lisp b/src/package.lisp index 20ef9b7..9730b57 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 249a9df..f194aea 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -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+