diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 34cb077..60fa9bc 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -427,12 +427,17 @@ (defun make-pre-end () (make-instance 'pre-end)) -(defclass quoted-lines (with-group-id with-lines) ()) +(defclass quoted-lines (with-group-id with-lines) + ((prefix + :initform "@ " + :initarg :prefix + :accessor prefix))) -(defun make-quoted-lines (text-lines group-id) +(defun make-quoted-lines (text group-id prefix) (make-instance 'quoted-lines - :group-id group-id - :lines (split-lines text-lines))) + :prefix prefix + :group-id group-id + :lines (list text))) (defclass pre-line (with-group-id with-pre-group-id with-lines with-alt-text) ()) @@ -509,122 +514,110 @@ :group-id header-group-id)) (defun sexp->text-rows (parsed-gemini theme) - (let ((win-width (message-window:viewport-width (viewport 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)) - (build-underline (text underline-char) - (let* ((size (length text)) - (underline (build-string size underline-char))) - underline)) - (make-header (level text underline-char) - (let ((underline (build-underline text underline-char)) - (header-group-id (next-header-group-id))) - (list (make-header-line text header-group-id level) - (make-header-line underline header-group-id level)))) - (trim (a) - (trim-blanks a)) - (text-value (node &key (trim t)) - (let ((text (first (html-utils:children node)))) - (if trim - (trim text) - text))) - (linkify (link-name link-value) - (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)) - (justified (flush-left-mono-text words - (- win-width - (length quote-prefix)))) - (lines (if justified - (mapcar (lambda (a) (strcat quote-prefix a)) - justified) - quote-prefix)) - (header-group-id (current-header-group-id))) - (make-quoted-lines (join-with-strings lines (format nil "~%")) - header-group-id))) - (pre-alt-text (node) - (trim (html-utils:attribute-value (html-utils:find-attribute :alt node)))) - (build-rows () - (loop for node in parsed-gemini - collect - (cond - ((null node) - (make-instance 'vertical-space - :group-id (current-header-group-id))) ;(format nil "~%")) - ((html-utils:tag= :as-is node) - (let* ((line (text-value node :trim nil)) - (fg (preformatted-fg theme)) - (line (tui:make-tui-string (format nil "~a" line) - :fgcolor fg))) - (make-pre-line (list line) - (current-header-group-id) - (current-pre-group-id) - (current-pre-alt-text)))) - ((html-utils:tag= :text node) - (make-simple-line (format nil "~a~%" (text-value node)) - (current-header-group-id))) - ((html-utils:tag= :h1 node) - (make-header 1 - (header-prefix-h1 (text-value node)) - +h1-underline+)) - ((html-utils:tag= :h2 node) - (make-header 2 - (header-prefix-h2 (text-value node)) - +h2-underline+)) - ((html-utils:tag= :h3 node) - (make-header 3 - (header-prefix-h3 (text-value node)) - +h3-underline+)) - ((html-utils:tag= :li node) - (let ((text (format nil - "~a ~a" - (bullet-prefix theme) - (text-value node)))) - (make-unordered-list-line text (current-header-group-id)))) - ((html-utils:tag= :quote node) - (fit-quote-lines (text-value node :trim nil) - win-width)) - ((html-utils:tag= :pre node) - (let ((current-alt-text (pre-alt-text node)) - (pre-group-id (next-pre-group-id)) - (current-group-id (current-header-group-id)) - (fg (preformatted-fg theme))) - (set-pre-alt-text current-alt-text) - (make-pre-start current-alt-text current-group-id pre-group-id fg))) - ((html-utils:tag= :pre-end node) - (make-pre-end)) - ((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))) - (link-text (if link-name - (linkify link-name link-value) - (linkify link-value link-value))) - (header-group-id (current-header-group-id))) - (make-link-line link-text link-name link-value header-group-id))))))) - (flatten (build-rows))))) + (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)) + (build-underline (text underline-char) + (let* ((size (length text)) + (underline (build-string size underline-char))) + underline)) + (make-header (level text underline-char) + (let ((underline (build-underline text underline-char)) + (header-group-id (next-header-group-id))) + (list (make-header-line text header-group-id level) + (make-header-line underline header-group-id level)))) + (trim (a) + (trim-blanks a)) + (text-value (node &key (trim t)) + (let ((text (first (html-utils:children node)))) + (if trim + (trim text) + text))) + (linkify (link-name link-value) + (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)))) + (pre-alt-text (node) + (trim (html-utils:attribute-value (html-utils:find-attribute :alt node)))) + (build-rows () + (loop for node in parsed-gemini + collect + (cond + ((null node) + (make-instance 'vertical-space + :group-id (current-header-group-id))) ;(format nil "~%")) + ((html-utils:tag= :as-is node) + (let* ((line (text-value node :trim nil)) + (fg (preformatted-fg theme)) + (line (tui:make-tui-string (format nil "~a" line) + :fgcolor fg))) + (make-pre-line (list line) + (current-header-group-id) + (current-pre-group-id) + (current-pre-alt-text)))) + ((html-utils:tag= :text node) + (make-simple-line (format nil "~a~%" (text-value node)) + (current-header-group-id))) + ((html-utils:tag= :h1 node) + (make-header 1 + (header-prefix-h1 (text-value node)) + +h1-underline+)) + ((html-utils:tag= :h2 node) + (make-header 2 + (header-prefix-h2 (text-value node)) + +h2-underline+)) + ((html-utils:tag= :h3 node) + (make-header 3 + (header-prefix-h3 (text-value node)) + +h3-underline+)) + ((html-utils:tag= :li node) + (let ((text (format nil + "~a ~a" + (bullet-prefix theme) + (text-value node)))) + (make-unordered-list-line text (current-header-group-id)))) + ((html-utils:tag= :quote node) + (let* ((line (text-value node :trim nil)) + (quote-prefix (quote-prefix theme)) + (header-group-id (current-header-group-id))) + (make-quoted-lines line header-group-id quote-prefix))) + ((html-utils:tag= :pre node) + (let ((current-alt-text (pre-alt-text node)) + (pre-group-id (next-pre-group-id)) + (current-group-id (current-header-group-id)) + (fg (preformatted-fg theme))) + (set-pre-alt-text current-alt-text) + (make-pre-start current-alt-text current-group-id pre-group-id fg))) + ((html-utils:tag= :pre-end node) + (make-pre-end)) + ((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))) + (link-text (if link-name + (linkify link-name link-value) + (linkify link-value link-value))) + (header-group-id (current-header-group-id))) + (make-link-line link-text link-name link-value header-group-id))))))) + (flatten (build-rows)))) (defun parse-gemini-file (data) (let* ((lines (if (string= (format nil "~%") data) diff --git a/src/message-window.lisp b/src/message-window.lisp index 607e4c3..5369266 100644 --- a/src/message-window.lisp +++ b/src/message-window.lisp @@ -374,8 +374,10 @@ (defgeneric collect-lines-from-ir (object window &key &allow-other-keys)) (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))))) + &key (width (win-width-no-border window)) &allow-other-keys) + (let ((colorized-lines (colorize-lines (%fit-lines window + (gemini-parser:lines object) + width)))) (loop for text in colorized-lines collect (let ((res-line (make-instance 'line @@ -386,7 +388,12 @@ res-line)))) (defmethod text->rendered-lines-rows (window (text gemini-parser:quoted-lines)) - (collect-lines-from-ir text window)) + (let* ((rows (collect-lines-from-ir text window :width (1- (win-width-no-border window))))) + (loop for row in rows do + (setf (normal-text row) + (colorize-lines (strcat (gemini-parser::prefix text) + (tui-string->chars-string (normal-text row)))))) + rows)) (defmethod text->rendered-lines-rows (window (text gemini-parser:header-line)) (collect-lines-from-ir text window)) @@ -404,7 +411,7 @@ (let ((lines (split-lines text))) (%fit-lines window lines))) -(defun %fit-lines (window lines) +(defun %fit-lines (window lines &optional (width (win-width-no-border window))) (let ((res ())) (loop for line in lines do (cond @@ -413,8 +420,7 @@ (push (make-render-vspace-row) res)) (t (loop for fitted-line - in (flush-left-mono-text (split-words line) - (win-width-no-border window)) + in (flush-left-mono-text (split-words line) width) do (push fitted-line res))))) (reverse res)))