;; tinmop: a multiprotocol client
;; Copyright © cage

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(in-package :message-window)

(define-constant +row-invisible-field-key+      :invisible      :test #'eq)

(define-constant +row-vertical-space-field-key+ :vertical-space :test #'eq)

(defclass message-window (wrapper-window
                          row-oriented-widget
                          focus-marked-window
                          metadata-container
                          title-window)
  ((line-position-mark
    :initform (make-tui-string "0")
    :initarg  :line-position-mark
    :accessor line-position-mark)
   (adjust-rows-strategy
    :initform #'adjust-rows-noop
    :initarg  :adjust-rows-strategy
    :accessor adjust-rows-strategy)
   (text-starting-column
    :initform 0
    :initarg  :text-starting-column
    :accessor text-starting-column)))

(defgeneric prepare-for-rendering (object text-data &key jump-to-first-row))

(defgeneric scroll-down  (object &optional amount))

(defgeneric scroll-up    (object &optional amount))

(defgeneric scroll-left  (object &optional amount))

(defgeneric scroll-right (object &optional amount))

(defgeneric scroll-end   (object))

(defgeneric scroll-begin (object))

(defgeneric scroll-next-page     (object))

(defgeneric scroll-previous-page (object))

(defgeneric search-regex (object regex))

(defgeneric jump-to-group-id (object gid-looking-for))

(defgeneric text->rendered-lines-rows (window text))

(defgeneric colorize-lines (object))

(defgeneric viewport-width (object))

(defgeneric generate-gemini-toc (object))

(defun gemini-window-p* (window)
  (display-gemini-text-p window))

(defgeneric gemini-window-p (win))

(defmethod gemini-window-p ((win message-window))
  (gemini-window-p* win))

(defun display-gemini-text-p (window)
  (eq (keybindings window)
      keybindings:*gemini-message-keymap*))

(defun display-chat-p (window)
  (eq (keybindings window)
      keybindings:*chat-message-keymap*))

(defun prepare-for-display-status-mode (window)
  (when (not (or (display-gemini-text-p window)
                 (display-chat-p        window)))
    (setf (keybindings window)
          keybindings:*message-keymap*)))

(defun refresh-line-mark-config (window)
  (multiple-value-bind (mark-value mark-fg mark-bg)
      (swconf:message-window-line-mark-values)
    (setf (line-position-mark window)
          (make-tui-string mark-value
                           :fgcolor mark-fg
                           :bgcolor mark-bg))))

(defmethod refresh-config :after ((object message-window))
  (refresh-config-colors object swconf:+key-message-window+)
  (refresh-line-mark-config object)
  (let* ((reference-window        (if command-line:*gemini-full-screen-mode*
                                      *main-window*
                                      *thread-window*))
         (reference-window-width  (if (and command-line:*gemini-full-screen-mode*
                                           *gemini-toc-window*)
                                      (- (win-width *main-window*)
                                         (win-width *gemini-toc-window*))
                                      (win-width  reference-window)))
         (reference-window-height (win-height reference-window))
         (command-window-height   (win-height *command-window*))
         (main-window-height      (win-height *main-window*))
         (height                  (if (eq reference-window *thread-window*)
                                      (- main-window-height
                                         command-window-height
                                         reference-window-height)
                                      (- main-window-height
                                         command-window-height
                                         (swconf:config-gemini-fullscreen-links-height))))
         (width                   reference-window-width)
         (x                       (if (and command-line:*gemini-full-screen-mode*
                                           *gemini-toc-window*)
                                      (win-width *gemini-toc-window*)
                                      (win-x reference-window)))
         (y                       (if (and command-line:*gemini-full-screen-mode*
                                           *gemini-toc-window*)
                                      (swconf:config-gemini-fullscreen-links-height)
                                      (+ (win-y reference-window)
                                         reference-window-height))))
    (win-resize object width height)
    (win-move   object x y)))

(defmethod calculate ((object message-window) dt)
  (declare (ignore object dt)))

(defun visible-rows (window)
  (with-accessors ((row-selected-index row-selected-index)) window
    (let* ((start  (max 0 row-selected-index))
           (end    (+ start
                      (win-height-no-border window)))
           (rows   (rows-safe-subseq window
                                     row-selected-index
                                     :end end)))
      (values rows
              start
              (length rows)))))

(defun draw-text (window)
  (when hooks:*before-rendering-message-text*
    (hooks:run-hook 'hooks:*before-rendering-message-text* window))
  (with-accessors ((row-selected-index   row-selected-index)
                   (text-starting-column text-starting-column)) window
    (let ((visible-rows                       (visible-rows window))
          (window-width                       (win-width-no-border window))
          (content-available-on-the-left-mark (swconf:left-arrow)))
      (when hooks:*before-rendering-message-visible-rows*
        (hooks:run-hook 'hooks:*before-rendering-message-visible-rows* visible-rows window))
      (loop for line in visible-rows
            for y from  1
            do
               (cond
                 ;; testing invisibility should  never returns true as
                 ;; the method `row'  is specialized on message-window
                 ;; and  always removes  from the  rows the  invisible
                 ;; ones.
                 ((row-invisible-p line)
                  (decf y))
                 ((not (row-vertical-space-p line))
                  (let* ((text-line         (remove-corrupting-utf8-chars (normal-text line)))
                         (text-length       (text-length text-line))
                         (truncate-at       (- window-width
                                               text-length
                                               text-starting-column))
                         (truncatep         (< truncate-at 0))
                         (actual-text-line  (cond
                                              ((= text-length 0)
                                               "")
                                              ((>= text-starting-column text-length)
                                               content-available-on-the-left-mark)
                                              (truncatep
                                               (tui-string-subseq text-line
                                                                  text-starting-column
                                                                  (min text-length
                                                                       (+ window-width
                                                                          text-starting-column))))
                                              (t
                                               (tui-string-subseq text-line
                                                                  text-starting-column
                                                                  nil)))))
                    (print-text window actual-text-line 1 y))))))))

(defun draw-buffer-line-mark (window)
  (with-accessors ((rows                 rows)
                   (row-selected-index   row-selected-index)
                   (line-position-mark line-position-mark)) window
    (let* ((height     (1- (win-height-no-border window)))
           (rows-count (- (rows-length window) height))
           (fraction   (/ row-selected-index
                          (max 1 rows-count)))
           (mark-y   (1+ (truncate (* fraction height))))
           (mark-x   (1- (win-width window))))
      (print-text window line-position-mark mark-x mark-y))))

(defmethod draw ((object message-window))
  (when-window-shown (object)
    (win-clear object :redraw nil)
    (win-box object)
    (draw-text object)
    (when (not (line-oriented-window:rows-empty-p object))
      (draw-buffer-line-mark object))
    (call-next-method)))

(let ((index     0)
      (frames   -1)
      (slowness 15))
  (declare (fixnum index frames slowness))
  (defun draw-downloading-animation (window)
    (declare (optimize (debug 0) (speed 3)))
    (let* ((animation-frames (swconf:gemini-downloading-animation))
           (max              (length (the list animation-frames))))
      (print-text window (elt animation-frames index) 0 0 :attributes (attribute-bold))
      (incf frames)
      (when (= (rem frames slowness)
               0)
        (setf index (rem (1+ index) max))))))

(defgeneric row-add-original-object (lines original-object))

(defgeneric row-find-original-object (object thing
                                             &key from-end start end key))


(defgeneric row-position-original-object (object thing &key start from-end end))

(defmethod row-add-original-object ((lines line) original-object)
  (push original-object
        (fields lines))
  (push :original-object
        (fields lines))
  lines)

(defun extract-original-object (row)
  (getf (fields row) :original-object))

(defmethod row-add-original-object ((lines list) original-object)
  (mapcar (lambda (a) (row-add-original-object a original-object))
          lines)
  lines)

(defmethod row-find-original-object ((object message-window) (thing symbol)
                                     &key from-end (start 0) end key)
  (rows-find-if object (lambda (a) (typep (extract-original-object a) thing))
                :from-end from-end
                :start    start
                :end      end
                :key      key))

(defmethod row-find-original-object ((object list) (thing symbol)
                                     &key from-end (start 0) end key)
  (find-if (lambda (a) (typep (extract-original-object a) thing))
           object
           :from-end from-end
           :start    start
           :end      end
           :key      key))

(defmethod row-position-original-object ((object message-window) (thing symbol)
                                         &key (start 0) (from-end nil) (end nil))
  (when (and (>= start 0)
             (< start (rows-length object))
             (or (null end)
                 (and (< end (rows-length object))
                      (>= end start))))
    (rows-position-if object (lambda (a) (typep (extract-original-object a) thing))
                      :start    start
                      :end      end
                      :from-end from-end)))

(defmethod row-position-original-object ((object list) (thing symbol)
                                         &key (start 0) (from-end nil) (end nil))
  (position-if (lambda (a) (typep (extract-original-object a) thing))
               object
               :start    start
               :end      end
               :from-end from-end))

(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
                            :normal-text (make-tui-string (format nil "~%"))
                            :fields      (list +row-vertical-space-field-key+ 1))))
    (row-add-original-object res original-object)
    (row-add-group-id res (gemini-parser:group-id original-object))
    res))

(defun row-vertical-space-p (row)
  (getf (fields row) +row-vertical-space-field-key+))

(defun make-invisible-row (original-object &optional (text ""))
  (let ((res (make-instance 'line
                            :fields      (list +row-invisible-field-key+ t)
                            :normal-text (if (typep text 'c:complex-string)
                                             text
                                             (make-tui-string text)))))
    (row-add-original-object res original-object)
    res))

(defun row-link-p (row)
  (typep (row-get-original-object row)
         'gemini-parser:link-line))

(defun row-pre-start-p (row)
  (typep (row-get-original-object row)
         'gemini-parser:pre-start))

(defun row-preformatted-p (row)
  (typep (row-get-original-object row)
         'gemini-parser:pre-line))

(defun row-invisible-p (row)
  (getf (fields row) +row-invisible-field-key+))

(defun row-visible-p (row)
  (not (row-invisible-p row)))

(defun row-set-invisible (row)
  (with-accessors ((fields fields)) row
    (when (not (row-invisible-p row))
      (push t fields)
      (push +row-invisible-field-key+ fields))
    row))

(defun row-set-visible (row)
  (setf (fields row) (remove-from-plist (fields row) +row-invisible-field-key+))
  row)

(defmacro with-map-update-raw-rows ((window function) &body body)
  (with-gensyms (new-rows)
    `(let ((,new-rows (rows-map-raw ,window
                                    ,function)))
       ,@body
       (update-all-rows ,window ,new-rows)
       (draw ,window))))

(defun row-hide-preformatted (message-window)
  (with-map-update-raw-rows (message-window
                             (lambda (a)
                               (when (row-preformatted-p a)
                                 (row-set-invisible a))
                               a))))

(defun row-show-pre-start (message-window)
  (with-map-update-raw-rows (message-window
                             (lambda (a)
                               (when (row-pre-start-p a)
                                 (row-set-visible a))
                               a))))

(defun row-show-preformatted (message-window)
  (with-map-update-raw-rows (message-window
                             (lambda (a)
                               (when (row-preformatted-p a)
                                 (row-set-visible a))
                               a))))

(defun row-hide-pre-start (message-window)
  (with-map-update-raw-rows (message-window
                             (lambda (a)
                               (when (row-pre-start-p a)
                                 (row-set-invisible a))
                               a))))

(let ((pre-visible-p t))

  (defun set-default-preformatted-visibility (visibility)
    (setf pre-visible-p visibility))

  (defun get-default-preformatted-visibility ()
    pre-visible-p)

  (defun toggle-default-preformatted-visibility ()
    (setf pre-visible-p (not pre-visible-p)))

  (defun toggle-preformatted-block (message-window)
    (if pre-visible-p
        (progn
          (row-hide-preformatted message-window)
          (row-show-pre-start    message-window))
        (progn
          (row-show-preformatted message-window)
          (row-hide-pre-start    message-window)))
    (toggle-default-preformatted-visibility)
    message-window))

(defmethod text->rendered-lines-rows (window (text gemini-parser:vertical-space))
  (make-render-vspace-row text))

(defmethod text->rendered-lines-rows (window (text gemini-parser:pre-start))
  (make-invisible-row text (gemini-parser:alt-text text)))

(defmethod text->rendered-lines-rows (window (text gemini-parser:pre-end))
  (make-invisible-row text))

(defmethod text->rendered-lines-rows (window (text gemini-parser:pre-line))
  (let ((res (make-instance 'line
                            :normal-text
                            (reduce #'tui:cat-complex-string
                                    (text->rendered-lines-rows window (gemini-parser:lines text)))
                            :fields      (list :alt-text        (gemini-parser:alt-text text)
                                               :group-id        (gemini-parser:group-id text)))))
    (row-add-original-object res text)
    res)) ; even if row-add-original-object returns the modified line explicit returns for clarity

(defmethod text->rendered-lines-rows (window (text list))
  (flatten (loop for i in text
                 collect
                 (text->rendered-lines-rows window i))))

(defmethod text->rendered-lines-rows (window (text c:complex-string))
  text)

(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
                                    (width (win-width-no-border window))
                                    (empty-line-transform-fn (lambda () (make-render-vspace-row)))
                                  &allow-other-keys)
  (let ((colorized-lines (colorize-lines (%fit-lines window
                                                     (gemini-parser:lines object)
                                                     :width width
                                                     :empty-line-transform-fn
                                                     empty-line-transform-fn))))
    (loop for text in colorized-lines
          collect
          (let ((res-line (text->line text))
                (group-id (gemini-parser:group-id object)))
            (row-add-original-object res-line object)
            (row-add-group-id res-line group-id)
            res-line))))

(defmethod text->rendered-lines-rows (window (text gemini-parser:quoted-lines))
  (let* ((rows (collect-lines-from-ir text window
                                      :width (1- (win-width-no-border window))
                                      :empty-line-transform-fn (lambda () ""))))
    (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))

(defmethod text->rendered-lines-rows (window (text gemini-parser:unordered-list-line))
  (collect-lines-from-ir text window))

(defmethod text->rendered-lines-rows (window (text gemini-parser:link-line))
  (let ((res (make-instance 'line :normal-text (gemini-parser:link-text text))))
    (row-add-original-object res text)
    (row-add-group-id res (gemini-parser:group-id text))
    res)) ; even if row-add-original-object returns the modified line explicit returns for clarity

(defun %fit-text (window text)
  (let ((lines (split-lines text)))
    (%fit-lines window lines)))

(defun %fit-lines (window lines
                   &key
                     (width (win-width-no-border window))
                     (empty-line-transform-fn (lambda () (make-render-vspace-row))))
  (let ((res   ()))
    (loop for line in lines do
      (cond
        ((string-empty-p (trim-blanks line))
         (push (funcall empty-line-transform-fn) res))
        (t
         (loop for fitted-line in (flush-left-mono-text (split-words line) width)  do
           (push fitted-line res)))))
    (reverse res)))

(defgeneric text->line (object))

(defmethod text->line ((object line))
  object)

(defmethod text->line (object)
  (make-instance 'line
                 :normal-text object))

(defgeneric line->text (object))

(defmethod line->text ((object line))
  (tui-string->chars-string (normal-text object)))

(defmethod line->text ((object sequence))
  (map 'list #'line->text object))

(defmethod text->rendered-lines-rows (window (text string))
  (let* ((fitted-lines (%fit-text window text))
         (new-rows     (colorize-lines fitted-lines)))
    (mapcar #'text->line new-rows)))

(defmethod text->rendered-lines-rows (window (text gemini-parser:simple-line))
  (let* ((fitted-lines (%fit-text window (gemini-parser:text-line text)))
         (new-rows     (colorize-lines fitted-lines)))
    (mapcar (lambda (text-line)
              (let ((res (text->line text-line)))
                (row-add-original-object res text)
                (row-add-group-id        res (gemini-parser:group-id text))))
            new-rows)))

(defun remove-invisible-rows (rows)
  (remove-if #'row-invisible-p rows))

(defmethod text->rendered-lines-rows (window (text line))
  text)

(defmethod rows ((object message-window))
   (with-slots (rows) object
     (remove-invisible-rows rows)))

(defmethod colorize-lines ((object line))
  object)

(defmethod colorize-lines ((object c:complex-string))
  (make-instance 'line :normal-text object))

(defmethod colorize-lines ((object string))
  (let ((color-re (swconf:color-regexps))
        (res object))
    (loop for re in color-re do
      (setf res (colorize-line res re)))
    (colorized-line->tui-string res)))

(defmethod colorize-lines ((object list))
  (loop for line in object
        collect
        (colorize-lines line)))

(defmethod viewport-width ((object message-window))
  (windows:win-width-no-border object))

(defmethod prepare-for-rendering ((object message-window) text-data &key (jump-to-first-row t))
  (update-all-rows object (text->rendered-lines-rows object text-data))
  (when (and jump-to-first-row
             (not (rows-empty-p object)))
    (select-row object 0))
  object)

(defun offset-to-move-end (win)
  (with-accessors ((rows                 rows)
                   (row-selected-index   row-selected-index)) win
    (let ((win-height (win-height-no-border win)))
      (- (- (rows-length win)
            (- win-height 1))
         row-selected-index))))

(defun scroll-end-reached-p (win)
  (with-accessors ((rows                 rows)
                   (row-selected-index   row-selected-index)) win
    (let* ((win-height (win-height-no-border win))
           (rows-left  (- (rows-length win) row-selected-index)))
      (< rows-left
         win-height))))

(defmethod scroll-down ((object message-window) &optional (amount 1))
    (when (not (or (scroll-end-reached-p object)
                   (= (row-move object amount)
                      0)))
    (draw object)))

(defmethod scroll-up   ((object message-window) &optional (amount 1))
  (when (/= (row-move object (- amount))
            0)
    (draw object)))

(defmethod scroll-left ((object message-window) &optional (amount 1))
  (with-accessors ((text-starting-column text-starting-column)) object
    (when (> text-starting-column 0)
      (decf text-starting-column amount)
      (draw object))))

(defmethod scroll-right  ((object message-window) &optional (amount 1))
  (with-accessors ((text-starting-column text-starting-column)) object
    (incf text-starting-column amount)
    (draw object)))

(defmethod scroll-end ((object message-window))
  (with-accessors ((rows                 rows)
                   (row-selected-index   row-selected-index)) object
    (let ((offset (offset-to-move-end object)))
      (when (/= (row-move object offset)
                0)
        (draw object)))))

(defmethod scroll-begin  ((object message-window))
  (with-accessors ((rows                 rows)
                   (row-selected-index   row-selected-index)) object
    (when (/= (row-move object (- row-selected-index))
              0)
      (draw object))))

(defmethod scroll-next-page ((object message-window))
  (with-accessors ((rows                 rows)
                   (row-selected-index   row-selected-index)) object
    (let ((actual-window-height (1- (win-height-no-border object)))
          (rows-length          (rows-length object)))
      (when (and (> (- rows-length
                       row-selected-index)
                    actual-window-height)
                 (/= (row-move object (min actual-window-height
                                           (- rows-length
                                              (+ row-selected-index
                                                 actual-window-height))))
                     0))
          (draw object)))))

(defmethod scroll-previous-page ((object message-window))
  (when (/= (row-move object (- (win-height-no-border object)))
            0)
    (draw object)))

(defun first-line->string (window)
  (with-accessors ((row-selected-index   row-selected-index)) window
    (let ((complex (normal-text (rows-elt window row-selected-index))))
      (values (tui-string->chars-string complex)
              complex))))

(defmethod search-regex ((object message-window) regex)
  (with-accessors ((row-selected-index   row-selected-index)) object
    (when-let ((selected-row (selected-row object)))
      (let* ((selected-text                (normal-text selected-row))
             (actual-row-starting          (if (scan regex
                                                     (tui-string->chars-string selected-text))
                                               (1+ row-selected-index)
                                               row-selected-index))
             (line-found (rows-position-if object
                                           (lambda (a)
                                             (scan regex
                                                   (tui-string->chars-string (normal-text a))))
                                           :start (clamp actual-row-starting
                                                         0
                                                         (rows-length object))))
             (replacements-strings ()))
        (when line-found
          (row-move object (- line-found row-selected-index))
          (draw object)
          (multiple-value-bind (first-window-line-simple first-window-line-complex)
              (first-line->string object)
            (labels ((calc-highlight (&optional (start-scan 0))
                       (multiple-value-bind (start end)
                           (scan regex first-window-line-simple :start start-scan)
                         (when start
                           (let* ((mask   (make-tui-string (subseq first-window-line-simple
                                                                   start end)
                                                           :fgcolor (win-bgcolor object)
                                                           :bgcolor (win-fgcolor object)))
                                  (prefix (tui-string-subseq first-window-line-complex
                                                             0
                                                             start))
                                  (new-prefix (cat-tui-string prefix mask)))
                             (push new-prefix replacements-strings)
                             (calc-highlight end)))))
                     (highlight ()
                       (loop for replacement in replacements-strings do
                         (print-text object replacement 1 1))))
              (calc-highlight)
              (highlight))))))))

(defmethod jump-to-group-id ((object message-window) gid-looking-for)
  (when-let ((line-found (rows-position-if object
                                           (lambda (a)
                                             (when-let ((header (row-get-original-object a)))
                                               (when (typep header 'gemini-parser:header-line)
                                                 (let ((gid (gemini-parser:group-id header)))
                                                   (= gid gid-looking-for)))))
                                           :start 0)))
    (select-row object 0)
    (row-move object line-found)
    (draw object)))


(defun gemini-sexp->toc-plist (all-headers
                               extract-header-fn
                               extract-level-fn
                               extract-gid-fn
                               extract-header-line-fn)
  (let* ((toc-number  (make-list gemini-parser:+max-header-level+ :initial-element 0))
         (current-gid -1)
         (toc         (loop for row in all-headers
                            collect
                            (let* ((header (funcall extract-header-fn row))
                                   (level  (funcall extract-level-fn header))
                                   (gid    (funcall extract-gid-fn header)))
                              (when (/= gid current-gid)
                                (setf current-gid gid)
                                (incf (elt toc-number (1- level)))
                                (loop for i from level below (length toc-number) do
                                  (setf (elt toc-number i) 0))
                                (loop for i from (- level 2 ) downto 0
                                      when (= (elt toc-number i) 0) do
                                        (setf (elt toc-number i) 1))
                                (list :header (funcall extract-header-line-fn header)
                                      :group-id gid
                                      :number   (subseq toc-number
                                                        0
                                                        level)))))))
    (remove-if #'null toc)))

(defmethod generate-gemini-toc ((object message-window))
  (let* ((all-headers (remove-if-not (lambda (a)
                                         (typep (row-get-original-object a)
                                                'gemini-parser:header-line))
                                       (rows object)))
         (toc         (gemini-sexp->toc-plist all-headers
                                              #'row-get-original-object
                                              #'gemini-parser:level
                                              #'gemini-parser:group-id
                                              (lambda (header)
                                                ;; just the first line
                                                ;; contains the header
                                                ;; text   the   second
                                                ;; contains        the
                                                ;; underline
                                                (first (gemini-parser:lines header))))))
    (remove-if #'null toc)))

(defun gemini-toc-header (fields)
  (getf fields :header))

(defun gemini-toc-max-number-length (toc)
  (* 2
     (num:find-max (mapcar (lambda (a) (length (getf a :number)))
                           toc))))

(defun gemini-toc-number (fields toc)
  (let ((raw               (mapcar #'to-s (getf fields :number)))
        (max-number-length (gemini-toc-max-number-length toc)))
    (right-padding (join-with-strings raw ".")
                   max-number-length
                   :padding-char (swconf:gemini-toc-padding-char))))

(defun gemini-toc-entry (fields toc)
  (format nil "~a ~a" (gemini-toc-number fields toc) (gemini-toc-header fields)))

(defun gemini-toc-group-id (fields)
  (getf fields :group-id))

(defun message-window-title ()
  (if command-line:*gemini-full-screen-mode*
      (_ "Gemini stream")
      (_ "Messages")))

(defun init ()
  (let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
    (setf *message-window*
          (make-instance 'message-window
                         :title           (message-window-title)
                         :keybindings     keybindings:*message-keymap*
                         :key-config      swconf:+key-message-window+
                         :croatoan-window low-level-window))
    (refresh-config *message-window*)
    (draw *message-window*)
    *message-window*))

(defun original-source-metadata (row)
  (let* ((original-line   (row-get-original-object      row))
         (source-line     (gemini-parser:source-line    original-line))
         (source-line-id  (gemini-parser:source-line-id original-line))
         (artificialp     (gemini-parser:artificialp    original-line)))
    (values source-line-id source-line artificialp)))

(defun search-gemini-fragment (window fragment)
  "Search `fragment' in the source lines  of the gemini steams and -if
fragment matches- move the window to the line when matching occurred."
  (labels ((prefix-diff (text-rows source-line)
             (- (length (first (split-words (first text-rows))))
                (length (first (split-words source-line)))))
           (reconstruct-source-lines (text-rows blanks &optional (accum '()))
             (if (null text-rows)
                 (mapcar (lambda (a) (reduce #'strcat a)) accum)
                 (let ((text-rows-words (remove-if #'string-empty-p
                                                   (split-words (first text-rows)))))
                   (multiple-value-bind (reconstructed rest-blanks)
                       (reconstruct-source-line text-rows-words blanks)
                     (reconstruct-source-lines (rest text-rows)
                                               rest-blanks
                                               (append accum (list reconstructed)))))))
           (quoted-line-p (row)
             (typep (row-get-original-object row) 'gemini-parser:quoted-lines))
           (strip-prefix-from-quoted-lines (text-rows prefix)
             (append (list (first text-rows))
                     (mapcar (lambda (a) (regex-replace prefix a ""))
                             (rest text-rows))))
           (rows->text-rows (rows)
             (let ((text-rows (mapcar (lambda (a)
                                        (tui-string->chars-string (normal-text a)))
                                      rows)))
               (if (quoted-line-p (first rows))
                   (let ((prefix (gemini-parser::prefix (row-get-original-object (first rows)))))
                     (strip-prefix-from-quoted-lines text-rows prefix))
                   text-rows)))
           (reconstruct-source-line (words blanks)
             (let ((rest-blanks '())
                   (res         '()))
               (loop for word in words
                     for blank in blanks
                     for ct from 1
                     do
                        (push word  res)
                        (push blank res)
                     finally (setf rest-blanks (subseq blanks ct)))
               (values (reverse res) rest-blanks))))
    (with-accessors ((row-selected-index   row-selected-index)) window
      (let ((rest-rows                (rest (rows-safe-subseq window row-selected-index)))
            (matching-source-line     nil)
            (matching-source-id       nil)
            (matching-source-position nil)
            (starting-match-row-pos   nil))
        (loop named sid-loop
              for i from 0 below (length rest-rows)
              for count-line-to-start-matching from 0
              for current-row in rest-rows do
                (multiple-value-bind (source-line-id source-line)
                    (original-source-metadata current-row)
                  (let* ((matching-string-pos (scan fragment source-line)))
                    (when matching-string-pos
                      (setf starting-match-row-pos   count-line-to-start-matching)
                      (setf matching-source-line     source-line)
                      (setf matching-source-id       source-line-id)
                      (setf matching-source-position matching-string-pos)
                      (return-from sid-loop t)))))
        (when matching-source-id
          (let* ((matching-rows   (remove-if-not (lambda (a)
                                                   (multiple-value-bind (source-line-id x artificialp)
                                                       (original-source-metadata a)
                                                     (declare (ignore x))
                                                     (and (not artificialp)
                                                          (= source-line-id matching-source-id))))
                                                 rest-rows))
                 (text-rows       (rows->text-rows matching-rows))
                 (matching-source-blanks (extract-blanks matching-source-line))
                 (reconstructed-rows (reconstruct-source-lines text-rows matching-source-blanks))
                 (line-matched (loop
                                 for reconstructed-row in reconstructed-rows
                                 for line from 1
                                 for length-accum = (length reconstructed-row)
                                   then (+ length-accum
                                           (length reconstructed-row))
                                 while (<= (- length-accum
                                              (prefix-diff text-rows matching-source-line))
                                           matching-source-position)
                                 finally (return line))))
            (row-move window (+ starting-match-row-pos line-matched))
            (draw window)))))))

(defmethod lines->uri ((object message-window))
  (flatten (map-rows object
                     (lambda (row)
                       (when-let* ((text-line (line->text row))
                                   (uri       (lines->uri text-line)))
                         uri)))))