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

- [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'.
This commit is contained in:
cage 2020-07-08 18:34:48 +02:00
parent bfc3fbfb97
commit c84de306c8
10 changed files with 195 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
etc/default-theme.conf
View File

@ -453,3 +453,19 @@ open-message-link-window.foreground = #FEB200
open-message-link-window.input.selected.background = black open-message-link-window.input.selected.background = black
open-message-link-window.input.selected.foreground = #FFB200 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 = "🞎 "

50
etc/shared.conf
View File

@ -1,11 +1,11 @@
# a line starting with a '#' is a comment # a line starting with a '#' is a comment
# The server instance name # The server instance name
# add this entry to your file (the one in your home) # add this entry to your file (the one in your home)
# server = test.server.org # server = test.server.org
# your username # your username
# add this entry to your file (the one in your home) # add this entry to your file (the one in your home)
# username = username # username = username
# theme # theme
@ -25,17 +25,17 @@ use "default-theme.conf"
#max-report-comment-length = 100 #max-report-comment-length = 100
# Character to use when replying to a message # 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 # delete the command history entries that are older than this number
# of days # of days
purge-history-days-offset = -7 purge-history-days-offset = -7
# delete the cache entries that are older than this number of days # 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 # 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 # color parts of a displayed message according to a regular expression
# syntax is regular expression color attribute # syntax is regular expression color attribute
@ -59,27 +59,43 @@ editor = "nano --locking"
# Some examples follows, order matters! # 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 # the signature file path relative to $HOME

1
src/command-line.lisp
View File

@ -63,7 +63,6 @@
(:name :notify-mentions (:name :notify-mentions
:description (_ "Notify messages that mentions the user") :description (_ "Notify messages that mentions the user")
:short #\m :short #\m
:arg-parser #'identity
:long "notify-mentions") :long "notify-mentions")
(:name :open-gemini-url (:name :open-gemini-url
:description (_ "Open gemini url") :description (_ "Open gemini url")

17
src/gemini/client.lisp
View File

@ -167,7 +167,20 @@
(host condition)))) (host condition))))
(:documentation "The condition signalled when tofu failed")) (: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) (let* ((header-raw (misc:list->array (loop for c = (read-byte stream)
while (/= c 10) while (/= c 10)
collect c) collect c)
@ -195,7 +208,7 @@
"-> ~a://~a:~a~a~2%~a" "-> ~a://~a:~a~a~2%~a"
+gemini-scheme+ +gemini-scheme+
host port path host port path
(sexp->text parsed)) (sexp->text parsed theme))
(sexp->links parsed host port path))) (sexp->links parsed host port path)))
(results +20+ body)))) (results +20+ body))))
((or (header-input-request-p parsed-header) ((or (header-input-request-p parsed-header)

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

@ -273,8 +273,51 @@
original-path) original-path)
:name (tag-value node))))) :name (tag-value node)))))
(defun sexp->text (parsed-gemini) (defun gemini-link-uri-p (uri)
(labels ((underlineize (stream text underline-char) (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)) (let* ((size (length text))
(underline (build-string size underline-char))) (underline (build-string size underline-char)))
(format stream "~a~%~a~%" text underline))) (format stream "~a~%~a~%" text underline)))
@ -284,7 +327,11 @@
(let ((text (first (html-utils:children node)))) (let ((text (first (html-utils:children node))))
(if trim (if trim
(trim text) (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) (with-output-to-string (stream)
(loop for node in parsed-gemini do (loop for node in parsed-gemini do
(cond (cond
@ -294,25 +341,25 @@
(format stream "~a~%" (text-value node))) (format stream "~a~%" (text-value node)))
((html-utils:tag= :h1 node) ((html-utils:tag= :h1 node)
(underlineize stream (underlineize stream
(text-value node) (header-prefix-h1 (text-value node))
+h1-underline+)) +h1-underline+))
((html-utils:tag= :h2 node) ((html-utils:tag= :h2 node)
(underlineize stream (underlineize stream
(text-value node) (header-prefix-h2 (text-value node))
+h2-underline+)) +h2-underline+))
((html-utils:tag= :h1 node) ((html-utils:tag= :h1 node)
(underlineize stream (underlineize stream
(text-value node) (header-prefix-h3 (text-value node))
+h3-underline+)) +h3-underline+))
((html-utils:tag= :li node) ((html-utils:tag= :li node)
(format stream (format stream
"~a ~a~%" "~a ~a~%"
+bullet-line-prefix+ (bullet-prefix theme)
(text-value node))) (text-value node)))
((html-utils:tag= :quote node) ((html-utils:tag= :quote node)
(format stream (format stream
"~a ~a~%" "~a ~a~%"
+quote-line-prefix+ (quote-prefix theme)
(text-value node))) (text-value node)))
((html-utils:tag= :pre node) ((html-utils:tag= :pre node)
(write-sequence (text-value node :trim nil) stream)) (write-sequence (text-value node :trim nil) stream))
@ -321,8 +368,8 @@
(link-value (html-utils:attribute-value (html-utils:find-attribute :href (link-value (html-utils:attribute-value (html-utils:find-attribute :href
node)))) node))))
(if link-name (if link-name
(format stream "[~a]~%" link-name) (write-string (linkify link-name link-value) stream)
(format stream "[~a]~%" link-value))))))))) (write-string (linkify link-value link-value) stream)))))))))
(defun parse-gemini-file (data) (defun parse-gemini-file (data)
(parse 'gemini-file (strcat data (string #\Newline)) (parse 'gemini-file (strcat data (string #\Newline))

9
src/gemini/package.lisp
View File

@ -47,6 +47,14 @@
:absolutize-link :absolutize-link
:make-gemini-uri :make-gemini-uri
:sexp->links :sexp->links
:gemini-page-theme
:link-prefix-gemini
:link-prefix-other
:h1-prefix
:h2-prefix
:h3-prefix
:quote-prefix
:bullet-prefix
:sexp->text :sexp->text
:parse-gemini-response-header :parse-gemini-response-header
:gemini-uri-p)) :gemini-uri-p))
@ -76,4 +84,5 @@
:response-sensitive-input-p :response-sensitive-input-p
:response-redirect-p :response-redirect-p
:absolute-url-p :absolute-url-p
:init-default-gemini-theme
:request)) :request))

