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

- [gemini] removed link prefix for link labels that starts with an emoji; 

- [gemini] removed splitting of long link labels;
- fixed output stream of 'print-debug'.
This commit is contained in:
cage 2021-07-17 12:13:04 +02:00
parent 2015066c61
commit e5f93bd632
10 changed files with 97 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
etc/default-theme.conf
View File

@ -512,6 +512,12 @@ gemini.downloading.animation = "🕐 🕑 🕒 🕓 🕔
gemini.favicon = "🌍"
#gemini.link.background = white
gemini.link.foreground = magenta
gemini.link.attribute = bold
gemini.link.scheme.gemini.prefix = "→ "
gemini.link.scheme.other.prefix = "➶ "

7
etc/shared.conf
View File

@ -110,13 +110,6 @@ color-regexp = "[012][0-9]:[0123456][0-9]" cyan bold
# gemini colorization
# gemini links
color-regexp = "→ .+" blue bold
# non gemini links
color-regexp = "➶ .+" magenta bold
# header level 1
color-regexp = "^🞂.*" white bold

2
modules/rewrite-message-urls.lisp
View File

@ -77,7 +77,7 @@ So the whole list is like: '((\"foo\" \"bar\") (\"old\" \"new\") ...)")
(setf replaced-string
(rewriting-link-replace-mapping mapping replaced-string)))
(setf (line-oriented-window:normal-text row)
(message-window::colorize-lines replaced-string))
(tui:apply-coloring original-string replaced-string))
(setf (elt rows index)
(message-window:text->rendered-lines-rows window row))))))))

25
src/gemini/client.lisp
View File

