diff --git a/src/follow-requests.lisp b/src/follow-requests.lisp index 8d45560..b60ceb5 100644 --- a/src/follow-requests.lisp +++ b/src/follow-requests.lisp @@ -128,8 +128,8 @@ requeste that are not be erased from the window (see the class row-oriented-widget)" (with-accessors ((all-accounts requests)) specials:*follow-requests-window* - (let* ((accepted-usernames (line-oriented-window:map-rows #'normal-text - specials:*follow-requests-window*)) + (let* ((accepted-usernames (line-oriented-window:map-rows specials:*follow-requests-window* + #'normal-text)) (accepted-accounts (remove-if-not (lambda (acc) (find-if (lambda (a) (string= a diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 6ad398b..cd34b53 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -384,87 +384,109 @@ :initarg :size :accessor size))) +(defclass header-line (with-group-id with-lines) + ((level + :initform nil + :initarg :level + :accessor level))) + +(defun make-header-line (text gid level) + (make-instance 'header-line + :lines (list text) + :group-id gid + :level level)) + (defun sexp->text-rows (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 (text underline-char) - (let* ((size (length text)) - (underline (build-string size underline-char))) - (format nil"~a~%~a~%" text underline))) - (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) - (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))) - (fit-quote-lines (line win-width) - (let* ((justified (flush-left-mono-text (split-words line) - (- win-width - (length (quote-prefix theme))))) - (lines (mapcar (lambda (a) (strcat (quote-prefix theme) a)) - justified))) - (make-quoted-lines (join-with-strings lines (format nil "~%"))))) - (pre-alt-text (node) - (trim (html-utils:attribute-value (html-utils:find-attribute :alt node))))) - (let ((win-width (message-window:viewport-width (viewport theme))) - (pre-group-id -1) - (pre-alt-text "")) - (loop for node in parsed-gemini collect - (cond - ((null node) - (make-instance 'vertical-space)) ;(format nil "~%")) - ((html-utils:tag= :as-is node) - (let* ((truncated-line (safe-subseq (text-value node) 0 (1- win-width))) - (fg (preformatted-fg theme)) - (line (tui:make-tui-string (format nil "~a" truncated-line) - :fgcolor fg))) - (make-pre-line (list line) pre-group-id pre-alt-text))) - ((html-utils:tag= :text node) - (format nil "~a~%" (text-value node))) - ((html-utils:tag= :h1 node) - (underlineize (header-prefix-h1 (text-value node)) - +h1-underline+)) - ((html-utils:tag= :h2 node) - (underlineize (header-prefix-h2 (text-value node)) - +h2-underline+)) - ((html-utils:tag= :h3 node) - (underlineize (header-prefix-h3 (text-value node)) - +h3-underline+)) - ((html-utils:tag= :li node) - (format nil - "~a ~a~%" - (bullet-prefix theme) - (text-value node))) - ((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))) - (incf pre-group-id) - (setf pre-alt-text current-alt-text) - (make-pre-start current-alt-text pre-group-id))) - ((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)))) - (if link-name - (linkify link-name link-value) - (linkify link-value link-value)))) - (t - (break))))))) + (let ((win-width (message-window:viewport-width (viewport theme))) + (pre-group-id -1) + (header-group-id -1) + (pre-alt-text "")) + (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))) + (incf 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) + (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))) + (fit-quote-lines (line win-width) + (let* ((justified (flush-left-mono-text (split-words line) + (- win-width + (length (quote-prefix theme))))) + (lines (mapcar (lambda (a) (strcat (quote-prefix theme) a)) + justified))) + (make-quoted-lines (join-with-strings lines (format nil "~%"))))) + (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)) ;(format nil "~%")) + ((html-utils:tag= :as-is node) + (let* ((truncated-line (safe-subseq (text-value node) 0 (1- win-width))) + (fg (preformatted-fg theme)) + (line (tui:make-tui-string (format nil "~a" truncated-line) + :fgcolor fg))) + (make-pre-line (list line) pre-group-id pre-alt-text))) + ((html-utils:tag= :text node) + (format nil "~a~%" (text-value node))) + ((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) + (format nil + "~a ~a~%" + (bullet-prefix theme) + (text-value node))) + ((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))) + (incf pre-group-id) + (setf pre-alt-text current-alt-text) + (make-pre-start current-alt-text pre-group-id))) + ((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)))) + (if link-name + (linkify link-name link-value) + (linkify link-value link-value)))))))) + (flatten (build-rows))))) (defun sexp->text (parsed-gemini theme) (labels ((header-prefix (prefix header) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index edaf253..7e3f9ef 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -64,6 +64,7 @@ :h3-prefix :quote-prefix :bullet-prefix + :with-lines :pre-start :value :pre-line @@ -74,6 +75,8 @@ :quoted-lines :lines :vertical-space + :header-line + :level :sexp->text-rows :sexp->text :parse-gemini-response-header diff --git a/src/message-window.lisp b/src/message-window.lisp index c0acef4..87abff0 100644 --- a/src/message-window.lisp +++ b/src/message-window.lisp @@ -149,6 +149,16 @@ (defun row-get-original-object (line) (getf (fields line) :original-object)) +(defun row-add-group-id (line group-id) + (push group-id + (fields line)) + (push :group-id + (fields line)) + line) + +(defun row-get-group-id (line) + (getf (fields line) :group-id)) + (defun make-render-vspace-row (&optional (original-object (make-instance 'gemini-parser:vertical-space))) (let ((res (make-instance 'line @@ -277,13 +287,27 @@ (defmethod text->rendered-lines-rows (window (text complex-string)) text) -(defmethod text->rendered-lines-rows (window (text gemini-parser:quoted-lines)) - (let ((colorized-lines (colorize-lines (gemini-parser:lines text)))) +(defgeneric collect-lines-from-ir (object)) + +(defmethod collect-lines-from-ir ((object gemini-parser:with-lines)) + (let ((colorized-lines (colorize-lines (gemini-parser:lines object)))) (loop for i in colorized-lines collect (make-instance 'line :normal-text i)))) +(defmethod text->rendered-lines-rows (window (text gemini-parser:quoted-lines)) + (collect-lines-from-ir text)) + +(defmethod text->rendered-lines-rows (window (text gemini-parser:header-line)) + (let* ((group-id (gemini-parser:group-id text)) + (lines (collect-lines-from-ir text)) + (res (mapcar (lambda (a) + (let ((line (row-add-original-object a text))) + (row-add-group-id line group-id))) + lines))) + res)) + (defmethod text->rendered-lines-rows (window (text string)) (labels ((fit-lines (lines) (let ((res ()))