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")