@ -183,16 +183,21 @@
(defun init-default-gemini-theme (viewport)
(setf *gemini-page-theme*
(make-instance 'gemini-parser:gemini-page-theme
:viewport viewport
: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)
:preformatted-fg (swconf:gemini-preformatted-fg))))
(multiple-value-bind (link-bg link-fg link-attributes)
(swconf:gemini-link-colors)
(make-instance 'gemini-parser:gemini-page-theme
:viewport viewport
:link-prefix-other (swconf:gemini-link-prefix-to-other)
:link-prefix-gemini (swconf:gemini-link-prefix-to-gemini)
:link-bg link-bg
:link-fg link-fg
:link-attributes link-attributes
: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)
:preformatted-fg (swconf:gemini-preformatted-fg)))))
(defclass gemini-file-response ()
((status-code

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

@ -339,6 +339,18 @@
:initarg :link-prefix-other
:initform "^ "
:accessor link-prefix-other)
(link-bg
:initarg :link-bg
:initform :red
:accessor link-bg)
(link-fg
:initarg :link-fg
:initform :yellow
:accessor link-fg)
(link-attributes
:initarg :link-attributes
:initform (tui:attribute-underline)
:accessor link-attributes)
(h1-prefix
:initarg :h1-prefix
:initform "+ "
@ -448,8 +460,12 @@
(make-instance 'unordered-list-line
:lines (list text)))
(defclass link-line (with-lines)
((link-name
(defclass link-line ()
((link-text
:initarg :link-text
:initform nil
:accessor link-text)
(link-name
:initarg :link-name
:initform nil
:accessor link-name)
@ -458,9 +474,9 @@
:initform nil
:accessor link-value)))
(defun make-link-line (text link-name link-value)
(defun make-link-line (link-text link-name link-value)
(make-instance 'link-line
:lines (list text)
:link-text link-text
:link-name link-name
:link-value link-value))
@ -491,11 +507,21 @@
(trim text)
text)))
(linkify (link-name link-value)
(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 (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))))
(tui:make-tui-string raw-link-text
:attributes (link-attributes theme)
:fgcolor (link-fg theme)
:bgcolor (link-bg theme))))
(fit-quote-lines (line win-width)
(let* ((words (split-words line))
(quote-prefix (quote-prefix theme))

1
src/gemini/package.lisp
View File

@ -84,6 +84,7 @@
:level
:unordered-list-line
:link-line
:link-text
:sexp->text-rows
:sexp->text
:parse-gemini-response-header

7
src/message-window.lisp
View File

@ -370,9 +370,10 @@
(defmethod text->rendered-lines-rows (window (text complex-string))
text)
(defgeneric collect-lines-from-ir (object window))
(defgeneric collect-lines-from-ir (object window &key &allow-other-keys))
(defmethod collect-lines-from-ir ((object gemini-parser:with-lines) (window message-window))
(defmethod collect-lines-from-ir ((object gemini-parser:with-lines) (window message-window)
&key &allow-other-keys)
(let ((colorized-lines (colorize-lines (%fit-lines window (gemini-parser:lines object)))))
(loop for i in colorized-lines
collect
@ -395,7 +396,7 @@
(collect-lines-from-ir text window))
(defmethod text->rendered-lines-rows (window (text gemini-parser:link-line))
(let ((res (collect-lines-from-ir text window)))
(let ((res (make-instance 'line :normal-text (gemini-parser:link-text text))))
(row-add-original-object res text)
res)) ; even if row-add-original-object returns the modified line explicit returns for clarity

1
src/package.lisp
View File

@ -1116,6 +1116,7 @@
:gemini-default-favicon
:directory-symbol
:gemini-fetch-favicon-p
:gemini-link-colors
:gemini-link-prefix-to-gemini
:gemini-link-prefix-to-other
:gemini-quote-prefix

14
src/software-configuration.lisp
View File

@ -588,6 +588,20 @@
+key-favicon+)))
(db-utils:db-not-nil-p fetchp)))
(defun gemini-link-colors ()
(values (access:accesses *software-configuration*
+key-gemini+
+key-link+
+key-background+)
(access:accesses *software-configuration*
+key-gemini+
+key-link+
+key-foreground+)
(tui-utils:text->tui-attribute (access:accesses *software-configuration*
+key-gemini+
+key-link+
+key-attribute+))))
(defun gemini-link-prefix (scheme)
(access-non-null-conf-value *software-configuration*
+key-gemini+

40
src/tui-utils.lisp
View File

@ -391,25 +391,25 @@ latter has a length equals to `total-size'"))
(last-char-bg (bgcolor last-char-from))
(last-char-attr (attributes last-char-from)))
(with-accessors ((complex-char-array-to complex-char-array)) res
(loop
for from-char across complex-char-array-from
for to-char across complex-char-array-to
do
(setf (attributes to-char)
(attributes from-char))
(setf (fgcolor to-char)
(fgcolor from-char))
(setf (bgcolor to-char)
(bgcolor from-char)))
(when (> length-diff 0)
(loop for i from length-diff below (length to) do
(let ((char (elt complex-char-array-to i)))
(setf (attributes char)
last-char-attr)
(setf (fgcolor char)
last-char-fg)
(setf (bgcolor char)
last-char-bg))))
(loop
for from-char across complex-char-array-from
for to-char across complex-char-array-to
do
(setf (attributes to-char)
(attributes from-char))
(setf (fgcolor to-char)
(fgcolor from-char))
(setf (bgcolor to-char)
(bgcolor from-char)))
(when (> length-diff 0)
(loop for i from length-diff below (length to) do
(let ((char (elt complex-char-array-to i)))
(setf (attributes char)
last-char-attr)
(setf (fgcolor char)
last-char-fg)
(setf (bgcolor char)
last-char-bg))))
res))))
(defmethod remove-corrupting-utf8-chars ((object complex-string))
@ -440,7 +440,7 @@ latter has a length equals to `total-size'"))
(defmethod print-debug ((object complex-string) &optional (stream *standard-output*))
(print-unreadable-object (object stream :type t :identity nil)
(loop for i across (complex-char-array object) do
(print-debug i))))
(print-debug i stream))))
(defun standard-error-notify-life ()
(* (swconf:config-notification-life) 5))