From 9e3269576d117a4fdbae32c1176c506d35970468 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 3 Apr 2021 15:03:24 +0200 Subject: [PATCH] - [gemini] improved rendering of quoted text. --- src/gemini/client.lisp | 3 +- src/gemini/gemini-parser.lisp | 98 +++++++++++++++++++---------------- src/main.lisp | 2 +- src/message-window.lisp | 29 ++++++----- src/package.lisp | 3 +- src/program-events.lisp | 6 +-- 6 files changed, 79 insertions(+), 62 deletions(-) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index adbb34e..5351883 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -181,9 +181,10 @@ (defparameter *gemini-page-theme* nil) -(defun init-default-gemini-theme () +(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) diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index a962659..09bcbe1 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -309,7 +309,11 @@ (bullet-prefix :initarg :bullet-prefix :initform +bullet-line-prefix+ - :accessor bullet-prefix))) + :accessor bullet-prefix) + (viewport + :initarg :viewport + :initform nil + :accessor viewport))) (defun sexp->text (parsed-gemini theme) (labels ((header-prefix (prefix header) @@ -317,9 +321,9 @@ (header-prefix-h1 (header) (header-prefix (h1-prefix theme) header)) (header-prefix-h2 (header) - (header-prefix (h2-prefix theme) header)) + (header-prefix (h2-prefix theme) header)) (header-prefix-h3 (header) - (header-prefix (h3-prefix theme) header)) + (header-prefix (h3-prefix theme) header)) (underlineize (stream text underline-char) (let* ((size (length text)) (underline (build-string size underline-char))) @@ -334,47 +338,53 @@ (linkify (link-name link-value) (if (gemini-link-iri-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 - ((null node) - (format stream "~%")) - ((html-utils:tag= :as-is node) - (format stream "~a~%" (text-value node))) - ((html-utils:tag= :text node) - (format stream "~a~%" (text-value node))) - ((html-utils:tag= :h1 node) - (underlineize stream - (header-prefix-h1 (text-value node)) - +h1-underline+)) - ((html-utils:tag= :h2 node) - (underlineize stream - (header-prefix-h2 (text-value node)) - +h2-underline+)) - ((html-utils:tag= :h3 node) - (underlineize stream - (header-prefix-h3 (text-value node)) - +h3-underline+)) - ((html-utils:tag= :li node) - (format stream - "~a ~a~%" - (bullet-prefix theme) - (text-value node))) - ((html-utils:tag= :quote node) - (format stream - "~a ~a~%" - (quote-prefix theme) - (text-value node))) - ((html-utils:tag= :pre node) - (write-sequence (text-value node :trim nil) stream)) - ((html-utils:tag= :a node) - (let ((link-name (text-value node :trim nil)) - (link-value (html-utils:attribute-value (html-utils:find-attribute :href - node)))) - (if link-name - (write-string (linkify link-name link-value) stream) - (write-string (linkify link-value link-value) stream))))))))) + (format nil "~a~a~%" (link-prefix-other theme) link-name))) + (fit-quote-lines (line win-width) + (join-with-strings (mapcar (lambda (a) (strcat (quote-prefix theme) a)) + (flush-left-mono-text (split-words line) + (- win-width + (length (quote-prefix theme))))) + (format nil "~%")))) + (let ((win-width (message-window:viewport-width (viewport theme)))) + (with-output-to-string (stream) + (loop for node in parsed-gemini do + (cond + ((null node) + (format stream "~%")) + ((html-utils:tag= :as-is node) + (format stream "~a~%" (text-value node))) + ((html-utils:tag= :text node) + (format stream "~a~%" (text-value node))) + ((html-utils:tag= :h1 node) + (underlineize stream + (header-prefix-h1 (text-value node)) + +h1-underline+)) + ((html-utils:tag= :h2 node) + (underlineize stream + (header-prefix-h2 (text-value node)) + +h2-underline+)) + ((html-utils:tag= :h3 node) + (underlineize stream + (header-prefix-h3 (text-value node)) + +h3-underline+)) + ((html-utils:tag= :li node) + (format stream + "~a ~a~%" + (bullet-prefix theme) + (text-value node))) + ((html-utils:tag= :quote node) + (write-sequence (fit-quote-lines (text-value node :trim nil) + win-width) + stream)) + ((html-utils:tag= :pre node) + (write-sequence (text-value node :trim nil) stream)) + ((html-utils:tag= :a node) + (let ((link-name (text-value node :trim nil)) + (link-value (html-utils:attribute-value (html-utils:find-attribute :href + node)))) + (if link-name + (write-string (linkify link-name link-value) stream) + (write-string (linkify link-value link-value) stream)))))))))) (defun parse-gemini-file (data) (let* ((was-raw-mode *raw-mode*) diff --git a/src/main.lisp b/src/main.lisp index 0036c07..22ece8b 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -119,7 +119,6 @@ etc.) happened" ;; (res:init) ;; (load-configuration-files) ;; (init-db) - (gemini-client:init-default-gemini-theme) (db-utils:with-ready-database (:connect nil) (complete:initialize-complete-username-cache) (modules:load-module +starting-init-file+) @@ -133,6 +132,7 @@ etc.) happened" ;; initialized after the latter (message-window:init) (tags-window:init) + (gemini-client:init-default-gemini-theme specials:*message-window*) (conversations-window:init) (setup-bindings) ;; ... and init-keyboard-mapping-for last diff --git a/src/message-window.lisp b/src/message-window.lisp index 7786f45..4c1fabd 100644 --- a/src/message-window.lisp +++ b/src/message-window.lisp @@ -137,18 +137,18 @@ (defgeneric search-regex (object regex)) (defun text->rendered-lines-rows (window text) - (flet ((fit-lines (lines) - (let ((res ())) - (loop for line in lines do - (if (string-empty-p line) - (push nil res) - (loop - for fitted-line in - (flush-left-mono-text (split-words line) - (win-width-no-border window)) - do - (push fitted-line res)))) - (reverse res)))) + (labels ((fit-lines (lines) + (let ((res ())) + (loop for line in lines do + (if (string-empty-p line) + (push nil res) + (loop + for fitted-line in + (flush-left-mono-text (split-words line) + (win-width-no-border window)) + do + (push fitted-line res)))) + (reverse res)))) (let* ((lines (split-lines text)) (fitted-lines (fit-lines lines)) (color-re (swconf:color-regexps)) @@ -279,3 +279,8 @@ (refresh-config *message-window*) (draw *message-window*) *message-window*)) + +(defgeneric viewport-width (object)) + +(defmethod viewport-width ((object message-window)) + (windows:win-width-no-border object)) diff --git a/src/package.lisp b/src/package.lisp index 99531ab..b82f123 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1926,7 +1926,8 @@ :scroll-next-page :scroll-previous-page :search-regex - :init)) + :init + :viewport-width)) (defpackage :open-attach-window (:use diff --git a/src/program-events.lisp b/src/program-events.lisp index 3a10802..1565fba 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -1122,9 +1122,9 @@ (text-rendering-theme gemini-client:text-rendering-theme)) response (when (and (gemini-viewer:downloading-allowed-p wrapper-object) (not (skip-rendering-p object))) - (let* ((win specials:*message-window*) - (rendered-line (gemini-parser:sexp->text parsed-file - text-rendering-theme))) + (let* ((win specials:*message-window*) + (rendered-line (gemini-parser:sexp->text parsed-file + text-rendering-theme))) (setf (windows:keybindings win) keybindings:*gemini-message-keymap*) (refresh-gemini-message-window links source rendered-line append-text)