From e5f93bd632f32c1e4e2dcb25e2fa92e082fbdc35 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 17 Jul 2021 12:13:04 +0200 Subject: [PATCH] - [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'. --- etc/default-theme.conf | 6 +++++ etc/shared.conf | 7 ----- modules/rewrite-message-urls.lisp | 2 +- src/gemini/client.lisp | 25 +++++++++++------- src/gemini/gemini-parser.lisp | 44 ++++++++++++++++++++++++------- src/gemini/package.lisp | 1 + src/message-window.lisp | 7 ++--- src/package.lisp | 1 + src/software-configuration.lisp | 14 ++++++++++ src/tui-utils.lisp | 40 ++++++++++++++-------------- 10 files changed, 97 insertions(+), 50 deletions(-) diff --git a/etc/default-theme.conf b/etc/default-theme.conf index 92cd6d0..bb5088f 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -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 = "➶ " diff --git a/etc/shared.conf b/etc/shared.conf index 7e58dee..a4d5a9e 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -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 diff --git a/modules/rewrite-message-urls.lisp b/modules/rewrite-message-urls.lisp index 8235adb..49fcdd4 100644 --- a/modules/rewrite-message-urls.lisp +++ b/modules/rewrite-message-urls.lisp @@ -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)))))))) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index bd909b1..385721d 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -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 diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 10dbe1c..b3c56a4 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -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)) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index 4f96872..d78c787 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -84,6 +84,7 @@ :level :unordered-list-line :link-line + :link-text :sexp->text-rows :sexp->text :parse-gemini-response-header diff --git a/src/message-window.lisp b/src/message-window.lisp index 773bc12..e381686 100644 --- a/src/message-window.lisp +++ b/src/message-window.lisp @@ -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 diff --git a/src/package.lisp b/src/package.lisp index 50bbb30..f81f8b2 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 3b7eff9..b9ee8bf 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -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+ diff --git a/src/tui-utils.lisp b/src/tui-utils.lisp index 41f0e91..8c674de 100644 --- a/src/tui-utils.lisp +++ b/src/tui-utils.lisp @@ -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))