1
src/main.lisp
View File

@ -101,6 +101,7 @@ etc.) happened"
(res:init) (res:init)
(load-configuration-files) (load-configuration-files)
(init-db) (init-db)
(gemini-client:init-default-gemini-theme)
(db-utils:with-ready-database (:connect nil) (db-utils:with-ready-database (:connect nil)
(modules:load-module +starting-init-file+) (modules:load-module +starting-init-file+)
;; init main window for first... ;; init main window for first...

8
src/package.lisp
View File

@ -950,6 +950,14 @@
:parse :parse
:load-config-file :load-config-file
:external-editor :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 :signature-file-path
:vote-vertical-bar :vote-vertical-bar
:crypted-mark-value :crypted-mark-value

54
src/software-configuration.lisp
View File

@ -332,6 +332,14 @@
prefix prefix
postfix postfix
value value
scheme
link
quote
h1
h2
h3
bullet
other
attribute attribute
new-message new-message
mark mark
@ -372,6 +380,7 @@
open-message-link-window open-message-link-window
command-window command-window
command-separator command-separator
gemini
tree tree
branch branch
arrow arrow
@ -435,13 +444,54 @@
;;;; interface ;;;; 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 () (defun signature-file-path ()
"Returns the filepath of the signature file, the $HOME is prepended." "Returns the filepath of the signature file, the $HOME is prepended."
(let* ((signature-file (or (access:accesses *software-configuration* (let* ((signature-file (or (access:accesses *software-configuration*
+key-signature-file+) +key-signature-file+)
+default-signature-filename+)) +default-signature-filename+))
(signature-path (fs:cat-parent-dir (fs:home-dir) (signature-path (fs:cat-parent-dir (fs:home-dir) signature-file)))
signature-file)))
(if (fs:file-exists-p signature-path) (if (fs:file-exists-p signature-path)
signature-path signature-path
nil))) nil)))

8
tinmop.asd
View File

@ -76,15 +76,15 @@
(:file "x509") (:file "x509")
(:file "db-utils") (:file "db-utils")
(:file "db") (:file "db")
(:file "date-formatter")
(:file "emoji-shortcodes")
(:file "software-configuration")
(:file "tui-utils")
(:module gemini (:module gemini
:components ((:file "package") :components ((:file "package")
(:file "gemini-constants") (:file "gemini-constants")
(:file "gemini-parser") (:file "gemini-parser")
(:file "client"))) (:file "client")))
(:file "date-formatter")
(:file "emoji-shortcodes")
(:file "software-configuration")
(:file "tui-utils")
(:file "command-line") (:file "command-line")
(:file "specials") (:file "specials")
(:file "complete") (:file "complete")