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.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 = "🞎 "

16
etc/shared.conf
View File

@ -81,6 +81,22 @@ color-regexp = "⯀" green 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
# signature-file = ".signature"

1
src/command-line.lisp
View File

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

17
src/gemini/client.lisp
View File

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

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

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

9
src/gemini/package.lisp
View File

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

1
src/main.lisp
View File

@ -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...

8
src/package.lisp
View File

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

54
src/software-configuration.lisp
View File

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

8
tinmop.asd
View File

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