From c84de306c8d55bbaf87df80635d20c6a1091f331 Mon Sep 17 00:00:00 2001 From: cage Date: Wed, 8 Jul 2020 18:34:48 +0200 Subject: [PATCH] - [gemini] made some elements of page rendering customizable using 'gemini-page-theme' class some elements of the rendered page (header prefix, bullet and so on) can be customized. users can use configuration files directive to change the appearance of said elements (both character and color or font variants); - removed unused argument from command line switch: '-m'. --- etc/default-theme.conf | 16 ++++++++ etc/shared.conf | 50 +++++++++++++++--------- src/command-line.lisp | 1 - src/gemini/client.lisp | 17 ++++++++- src/gemini/gemini-parser.lisp | 67 ++++++++++++++++++++++++++++----- src/gemini/package.lisp | 9 +++++ src/main.lisp | 1 + src/package.lisp | 8 ++++ src/software-configuration.lisp | 54 +++++++++++++++++++++++++- tinmop.asd | 8 ++-- 10 files changed, 195 insertions(+), 36 deletions(-) diff --git a/etc/default-theme.conf b/etc/default-theme.conf index 1baeb33..c541b1e 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -453,3 +453,19 @@ open-message-link-window.foreground = #FEB200 open-message-link-window.input.selected.background = black open-message-link-window.input.selected.foreground = #FFB200 + +# gemini browser + +gemini.link.scheme.gemini.prefix = "→ " + +gemini.link.scheme.other.prefix = "➶ " + +gemini.quote.prefix = "🞂 " + +gemini.bullet.prefix = "• " + +gemini.h1.prefix = "🞓 " + +gemini.h2.prefix = "🞐 " + +gemini.h3.prefix = "🞎 " diff --git a/etc/shared.conf b/etc/shared.conf index 5c7d31c..5a38c1d 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -1,11 +1,11 @@ # a line starting with a '#' is a comment # The server instance name # add this entry to your file (the one in your home) -# server = test.server.org +# server = test.server.org # your username # add this entry to your file (the one in your home) -# username = username +# username = username # theme @@ -25,17 +25,17 @@ use "default-theme.conf" #max-report-comment-length = 100 # Character to use when replying to a message -reply-quoted-character = "> " +reply-quoted-character = "> " # delete the command history entries that are older than this number # of days -purge-history-days-offset = -7 +purge-history-days-offset = -7 # delete the cache entries that are older than this number of days -purge-cache-days-offset = -7 +purge-cache-days-offset = -7 # chosen editor (as shell command line) for compose a message -editor = "nano --locking" +editor = "nano --locking" # color parts of a displayed message according to a regular expression # syntax is regular expression color attribute @@ -59,27 +59,43 @@ editor = "nano --locking" # Some examples follows, order matters! -color-regexp = "http(s)?://[^ ]+" #ff0000 +color-regexp = "http(s)?://[^ ]+" #ff0000 -color-regexp = "-> gemini://[^ ]+" yellow underline +color-regexp = "-> gemini://[^ ]+" yellow underline -color-regexp = "gemini://[^ ]+" #ff0000 +color-regexp = "gemini://[^ ]+" #ff0000 -color-regexp = "(?i)(\\(c\\))|(\\(r\\))" #ff0000 bold +color-regexp = "(?i)(\\(c\\))|(\\(r\\))" #ff0000 bold -color-regexp = "[0-9]{4}-[0-9]?[0-9]-[0-9]?[0-9]" #0000ff bold +color-regexp = "[0-9]{4}-[0-9]?[0-9]-[0-9]?[0-9]" #0000ff bold -color-regexp = "-?[0-9]+%" #ff00ff bold +color-regexp = "-?[0-9]+%" #ff00ff bold -color-regexp = "\*[^*]+\*" #ffff00 bold +color-regexp = "\*[^*]+\*" #ffff00 bold -color-regexp = "_[^_]+_" #ffff00 underline +color-regexp = "_[^_]+_" #ffff00 underline -color-regexp = "/[^/]+/" #ffff00 italic +color-regexp = "/[^/]+/" #ffff00 italic -color-regexp = "⯀" green bold +color-regexp = "⯀" green bold -color-regexp = "The poll has expired" #ff00ff bold +color-regexp = "The poll has expired" #ff00ff bold + +# gemini colorization + +color-regexp = "→ .+" blue bold + +color-regexp = "➶ .+" magenta bold + +color-regexp = "🞂 .+" white bold + +color-regexp = "🞓 .+" blue bold + +color-regexp = "🞐 .+" yellow bold + +color-regexp = "🞎 " yellow + +color-regexp = "• " blue bold # the signature file path relative to $HOME diff --git a/src/command-line.lisp b/src/command-line.lisp index f7212e7..61a7ee2 100644 --- a/src/command-line.lisp +++ b/src/command-line.lisp @@ -63,7 +63,6 @@ (:name :notify-mentions :description (_ "Notify messages that mentions the user") :short #\m - :arg-parser #'identity :long "notify-mentions") (:name :open-gemini-url :description (_ "Open gemini url") diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index 51fa31a..8522faf 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -167,7 +167,20 @@ (host condition)))) (:documentation "The condition signalled when tofu failed")) -(defun parse-response (stream host port path) +(defparameter *gemini-page-theme* nil) + +(defun init-default-gemini-theme () + (setf *gemini-page-theme* + (make-instance 'gemini-parser:gemini-page-theme + :link-prefix-other (swconf:gemini-link-prefix-to-other) + :link-prefix-gemini (swconf:gemini-link-prefix-to-gemini) + :quote-prefix (swconf:gemini-quote-prefix) + :h1-prefix (swconf:gemini-h1-prefix) + :h2-prefix (swconf:gemini-h2-prefix) + :h3-prefix (swconf:gemini-h3-prefix) + :bullet-prefix (swconf:gemini-bullet-prefix)))) + +(defun parse-response (stream host port path &key (theme *gemini-page-theme*)) (let* ((header-raw (misc:list->array (loop for c = (read-byte stream) while (/= c 10) collect c) @@ -195,7 +208,7 @@ "-> ~a://~a:~a~a~2%~a" +gemini-scheme+ host port path - (sexp->text parsed)) + (sexp->text parsed theme)) (sexp->links parsed host port path))) (results +20+ body)))) ((or (header-input-request-p parsed-header) diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index ce276a4..ed8d376 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -273,8 +273,51 @@ original-path) :name (tag-value node))))) -(defun sexp->text (parsed-gemini) - (labels ((underlineize (stream text underline-char) +(defun gemini-link-uri-p (uri) + (conditions:with-default-on-error (nil) + (or (text-utils:string-starts-with-p +gemini-scheme+ uri) + (null (quri:uri-scheme (quri:uri uri)))))) + +(defclass gemini-page-theme () + ((link-prefix-gemini + :initarg :link-prefix-gemini + :initform "-> " + :accessor link-prefix-gemini) + (link-prefix-other + :initarg :link-prefix-other + :initform "^ " + :accessor link-prefix-other) + (h1-prefix + :initarg :h1-prefix + :initform "+ " + :accessor h1-prefix) + (h2-prefix + :initarg :h2-prefix + :initform "+ " + :accessor h2-prefix) + (h3-prefix + :initarg :h3-prefix + :initform "+ " + :accessor h3-prefix) + (quote-prefix + :initarg :quote-prefix + :initform +quote-line-prefix+ + :accessor quote-prefix) + (bullet-prefix + :initarg :bullet-prefix + :initform +bullet-line-prefix+ + :accessor bullet-prefix))) + +(defun sexp->text (parsed-gemini theme) + (labels ((header-prefix (prefix header) + (strcat prefix header)) + (header-prefix-h1 (header) + (header-prefix (h1-prefix theme) header)) + (header-prefix-h2 (header) + (header-prefix (h2-prefix theme) header)) + (header-prefix-h3 (header) + (header-prefix (h3-prefix theme) header)) + (underlineize (stream text underline-char) (let* ((size (length text)) (underline (build-string size underline-char))) (format stream "~a~%~a~%" text underline))) @@ -284,7 +327,11 @@ (let ((text (first (html-utils:children node)))) (if trim (trim text) - text)))) + text))) + (linkify (link-name link-value) + (if (gemini-link-uri-p link-value) + (format nil "~a~a~%" (link-prefix-gemini theme) link-name) + (format nil "~a~a~%" (link-prefix-other theme) link-name)))) (with-output-to-string (stream) (loop for node in parsed-gemini do (cond @@ -294,25 +341,25 @@ (format stream "~a~%" (text-value node))) ((html-utils:tag= :h1 node) (underlineize stream - (text-value node) + (header-prefix-h1 (text-value node)) +h1-underline+)) ((html-utils:tag= :h2 node) (underlineize stream - (text-value node) + (header-prefix-h2 (text-value node)) +h2-underline+)) ((html-utils:tag= :h1 node) (underlineize stream - (text-value node) + (header-prefix-h3 (text-value node)) +h3-underline+)) ((html-utils:tag= :li node) (format stream "~a ~a~%" - +bullet-line-prefix+ + (bullet-prefix theme) (text-value node))) ((html-utils:tag= :quote node) (format stream "~a ~a~%" - +quote-line-prefix+ + (quote-prefix theme) (text-value node))) ((html-utils:tag= :pre node) (write-sequence (text-value node :trim nil) stream)) @@ -321,8 +368,8 @@ (link-value (html-utils:attribute-value (html-utils:find-attribute :href node)))) (if link-name - (format stream "[~a]~%" link-name) - (format stream "[~a]~%" link-value))))))))) + (write-string (linkify link-name link-value) stream) + (write-string (linkify link-value link-value) stream))))))))) (defun parse-gemini-file (data) (parse 'gemini-file (strcat data (string #\Newline)) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index e315d2c..ed9caa0 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -47,6 +47,14 @@ :absolutize-link :make-gemini-uri :sexp->links + :gemini-page-theme + :link-prefix-gemini + :link-prefix-other + :h1-prefix + :h2-prefix + :h3-prefix + :quote-prefix + :bullet-prefix :sexp->text :parse-gemini-response-header :gemini-uri-p)) @@ -76,4 +84,5 @@ :response-sensitive-input-p :response-redirect-p :absolute-url-p + :init-default-gemini-theme :request)) diff --git a/src/main.lisp b/src/main.lisp index 64c6c1d..0ea008d 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -101,6 +101,7 @@ etc.) happened" (res:init) (load-configuration-files) (init-db) + (gemini-client:init-default-gemini-theme) (db-utils:with-ready-database (:connect nil) (modules:load-module +starting-init-file+) ;; init main window for first... diff --git a/src/package.lisp b/src/package.lisp index a82ac9a..b4e2e3b 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -950,6 +950,14 @@ :parse :load-config-file :external-editor + :gemini-link-prefix-to-gemini + :gemini-link-prefix-to-other + :gemini-quote-prefix + :gemini-quote-prefix + :gemini-h1-prefix + :gemini-h2-prefix + :gemini-h3-prefix + :gemini-bullet-prefix :signature-file-path :vote-vertical-bar :crypted-mark-value diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 65b56d1..3cc4eaa 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -332,6 +332,14 @@ prefix postfix value + scheme + link + quote + h1 + h2 + h3 + bullet + other attribute new-message mark @@ -372,6 +380,7 @@ open-message-link-window command-window command-separator + gemini tree branch arrow @@ -435,13 +444,54 @@ ;;;; interface +(defun gemini-link-prefix (scheme) + (access:accesses *software-configuration* + +key-gemini+ + +key-link+ + +key-scheme+ + scheme + +key-prefix+)) + +(defun gemini-link-prefix-to-gemini () + (gemini-link-prefix +key-gemini+)) + +(defun gemini-link-prefix-to-other () + (gemini-link-prefix +key-other+)) + +(defun gemini-quote-prefix () + (access:accesses *software-configuration* + +key-gemini+ + +key-quote+ + +key-prefix+)) + + +(defun gemini-h*-prefix (level) + (access:accesses *software-configuration* + +key-gemini+ + level + +key-prefix+)) + +(defun gemini-h1-prefix () + (gemini-h*-prefix +key-h1+)) + +(defun gemini-h2-prefix () + (gemini-h*-prefix +key-h2+)) + +(defun gemini-h3-prefix () + (gemini-h*-prefix +key-h3+)) + +(defun gemini-bullet-prefix () + (access:accesses *software-configuration* + +key-gemini+ + +key-bullet+ + +key-prefix+)) + (defun signature-file-path () "Returns the filepath of the signature file, the $HOME is prepended." (let* ((signature-file (or (access:accesses *software-configuration* +key-signature-file+) +default-signature-filename+)) - (signature-path (fs:cat-parent-dir (fs:home-dir) - signature-file))) + (signature-path (fs:cat-parent-dir (fs:home-dir) signature-file))) (if (fs:file-exists-p signature-path) signature-path nil))) diff --git a/tinmop.asd b/tinmop.asd index 69d6896..6710a15 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -76,15 +76,15 @@ (:file "x509") (:file "db-utils") (:file "db") + (:file "date-formatter") + (:file "emoji-shortcodes") + (:file "software-configuration") + (:file "tui-utils") (:module gemini :components ((:file "package") (:file "gemini-constants") (:file "gemini-parser") (:file "client"))) - (:file "date-formatter") - (:file "emoji-shortcodes") - (:file "software-configuration") - (:file "tui-utils") (:file "command-line") (:file "specials") (:file "complete")