(in-package :client-main-window)

(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)

(defclass gemini-stream ()
  ((server-stream-handle
    :initform nil
    :initarg :server-stream-handle
    :accessor server-stream-handle)
   (status
    :initform +stream-status-streaming+
    :initarg :status
    :accessor status)
   (status-lock
    :initform (bt:make-lock)
    :reader status-lock)
   (fetching-thread
    :initform nil
    :initarg :fetching-thread
    :accessor fetching-thread)))

(defgeneric status (object))

(defmethod status ((object gemini-stream))
  (misc:with-lock ((status-lock object))
    (slot-value object 'status)))

(defmethod (setf status) ((object gemini-stream) val)
  (misc:with-lock ((status-lock object))
    (setf (slot-value object 'status) val)
    val))

(defparameter *gemini-streams-db* ())

(defun push-db-stream (stream-object)
  (pushnew stream-object
           *gemini-streams-db*
           :test (lambda (a b)
                   (string= (server-stream-handle a)
                            (server-stream-handle b))))
  *gemini-streams-db*)

(defun remove-db-stream (stream-object)
  (setf *gemini-streams-db*
        (remove stream-object *gemini-streams-db*))
  *gemini-streams-db*)

(defmethod abort-downloading ((object gemini-stream))
  (setf (status object) +stream-status-canceled+))

(defun remove-all-db-stream ()
  (map nil
       (lambda (a) (abort-downloading a))
       *gemini-streams-db*)
  (setf *gemini-streams-db* ())
  *gemini-streams-db*)

(defun find-db-stream-if (predicate)
  (find-if predicate *gemini-streams-db*))

(defun find-db-stream-url (url)
  (find-db-stream-if (lambda (a) (string= (server-stream-handle a) url))))

(defun find-streaming-stream-url ()
  (find-db-stream-if (lambda (a) (eq (status a) +stream-status-streaming+))))

(defgeneric stop-stream-thread (object))

(defmethod stop-stream-thread ((object gemini-stream))
  (with-accessors ((fetching-thread fetching-thread)) object
    (abort-downloading object)
    (when (and (bt:threadp fetching-thread)
               (bt:thread-alive-p fetching-thread))
      (bt:join-thread fetching-thread)))
  object)

(defmethod stop-stream-thread ((object string))
  (let ((stream-wrapper (find-db-stream-url object)))
    (stop-stream-thread stream-wrapper)))

(defun stop-steaming-stream-thread ()
  (let ((stream-wrapper (find-streaming-stream-url)))
    (stop-stream-thread stream-wrapper)))

(defun maybe-stop-steaming-stream-thread ()
  (a:when-let ((stream-wrapper (find-streaming-stream-url)))
    (stop-stream-thread stream-wrapper)))

(defun enqueue-request-notify-error (method-name id &rest args)
  (ev:with-enqueued-process-and-unblock ()
    (gui-goodies:with-notify-errors
      (apply #'comm:make-request method-name id args))))

(defun render-toc (main-window iri)
  (gui-goodies:with-notify-errors
    (toc-clear main-window)
    (let* ((toc-max-width (gui-conf:config-toc-maximum-width))
           (toc           (comm:make-request :gemini-table-of-contents
                                             1
                                             iri
                                             toc-max-width)))
      (when toc
        (let ((toc-widget-width (length (getf (first toc) :text))))
          (loop for ct from 0
                for toc-item in toc do
                  (gui:listbox-append (toc-listbox (toc-frame main-window))
                                      (getf toc-item :text)))
          (setf (toc-data (toc-frame main-window))
                (loop for toc-item in toc collect (getf toc-item :header-group-id)))
          (fit-toc-char-width main-window toc-widget-width)))
      main-window)))

(defun slurp-gemini-stream (main-window iri stream-wrapper
                            &key
                              (use-cache t)
                              (process-function  #'identity)
                              (aborting-function (constantly nil)))
  (ev:with-enqueued-process-and-unblock ()
    (set-focus-to-gemtext main-window))
  (enqueue-request-notify-error :gemini-request 1 iri use-cache nil)
  (labels ((stream-exausted-p ()
             (let ((status-completed (comm:make-request :gemini-stream-completed-p
                                                        1
                                                        iri)))
               status-completed))
           (loop-fetch (&optional (last-lines-fetched-count 0))
             (ev:with-enqueued-process-and-unblock ()
               (gui-goodies:with-notify-errors
                 (let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
                                                               1
                                                               iri
                                                               last-lines-fetched-count
                                                               nil))
                        (next-start-fetching (length last-lines-fetched)))
                   (when last-lines-fetched
                     (funcall process-function stream-wrapper last-lines-fetched))
                   (when (not (or (funcall aborting-function)
                                  (and (stream-exausted-p)
                                       (<= next-start-fetching 0))))
                     (loop-fetch (+ last-lines-fetched-count
                                    next-start-fetching))))))))
    (loop-fetch)
    (ev:with-enqueued-process-and-unblock ()
      (print-info-message (_ "Stream finished"))
      (gui:configure-mouse-pointer (gemtext-widget main-window) :xterm)
      (render-toc main-window iri))
    (if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p
                                              1
                                              ev:+standard-event-priority+
                                              iri)
        (ev:with-enqueued-process-and-unblock ()
          (set-bookmark-button-true main-window))
        (ev:with-enqueued-process-and-unblock ()
          (set-bookmark-button-false main-window)))
    (ev:with-enqueued-process-and-unblock ()
      (set-gemlog-toolbar-button-appearance main-window iri))
    (ev:with-enqueued-process-and-unblock ()
      (a:when-let* ((fragment (uri:fragment (iri:iri-parse iri)))
                    (regexp   (gemini-viewer::fragment->regex fragment)))
        (setf (gui:text (client-search-frame::entry (search-frame main-window)))
              regexp)
        (funcall (client-search-frame::start-search-clsr (search-frame main-window)
                                                         (gemtext-widget main-window)
                                                         nil)
                 nil)))))

(defun set-gemlog-toolbar-button-appearance (main-window iri)
  (if (comm:make-request :gemini-gemlog-subscribed-p 1 iri)
      (set-subscribe-button-subscribed main-window)
      (set-subscribe-button-unsubscribed main-window)))

(defun start-streaming-thread (main-window iri
                               &key
                                 (use-cache           t)
                                 (process-function    #'identity)
                                 (status +stream-status-streaming+))
  (let ((existing-stream (find-db-stream-url iri)))
    (when existing-stream
      (stop-stream-thread existing-stream)
      (setf (status existing-stream) status))
    (let ((stream-wrapper (or existing-stream
                              (make-instance 'gemini-stream
                                             :server-stream-handle iri
                                             :status               status))))
      (when (not existing-stream)
        (push-db-stream stream-wrapper))
      (flet ((aborting-function ()
               (eq (status stream-wrapper) +stream-status-canceled+)))
        (print-info-message (_ "Stream started"))
        (let ((stream-thread (bt:make-thread (lambda ()
                                               (slurp-gemini-stream main-window
                                                                    iri
                                                                    stream-wrapper
                                                                    :use-cache use-cache
                                                                    :process-function
                                                                    process-function
                                                                    :aborting-function
                                                                    #'aborting-function)))))
          (setf (fetching-thread stream-wrapper) stream-thread)
          stream-wrapper)))))

(defun initialize-menu (parent main-window)
  (let* ((bar       (gui:make-menubar parent))
         (file      (gui:make-menu bar (_ "File")))
         (tools     (gui:make-menu bar (_ "Tools")))
         (tour      (gui:make-menu bar (_ "Tour")))
         (bookmarks (gui:make-menu bar (_ "Bookmarks")))
         (gemlogs   (gui:make-menu bar (_ "Gemlogs")))
         (help      (gui:make-menu bar (_ "Help"))))
    (gui:make-menubutton tools
                         (_ "Certificates")
                         #'menu:show-certificates
                         :accelerator (client-configuration:get-keybinding :certificates))
    (gui:make-menubutton tools
                         (_ "Streams")
                         #'menu:show-streams
                         :accelerator (client-configuration:get-keybinding :stream))
    (gui:make-menubutton tools
                         (_ "Search")
                         (menu:show-search-frame-clsr main-window)
                         :accelerator (client-configuration:get-keybinding :search))
    (gui:make-menubutton file
                         (_ "Quit")
                         #'menu:quit
                         :accelerator (client-configuration:get-keybinding :quit))
    (gui:make-menubutton help
                         (_ "About")
                         #'menu:help-about
                         :accelerator (client-configuration:get-keybinding :about))
    (gui:make-menubutton bookmarks
                         (_ "Show")
                         (menu:show-bookmarks-clsr main-window)
                         :accelerator (client-configuration:config-keybinding-bookmark-show))
    (gui:make-menubutton bookmarks (_ "Manage") (menu:manage-bookmarks-clsr main-window))
    (gui:make-menubutton tour
                         (_ "Manage")
                         #'menu:show-tour
                         :accelerator (client-configuration:config-keybinding-tour-manage))
    (gui:make-menubutton tour
                         (_ "Shuffle")
                         (lambda () (client-tour-window:enqueue-shuffle-tour))
                         :accelerator (client-configuration:config-keybinding-tour-shuffle))
    (gui:make-menubutton gemlogs
                         (_ "Show")
                         #'menu:manage-gemlogs
                         :accelerator (client-configuration:get-keybinding :gemlog))))

(defclass tool-bar (gui:frame)
  ((iri-entry
    :initform nil
    :initarg  :iri-entry
    :accessor iri-entry)
   (back-button
    :initform nil
    :initarg  :back-button
    :accessor back-button)
   (reload-button
    :initform nil
    :initarg  :reload-button
    :accessor reload-button)
   (up-button
    :initform nil
    :initarg  :up-button
    :accessor up-button)
   (go-button
    :initform nil
    :initarg  :go-button
    :accessor go-button)
   (bookmark-button
    :initform nil
    :initarg  :bookmark-button
    :accessor bookmark-button)
   (tour-button
    :initform nil
    :initarg  :tour-button
    :accessor tour-button)
   (subscribe-button
    :initform nil
    :initarg  :subscribe-button
    :accessor subscribe-button)
   (inline-images-button
    :initform nil
    :initarg  :inline-images-button
    :accessor inline-images-button)))

(defun autocomplete-iri-clsr (toolbar)
  (declare (ignore toolbar))
  (lambda (hint)
    (if (or (complete:expand-iri-as-local-path-p hint)
            (> (length hint) 2))
        (gui-goodies:with-notify-errors
          (let ((match-results (cev:enqueue-request-and-wait-results :complete-net-address
                                                                     1
                                                                     ev:+maximum-event-priority+
                                                                     hint)))
            (values (getf match-results :matches)
                    (getf match-results :indices))))
        hint)))

(defmacro gen-ir-access (key)
  `(defun ,(misc:format-fn-symbol t "ir-~a" key) (line)
     (getf line ,(a:make-keyword key))))

(gen-ir-access type)

(gen-ir-access source-id)

(gen-ir-access header-group-id)

(gen-ir-access source-line)

(gen-ir-access line)

(gen-ir-access href)

(gen-ir-access pre-alt-text)

(defun link-click-mouse-1-callback-clsr (link-value main-window
                                         &key
                                           (use-cache t)
                                           (status +stream-status-streaming+))
  (with-accessors ((tool-bar tool-bar)) main-window
    (with-accessors ((iri-entry iri-entry)) tool-bar
      (lambda ()
        (set-address-bar-text main-window link-value)
        (gui:focus (toc-frame main-window))
        (open-iri link-value main-window use-cache :status status)))))

(defun absolutize-link (request-iri link-value)
  (let ((parsed-request-iri (iri:iri-parse request-iri)))
    (multiple-value-bind (x host path query port y w z)
        (gemini-client:displace-iri parsed-request-iri)
      (declare (ignore x y w z))
      (gemini-parser:absolutize-link link-value
                                     host
                                     port
                                     path
                                     query))))

(defun slurp-iri (main-window iri)
  (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
                                                                   1
                                                                   ev:+maximum-event-priority+
                                                                   iri
                                                                   t
                                                                   nil)))
    (multiple-value-bind  (status-code
                           status-description
                           meta
                           cached
                           original-iri)
        (displace-gemini-response connecting-response)
      (declare (ignore original-iri cached))
      (cond
        ((gemini-client:header-input-p status-code)
         (let ((actual-iri (get-user-request-query iri meta main-window)))
           (slurp-iri main-window actual-iri)))
        ((gemini-client:header-sensitive-input-p status-code)
         (let ((actual-iri (get-user-request-query iri meta main-window :sensitive t)))
           (slurp-iri main-window actual-iri)))
        ((= status-code comm:+tofu-error-status-code+)
         (when (gui:ask-yesno meta
                              :title (_ "Server certificate error")
                              :parent main-window)
           (cev:enqueue-request-and-wait-results :gemini-delete-certificate
                                                 1
                                                 ev:+maximum-event-priority+
                                                 iri)
           (slurp-iri main-window iri)))
        ((or (gemini-client:header-temporary-failure-p   status-code)
             (gemini-client:header-permanent-failure-p   status-code)
             (gemini-client:header-certificate-failure-p status-code))
         (gui-goodies:notify-request-error (format nil
                                                   "Error getting ~a (~a ~a)"
                                                   iri
                                                   status-code
                                                   status-description)))
        ((gemini-client:header-redirect-p status-code)
         (when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
                              :title (_ "Redirection")
                              :parent main-window)
           (let ((redirect-iri (if (iri:absolute-url-p meta)
                                   meta
                                   (absolutize-link iri meta))))
             (slurp-iri redirect-iri main-window))))
        ((gemini-client:header-success-p status-code)
         (slurp-non-text-data main-window iri :try-to-open nil))))))

(defun inline-image-p (link-value)
  (a:when-let* ((parsed (iri:iri-parse link-value :null-on-error t))
                (path   (uri:path parsed)))
    (and (or (gemini-client:absolute-gemini-url-p link-value)
             (not (iri:absolute-url-p link-value)))
         (or (re:scan "(?i)jpg$"  path)
             (re:scan "(?i)jpeg$" path)
             (re:scan "(?i)png$"  path)
             (re:scan "(?i)gif$"  path)
             (re:scan "(?i)bmp$"  path)
             (re:scan "(?i)tga$"  path)))))

(defun inline-possible-p (link-value)
  (inline-image-p link-value))

(defun inline-type (link-value)
  (when (inline-image-p link-value)
    :inline-image))

(defun inline-image (main-window link-value line-index)
  (let* ((file-path (slurp-iri main-window link-value))
         (image     (gui:make-image file-path))
         (coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
    (with-accessors ((ir-lines          ir-lines)
                     (ir-rendered-lines ir-rendered-lines)
                     (gemtext-widget    gemtext-widget)) main-window
      (let* ((parent-line (elt ir-lines (- line-index 1)))
             (new-line    (copy-list parent-line)))
        (gui:move-cursor-to gemtext-widget coordinates)
        (gui:insert-text gemtext-widget (format nil "~%"))
        (gui:insert-image gemtext-widget image coordinates)
        (setf (getf new-line :type) (inline-type link-value))
        (setf ir-lines
              (fresh-vector-insert@ ir-lines
                                    new-line
                                    (1- line-index)))
        (setf ir-rendered-lines
              (fresh-vector-insert@ ir-rendered-lines
                                    ""
                                    (1- line-index)))))))

(defun inline-all-images (main-window)
  (gui-goodies:with-busy* (main-window)
    (loop for line across (ir-lines main-window)
          for line-number from 1
          when (and (string= (getf line :type) "a")
                    (inline-image-p (getf line :href)))
            do
               (let ((link-value (absolutize-link (get-address-bar-text main-window)
                                                  (getf line :href))))
                 (inline-image main-window link-value line-number)
                 (incf line-number)))))

(defun inline-all-images-clsr (main-window)
  (lambda ()
    (inline-all-images main-window)))

(defun contextual-menu-link-clrs (link-name link-value main-window)
  (labels ((add-to-tour-callback ()
             (ev:with-enqueued-process-and-unblock ()
               (comm:make-request :tour-add-link
                                  1
                                  link-value
                                  link-name)
               (print-info-message (format nil
                                           (_ "~a added to tour")
                                           (if (string-not-empty-p link-name)
                                               link-name
                                               link-value)))))
           (download-background-callback ()
             (open-iri link-value main-window nil :status +stream-status-downloading+))
           (copy-link-callback ()
             (os-utils:copy-to-clipboard link-value)
             (print-info-message (format nil
                                         (_ "~s has been copied to the clipboard")
                                         link-value)))
           (bookmark-link-callback ()
             (let ((bookmarkedp (cev:enqueue-request-and-wait-results :gemini-bookmarked-p
                                                                      1
                                                                      ev:+standard-event-priority+
                                                                      link-value)))
               (if bookmarkedp
                   (print-info-message (format nil
                                               (_ "~s already bookmarked")
                                               link-value)
                                       :bold t)
                   (client-bookmark-window:init-window main-window link-value))))
           (open-inline-clsr (line-number)
             (lambda ()
               (if (inline-possible-p link-value)
                   (gui-goodies:with-busy* (main-window)
                     (inline-image main-window link-value line-number))
                   (funcall (link-click-mouse-1-callback-clsr link-value main-window)))))
           (save-link-as-callback ()
             (a:when-let* ((suggested-file-name (fs:path-last-element link-value))
                           (output-file (gui:get-save-file :initial-file suggested-file-name
                                                           :initial-dir "."
                                                           :parent      main-window
                                                           :title       (_ "Choose a file for saving")))
                           (input-file  (gui-goodies:with-busy* (main-window)
                                          (slurp-iri main-window link-value))))
               (fs:copy-a-file input-file output-file :overwrite t))))
    (lambda ()
      (let* ((popup-menu (gui:make-menu nil (_"link menu")))
             (x          (gui:screen-mouse-x))
             (y          (gui:screen-mouse-y))
             (relative-x (- x (gui:root-x (gemtext-widget main-window))))
             (relative-y (- y (gui:root-y (gemtext-widget main-window)))))
        (gui:move-cursor-to (gemtext-widget main-window)`(:x ,relative-x :y ,relative-y))
        (when (inline-possible-p link-value)
          (gui:make-menubutton popup-menu
                               (_ "Inline")
                               (open-inline-clsr (gui:cursor-index (gemtext-widget main-window)))))
        (gui:make-menubutton popup-menu (_ "Add link to tour") #'add-to-tour-callback)
        (gui:make-menubutton popup-menu (_ "Copy link to the clipboard") #'copy-link-callback)
        (gui:make-menubutton popup-menu (_ "Add link to bookmarks") #'bookmark-link-callback)
        (when (or (gemini-client:absolute-gemini-url-p link-value)
                  (not (iri:absolute-url-p link-value)))
          (gui:make-menubutton popup-menu (_ "Save link as…") #'save-link-as-callback))
        (gui:make-menubutton popup-menu
                             (_ "Open link in background")
                             #'download-background-callback)
        (gui:popup popup-menu x y)))))

(defun scale-font (font scaling)
  (when scaling
    (let* ((font-size      (parse-integer (getf (gui:font-actual font) :size)))
           (new-font-size  (round (* font-size scaling))))
      (gui:font-configure font :size new-font-size)))
  font)

(defun maybe-re-emphatize-lines (main-window from to)
  (with-accessors ((gemtext-font-scaling gemtext-font-scaling)
                   (gemtext-widget       gemtext-widget)) main-window
    (when (client-configuration:emphasize-wrapped-asterisk-p)
      (let ((matches (gui:search-all-text gemtext-widget
                                          "\\*[^*]+\\*"
                                          :start-index from
                                          :end-index to)))
        (loop for match in matches do
          (gui:tag-configure gemtext-widget
                             (gui:match-tag-name match)
                             :font (scale-font (client-configuration:font-text-bold)
                                               gemtext-font-scaling))
          (gui:tag-raise gemtext-widget (gui:match-tag-name match)))))))

(defun linkify (line)
  (let* ((link-value          (ir-href line))
         (link-name           (or (ir-line line)
                                  link-value))
         (prefix-gemini       (gui-conf:gemini-link-prefix-to-gemini))
         (prefix-www          (gui-conf:gemini-link-prefix-to-http))
         (prefix-other        (gui-conf:gemini-link-prefix-to-other))
         (link-rendered-label (if (text-utils:starting-emoji link-name)
                                  (format nil
                                          "~a~a"
                                          (trim-blanks prefix-other)
                                          link-name)
                                  (cond
                                    ((gemini-parser::gemini-link-iri-p link-value)
                                     (format nil "~a~a" prefix-gemini link-name))
                                    ((html-utils::http-link-iri-p link-value)
                                     (format nil "~a~a" prefix-www link-name))
                                    (t
                                     (format nil "~a~a" prefix-other link-name))))))
    (values link-rendered-label link-name link-value)))

(defun colorize-emoji (main-window line-index &optional (start 0))
  (with-accessors ((ir-lines             ir-lines)
                   (ir-rendered-lines    ir-rendered-lines)
                   (gemtext-widget       gemtext-widget)) main-window
    (let ((line (coerce (elt ir-rendered-lines line-index) 'list)))
      (loop for i from start below (length line)
            with skip-index = 0
            do
               (let ((emoji-code-points (starting-emoji (subseq line skip-index))))
                 (if emoji-code-points
                     (let ((tag (gui:tag-create gemtext-widget
                                                (gui::create-tag-name)
                                                `(:char ,i :line ,(1+ line-index))
                                                `(:char ,(1+ i) :line ,(1+ line-index)))))
                       (gui:tag-configure gemtext-widget
                                          tag
                                          :font (gui:font-create (gui::create-name)
                                                                 :family "Noto Color Emoji"
                                                                 :size 11))
                       (incf skip-index (length emoji-code-points)))
                     (incf skip-index)))))))

(defun render-ir-lines (request-iri main-window &key (starting-index 0))
  (with-accessors ((ir-lines             ir-lines)
                   (ir-rendered-lines    ir-rendered-lines)
                   (gemtext-font-scaling gemtext-font-scaling)
                   (gemtext-widget       gemtext-widget)) main-window
    (labels ((key->font (key)
               (let ((font (ecase key
                             ((:vertical-space :text :li)
                              (gui-conf:gemini-text-font-configuration))
                             (:h1
                              (gui-conf:gemini-h1-font-configuration))
                             (:h2
                              (gui-conf:gemini-h2-font-configuration))
                             (:h3
                              (gui-conf:gemini-h3-font-configuration))
                             (:quote
                              (gui-conf:gemini-quote-font-configuration))
                             ((:pre :pre-end :as-is)
                              (gui-conf:gemini-preformatted-text-font-configuration))
                             (:a
                              (gui-conf:gemini-link-font-configuration)))))
                 (scale-font font gemtext-font-scaling)
                 font))
             (key->colors (key)
               (ecase key
                 ((:vertical-space :text :li)
                  (gui-conf:gemini-window-colors))
                 (:h1
                  (gui-conf:gemini-h1-colors))
                 (:h2
                  (gui-conf:gemini-h2-colors))
                 (:h3
                  (gui-conf:gemini-h3-colors))
                 (:quote
                  (gui-conf:gemini-quote-colors))
                 ((:pre :pre-end :as-is)
                  (gui-conf:gemini-preformatted-text-colors))
                 (:a
                  (gui-conf:gemini-link-colors))))
             (key->justification (key)
               (ecase key
                 ((:vertical-space :text :li :a)
                  :left)
                 (:h1
                  (gui-conf:gemini-h1-justification))
                 (:h2
                  (gui-conf:gemini-h2-justification))
                 (:h3
                  (gui-conf:gemini-h3-justification))
                 (:quote
                  (gui-conf:gemini-quote-justification))
                 ((:pre :pre-end :as-is)
                  (gui-conf:gemini-preformatted-text-justification))))
             (render-link (line link-rendered-label line-number)
               (multiple-value-bind (link-bg link-fg)
                   (gui-conf:gemini-link-colors)
                 (let ((link-font     (scale-font (gui-conf:gemini-link-font-configuration)
                                                  gemtext-font-scaling)))
                   (multiple-value-bind (x link-name link-value)
                       (linkify line)
                     (declare (ignore x))
                     (let ((target-iri (absolutize-link request-iri link-value))
                           (new-text-line-start `(:line ,line-number :char 0)))
                       (gui:append-text gemtext-widget link-rendered-label)
                       (let ((tag-link (gui:make-link-button gemtext-widget
                                             new-text-line-start
                                             `(- :end 1 :chars)
                                             link-font
                                             link-fg
                                             link-bg
                                             (link-click-mouse-1-callback-clsr target-iri
                                                                               main-window)
                                             :cursor-outside
                                             (gui:find-cursor :xterm)
                                             :button-3-callback
                                             (contextual-menu-link-clrs link-name
                                                                        target-iri
                                                                        main-window)
                                             :over-callback
                                             (lambda () (print-info-message target-iri))
                                             :leave-callback
                                             (lambda () (print-info-message "")))))
                         (gui:tag-lower gemtext-widget tag-link)
                         (gui:append-line gemtext-widget "")))))))
             (render-line (key text line-number &key (wrap :word))
               (let ((font          (key->font key))
                     (justification (key->justification key))
                     (start-index   `(:line ,line-number :char 0)))
                 (gui:append-text gemtext-widget text)
                 (gui:append-line gemtext-widget "")
                 (multiple-value-bind (background foreground)
                     (key->colors key)
                   (let ((tag (gui:tag-create gemtext-widget
                                              (gui::create-tag-name)
                                              start-index
                                              (gui:make-indices-end))))
                     (gui:tag-configure gemtext-widget
                                        tag
                                        :wrap       wrap
                                        :font       font
                                        :foreground foreground
                                        :background background
                                        :justify    justification)
                     ;; does not works because of a TK bug
                     ;;(colorize-emoji main-window (1- line-number))
                     (gui:tag-lower gemtext-widget tag))))))
      (loop with render-line-count          =  starting-index
            with current-pre-block-alt-text = nil
            for rendered-line across (subseq ir-rendered-lines starting-index)
            for ir-line across (subseq ir-lines starting-index)
            do
               (let ((type (ir-type ir-line)))
                 (ecase (format-keyword type)
                   (:vertical-space
                    (incf render-line-count)
                    (render-line :vertical-space rendered-line render-line-count))
                   (:as-is
                    (incf render-line-count)
                    (render-line :as-is
                                 rendered-line
                                 render-line-count
                                 :wrap :none))
                   (:text
                    (incf render-line-count)
                    (render-line :text rendered-line render-line-count)
                    (maybe-re-emphatize-lines main-window
                                              `(:line ,render-line-count :char 0)
                                              `(:line ,render-line-count :char :end)))
                   (:h1
                    (incf render-line-count)
                    (render-line :h1 rendered-line render-line-count))
                   (:h2
                    (incf render-line-count)
                    (render-line :h2 rendered-line render-line-count))
                   (:h3
                    (incf render-line-count)
                    (render-line :h3 rendered-line render-line-count))
                  (:li
                   (incf render-line-count)
                   (render-line :li rendered-line render-line-count)
                   (maybe-re-emphatize-lines main-window
                                             `(:line ,render-line-count :char 0)
                                             `(:line ,render-line-count :char :end)))
                  (:quote
                   (incf render-line-count)
                   (render-line :quote rendered-line render-line-count))
                  (:pre
                   (incf render-line-count)
                   (setf current-pre-block-alt-text (ir-pre-alt-text ir-line))
                   (render-line :pre
                                rendered-line
                                render-line-count
                                :wrap :none))
                  (:pre-end
                   (incf render-line-count)
                   (render-line :pre-end rendered-line render-line-count))
                  (:a
                   (incf render-line-count)
                   (render-link ir-line rendered-line render-line-count))))))))

(defun collect-ir-lines (request-iri main-window lines)
  (with-accessors ((ir-lines             ir-lines)
                   (ir-rendered-lines    ir-rendered-lines)
                   (gemtext-font-scaling gemtext-font-scaling)
                   (gemtext-widget       gemtext-widget)) main-window
    (labels ((push-prefixed (prefix ir)
               (let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
                 (vector-push-extend raw-line ir-rendered-lines)))
             (collect-link (line)
               (vector-push-extend (linkify line) ir-rendered-lines)))
      (let ((starting-index (if (vector-empty-p ir-lines)
                                0
                                (length ir-lines))))
        (loop for line in lines do
          (vector-push-extend line ir-lines)
          (let ((type (ir-type line)))
            (ecase (format-keyword type)
              (:vertical-space
               (vector-push-extend (format nil "") ir-rendered-lines))
              (:as-is
               (vector-push-extend (ir-line line) ir-rendered-lines))
              (:text
               (vector-push-extend (ir-line line) ir-rendered-lines))
              (:h1
               (push-prefixed (gui-conf:gemini-h1-prefix) line))
              (:h2
               (push-prefixed (gui-conf:gemini-h1-prefix) line))
              (:h3
               (push-prefixed (gui-conf:gemini-h1-prefix) line))
              (:li
               (push-prefixed (gui-conf:gemini-bullet-prefix) line))
              (:quote
               (push-prefixed (gui-conf:gemini-quote-prefix) line))
              (:pre
               (vector-push-extend (format nil "") ir-rendered-lines))
              (:pre-end
               (vector-push-extend (format nil "") ir-rendered-lines))
              (:a
               (collect-link line)))))
        (render-ir-lines request-iri main-window :starting-index starting-index)))))

(defun displace-gemini-response (response)
  (values (getf response :status)
          (getf response :status-description)
          (getf response :meta)
          (getf response :cached)
          (getf response :iri)))

(defun render-monospaced-text (main-window lines)
  (ev:with-enqueued-process-and-unblock ()
    (clear-gemtext main-window)
    (gui:configure (gemtext-widget main-window)
                   :font (gui-conf:gemini-preformatted-text-font-configuration))
    (set-text-gemtext main-window lines)))

(defun open-local-path (path main-window &key (force-rendering nil))
  (cond
    ((fs:file-exists-p path)
     (if (fs:has-extension path +gemini-file-extension+)
         (let ((parsed-lines (cev:enqueue-request-and-wait-results :gemini-parse-local-file
                                                                   1
                                                                   ev:+standard-event-priority+
                                                                   path)))
           (ev:with-enqueued-process-and-unblock ()
             (clear-gemtext main-window)
             (collect-ir-lines path gui-goodies:*main-frame* parsed-lines)
             (render-toc main-window path)))
         (if force-rendering
             (let ((lines (cev:enqueue-request-and-wait-results :gemini-slurp-local-file
                                                                1
                                                                ev:+standard-event-priority+
                                                                path)))
               (render-monospaced-text main-window lines))
             (client-os-utils:open-resource-with-external-program main-window path))))
    ((fs:directory-exists-p path)
     (gui:choose-directory :initial-dir path :parent main-window :mustexist t))
    (t
     (gui-goodies:notify-request-error (format nil (_ "No such file or directory: ~a") path)))))

(defun render-gemtext-string (main-window parsed-lines &key (links-path-prefix ""))
  (ev:with-enqueued-process-and-unblock ()
    (clear-gemtext main-window)
    (collect-ir-lines links-path-prefix gui-goodies:*main-frame* parsed-lines)))

(defun iri-ensure-path (iri)
  (let ((parsed (iri:iri-parse iri :null-on-error t)))
    (if (and parsed
             (null (uri:path parsed)))
        (strcat iri "/")
        iri)))

(defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
  (handler-case
      (let ((parsed-iri (iri:iri-parse iri)))
        (cond
          ((iri:iri= iri (internal-iri-bookmark))
           (initialize-ir-lines main-window)
           (funcall (menu:show-bookmarks-clsr main-window)))
          ((iri:iri= iri (internal-iri-gemlogs))
           (menu:manage-gemlogs))
          ((gemini-client:absolute-titan-url-p iri)
           (client-titan-window:init-window main-window iri))
          ((gemini-parser:gemini-iri-p iri)
           (start-stream-iri (iri-ensure-path iri)
                             main-window
                             use-cache
                             status))
          ((or (null (uri:scheme parsed-iri))
               (string= (uri:scheme parsed-iri)
                        constants:+file-scheme+))
           (initialize-ir-lines main-window)
           (open-local-path (uri:path parsed-iri) main-window))
          (t
           (client-os-utils:open-resource-with-external-program main-window iri))))
    (error (e)
      (gui-goodies:notify-request-error e))))

(defun get-user-request-query (iri meta main-window &key (sensitive nil))
  (let* ((parsed-iri    (iri:iri-parse iri))
         (prompt        (format nil
                                (_ "The server asks:~2%~a")
                                meta))
         (button-label  (_ "Submit"))
         (dialog-title  (_ "Input query"))
         (dialog-function (if sensitive
                              #'gui-goodies:password-dialog
                              #'gui-mw:text-input-dialog))
         (raw-input     (funcall dialog-function
                                 main-window
                                 dialog-title
                                 prompt
                                 :button-message button-label))
         (encoded-input (maybe-percent-encode raw-input)))
    (multiple-value-bind (actual-iri host path query port fragment)
        (gemini-client:displace-iri parsed-iri)
      (declare (ignore actual-iri query fragment))
      (gemini-parser:make-gemini-iri host
                                     path
                                     :query encoded-input
                                     :port  port))))

(defun slurp-text-data (main-window iri)
  (labels ((maybe-open-if-completed (stream-info support-file)
             (if (string-equal (getf stream-info :stream-status)
                               :completed)
                 (client-os-utils:open-resource-with-external-program main-window support-file)
                 (wait-enough-data)))
           (wait-enough-data ()
             (let* ((stream-info (cev:enqueue-request-and-wait-results :gemini-stream-info
                                                                       1
                                                                       ev:+maximum-event-priority+
                                                                       iri))
                    (support-file (getf stream-info :support-file)))
               (maybe-open-if-completed stream-info support-file))))
    (wait-enough-data)))

(defun slurp-non-text-data (main-window iri &key (try-to-open t))
  (labels ((wait-until-download-complete (stream-info support-file)
             (if (string-equal (getf stream-info :stream-status)
                               :completed)
                 (if try-to-open
                     (client-os-utils:open-resource-with-external-program main-window support-file)
                     (getf stream-info :support-file))
                 (wait-enough-data)))
           (buffer-filled-enough-to-open-p (buffer-size read-so-far)
             (let ((filled-configuration-threshold (and buffer-size
                                                        (> read-so-far buffer-size))))
               (or filled-configuration-threshold
                   (> read-so-far
                      swconf:+buffer-minimum-size-to-open+))))
           (wait-enough-data ()
             (let* ((stream-info
                      (cev:enqueue-request-and-wait-results :gemini-stream-info
                                                            1
                                                            ev:+maximum-event-priority+
                                                            iri))
                    (read-so-far  (getf stream-info :octect-count -1))
                    (support-file (getf stream-info :support-file)))
               (multiple-value-bind (program-exists y wait-for-download)
                   (swconf:link-regex->program-to-use support-file)
                 (declare (ignore y))
                 (if program-exists
                     (if (or wait-for-download
                             (not try-to-open))
                         (wait-until-download-complete stream-info support-file)
                         (let ((buffer-size (swconf:link-regex->program-to-use-buffer-size support-file)))
                           (if (buffer-filled-enough-to-open-p buffer-size read-so-far)
                               (client-os-utils:open-resource-with-external-program main-window
                                                                                    support-file)
                               (wait-enough-data))))
                     (wait-until-download-complete stream-info support-file))))))
    (wait-enough-data)))

(defun start-stream-iri (iri main-window use-cache &optional (status +stream-status-streaming+))
  (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
                                                                   1
                                                                   ev:+maximum-event-priority+
                                                                   iri
                                                                   use-cache
                                                                   nil)))
    (multiple-value-bind  (status-code
                           status-description
                           meta
                           cached
                           original-iri)
        (displace-gemini-response connecting-response)
      (declare (ignore original-iri cached))
      (cond
        ((gemini-client:header-input-p status-code)
         (let ((actual-iri (get-user-request-query iri meta main-window)))
           (start-stream-iri actual-iri main-window nil)))
        ((gemini-client:header-sensitive-input-p status-code)
         (let ((actual-iri (get-user-request-query iri meta main-window :sensitive t)))
           (start-stream-iri actual-iri main-window nil)))
        ((= status-code comm:+tofu-error-status-code+)
         (when (gui:ask-yesno (_ "The certificate for this address has changed, replace the old with the one I just received?")
                              :title (_ "Server certificate error")
                              :parent main-window)
           (cev:enqueue-request-and-wait-results :gemini-delete-certificate
                                                 1
                                                 ev:+maximum-event-priority+
                                                 iri)
           (start-stream-iri iri main-window use-cache status)))
        ((or (gemini-client:header-temporary-failure-p   status-code)
             (gemini-client:header-permanent-failure-p   status-code)
             (gemini-client:header-certificate-failure-p status-code))
         (let ((error-gemtext (cev:enqueue-request-and-wait-results :make-error-page
                                                                    1
                                                                    ev:+standard-event-priority+
                                                                    iri
                                                                    status-code
                                                                    status-description
                                                                    meta)))
           (render-gemtext-string main-window error-gemtext)))
        ((gemini-client:header-redirect-p status-code)
         (when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
                              :title (_ "Redirection")
                              :parent main-window)
           (let ((redirect-iri (if (iri:absolute-url-p meta)
                                   meta
                                   (absolutize-link iri meta))))
             (start-stream-iri redirect-iri main-window use-cache status))))
        ((gemini-client:header-success-p status-code)
         (cond
           ((eq status +stream-status-streaming+)
            (cond
              ((gemini-client:gemini-file-stream-p meta)
               (ev:with-enqueued-process-and-unblock ()
                 (comm:make-request :gemini-save-url-db-history 1 iri))
               (maybe-stop-steaming-stream-thread)
               (clear-gemtext main-window)
               (initialize-ir-lines main-window)
               (start-streaming-thread main-window
                                       iri
                                       :use-cache        t
                                       :status           status
                                       :process-function
                                       (lambda (stream-wrapper lines)
                                         ;; this test  ensures that the
                                         ;; collecting  events left  on
                                         ;; the queue won't be actually
                                         ;; processed, just discarded
                                         (when (not (eq (status stream-wrapper)
                                                        +stream-status-canceled+))
                                           (collect-ir-lines iri main-window lines)))))
              ((gemini-client:text-file-stream-p meta)
               (slurp-text-data main-window iri))
              (t
               (slurp-non-text-data main-window iri))))
           ((eq status +stream-status-downloading+)
            (when (not (find-db-stream-url iri))
              (let ((background-stream (make-instance 'gemini-stream
                                                      :server-stream-handle iri
                                                      :status               status)))
                (push-db-stream background-stream))))
           (t
            (error "Unrecognized stream status for address ~s: ~s" iri status))))))))

(defun open-iri-clsr (main-window use-cache)
  (lambda ()
    (with-accessors ((tool-bar tool-bar)) main-window
      (with-accessors ((iri-entry iri-entry)) tool-bar
        (let ((iri (trim-blanks (gui:text iri-entry))))
          (gui-mw::hide-candidates iri-entry)
          (open-iri iri main-window use-cache))))))

(defun toc-callback-clsr (main-window)
  (with-accessors ((toc-frame      toc-frame)
                   (gemtext-widget gemtext-widget)
                   (ir-lines       ir-lines)) main-window
    (let ((toc-listbox (gui:listbox (toc-listbox toc-frame))))
      (lambda (event)
        (declare (ignore event))
        (a:when-let* ((index-item        (first (gui:listbox-get-selection-index toc-listbox)))
                      (selected-group-id (elt (toc-data toc-frame) index-item))
                      (line-position     (position-if (lambda (a)
                                                        (a:when-let ((gid (getf a
                                                                                :header-group-id)))
                                                          (= selected-group-id gid)))
                                                      ir-lines))
                      (line-index         (1+ line-position)))
          (gui:scroll-until-line-on-top gemtext-widget line-index))))))

(defun reload-iri-clsr (main-window)
  (lambda ()
    (with-accessors ((tool-bar tool-bar)) main-window
      (with-accessors ((iri-entry iri-entry)) tool-bar
        (let ((iri (get-address-bar-text main-window)))
          (open-iri iri main-window nil))))))

(defun up-iri-clsr (main-window)
  (lambda ()
    (with-accessors ((tool-bar tool-bar)) main-window
      (with-accessors ((iri-entry iri-entry)) tool-bar
        (let ((to-parent-iri (cev:enqueue-request-and-wait-results :iri-to-parent-path
                                                                   1
                                                                   ev:+standard-event-priority+
                                                                   (gui:text iri-entry))))
          (when (string-not-empty-p to-parent-iri)
            (set-address-bar-text main-window to-parent-iri)
            (open-iri to-parent-iri main-window t)))))))

(defun back-iri-clsr (main-window)
  (lambda ()
    (with-accessors ((tool-bar tool-bar)) main-window
      (with-accessors ((iri-entry iri-entry)) tool-bar
        (let ((iri-visited (cev:enqueue-request-and-wait-results :gemini-pop-url-from-history
                                                                 1
                                                                 ev:+standard-event-priority+)))
          (when (string-not-empty-p iri-visited)
            (set-address-bar-text main-window iri-visited)
            (open-iri iri-visited main-window t)))))))

(defun set-bookmark-button-image (main-window image)
  (with-accessors ((tool-bar tool-bar)) main-window
    (with-accessors ((bookmark-button bookmark-button)) tool-bar
      (gui:configure bookmark-button :image image))))

(defun set-bookmark-button-false (main-window)
  (set-bookmark-button-image main-window icons:*star-yellow*))

(defun set-bookmark-button-true (main-window)
  (set-bookmark-button-image main-window icons:*star-blue*))

(defun set-subscribe-button-image (main-window image)
  (with-accessors ((tool-bar tool-bar)) main-window
    (with-accessors ((subscribe-button subscribe-button)) tool-bar
      (gui:configure subscribe-button :image image))))

(defun set-subscribe-button-unsubscribed (main-window)
  (set-subscribe-button-image main-window icons:*gemlog-subscribe*))

(defun set-subscribe-button-subscribed (main-window)
  (set-subscribe-button-image main-window icons:*gemlog-unsubscribe*))

(defun toggle-bookmark-iri-clsr (main-window)
  (lambda ()
    (with-accessors ((tool-bar tool-bar)) main-window
      (with-accessors ((iri-entry iri-entry)) tool-bar
        (let* ((iri          (gui:text iri-entry))
               (bookmarkedp (cev:enqueue-request-and-wait-results :gemini-bookmarked-p
                                                                  1
                                                                  ev:+standard-event-priority+
                                                                  iri)))
          (if bookmarkedp
              (ev:with-enqueued-process-and-unblock ()
                (comm:make-request :gemini-bookmark-delete 1 iri)
                (set-bookmark-button-false main-window))
              (client-bookmark-window:init-window main-window (gui:text iri-entry))))))))

(defun toggle-subscribtion-iri-clsr (main-window)
  (lambda ()
    (with-accessors ((tool-bar tool-bar)) main-window
      (with-accessors ((iri-entry iri-entry)) tool-bar
        (ev:with-enqueued-process-and-unblock ()
          (let* ((iri         (gui:text iri-entry))
                 (subscribedp (comm:make-request :gemini-gemlog-subscribed-p
                                                 1
                                                 iri)))
            (if subscribedp
                (progn
                  (comm:make-request :gemini-gemlog-unsubscribe 1 iri)
                  (set-subscribe-button-unsubscribed main-window))
                (progn
                  (comm:make-request :gemini-gemlog-subscribe 1 iri)
                  (set-subscribe-button-subscribed main-window)))))))))

(defun tour-visit-next-iri-clsr (main-window)
  (lambda ()
    (let ((next-link (cev:enqueue-request-and-wait-results :tour-pop-link
                                                           1
                                                           ev:+standard-event-priority+)))
      (if next-link
          (funcall (link-click-mouse-1-callback-clsr (getf next-link :link-value)
                                                     main-window))
          (print-info-message (_ "Tour is terminated") :bold t)))))

(defun setup-main-window-events (main-window)
  (with-accessors ((tool-bar       tool-bar)
                   (toc-frame      toc-frame)
                   (gemtext-widget gemtext-widget)
                   (ir-lines       ir-lines)) main-window
    (with-accessors ((iri-entry            iri-entry)
                     (back-button          back-button)
                     (reload-button        reload-button)
                     (up-button            up-button)
                     (go-button            go-button)
                     (bookmark-button      bookmark-button)
                     (tour-button          tour-button)
                     (subscribe-button     subscribe-button)
                     (inline-images-button inline-images-button)) tool-bar
      (let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry))
            (toc-listbox        (gui:listbox (toc-listbox toc-frame))))
        (gui:bind entry-autocomplete
                  #$<KeyPress-Return>$
                  (lambda (e)
                    (declare (ignore e))
                    (gui:focus toc-frame)
                    (funcall (open-iri-clsr main-window t)))
                  :append nil)
        (gui:bind toc-listbox
                  #$<<ListboxSelect>>$
                  (toc-callback-clsr main-window))
        (setf (gui:command go-button)            (open-iri-clsr main-window t))
        (setf (gui:command reload-button)        (reload-iri-clsr main-window))
        (setf (gui:command back-button)          (back-iri-clsr main-window))
        (setf (gui:command up-button)            (up-iri-clsr main-window))
        (setf (gui:command bookmark-button)      (toggle-bookmark-iri-clsr main-window))
        (setf (gui:command tour-button)          (tour-visit-next-iri-clsr main-window))
        (setf (gui:command subscribe-button)     (toggle-subscribtion-iri-clsr main-window))
        (setf (gui:command inline-images-button) (inline-all-images-clsr main-window))))))

(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
  (with-accessors ((iri-entry            iri-entry)
                   (back-button          back-button)
                   (reload-button        reload-button)
                   (up-button            up-button)
                   (go-button            go-button)
                   (bookmark-button      bookmark-button)
                   (tour-button          tour-button)
                   (subscribe-button     subscribe-button)
                   (inline-images-button inline-images-button)) object
    (gui:configure object :relief :raised)
    (setf iri-entry (make-instance 'gui-mw:autocomplete-entry
                                   :master                object
                                   :autocomplete-function (autocomplete-iri-clsr object)))
    (setf back-button      (make-instance 'gui:button :master object :image icons:*back*))
    (setf reload-button    (make-instance 'gui:button :master object :image icons:*refresh*))
    (setf go-button        (make-instance 'gui:button :master object :image icons:*open-iri*))
    (setf up-button        (make-instance 'gui:button :master object :image icons:*up*))
    (setf bookmark-button  (make-instance 'gui:button :master object))
    (setf tour-button      (make-instance 'gui:button :master object :image icons:*bus-go*))
    (setf subscribe-button (make-instance 'gui:button
                                          :master object
                                          :image icons:*gemlog-subscribe*))
    (setf inline-images-button (make-instance 'gui:button
                                              :master object
                                              :image icons:*inline-images*))
    (gui-goodies:attach-tooltips (back-button          (_ "go back"))
                                 (reload-button        (_ "reload address"))
                                 (go-button            (_ "go to address"))
                                 (up-button            (_ "one level up"))
                                 (bookmark-button      (_ "add or remove bookmark"))
                                 (tour-button          (_ "go to the next link in tour"))
                                 (subscribe-button     (_ "subscribe/unsubscribe to this gemlog"))
                                 (inline-images-button (_ "inline images")))
    (gui:grid back-button          0 0 :sticky :nsw)
    (gui:grid reload-button        0 1 :sticky :nsw)
    (gui:grid up-button            0 2 :sticky :nsw)
    (gui:grid iri-entry            0 3 :sticky :nswe :padx +minimum-padding+)
    (gui:grid go-button            0 4 :sticky :nsw)
    (gui:grid bookmark-button      0 5 :sticky :nsw)
    (gui:grid subscribe-button     0 6 :sticky :nsw)
    (gui:grid tour-button          0 7 :sticky :nsw)
    (gui:grid inline-images-button 0 8 :sticky :nsw)
    (gui:grid-columnconfigure object 3 :weight 2)
    object))

(defclass toc-frame (gui:frame)
  ((toc-listbox
    :initform nil
    :initarg :toc-listbox
    :accessor toc-listbox)
   (toc-data
    :initform nil
    :initarg :toc-data
    :accessor toc-data)))

(defun setup-on-motion-higlight-toc-entry (toc-listbox)
  (with-accessors ((listbox gui:listbox)) toc-listbox
    (gui:bind listbox
              #$<Motion>$
              (lambda (event)
                (let* ((y              (gui:event-y event))
                       (selected-index (gui:listbox-nearest listbox y)))
                  (gui:listbox-clear listbox)
                  (gui:listbox-select listbox selected-index))))))

(defmethod initialize-instance :after ((object toc-frame) &key &allow-other-keys)
  (with-accessors ((toc-listbox toc-listbox)
                   (toc-data    toc-data)) object
    (setf toc-listbox
          (make-instance 'gui:scrolled-listbox
                         :cursor (gui:find-cursor :hand2)
                         :master object
                         :name   nil
                         :select-mode :single))
    (setup-on-motion-higlight-toc-entry toc-listbox)
    (gui:configure (gui:listbox toc-listbox) :width (gui-conf:config-toc-minimum-width))
    (gui:configure (gui:listbox toc-listbox)
                   :font (gui-conf:toc-font-configuration))
    (gui:grid toc-listbox 0 0
              :sticky :nswe
              :ipadx  +minimum-padding+
              :ipady  +minimum-padding+)
    (gui-goodies:gui-resize-grid-all object)))

(defun initialize-ir-lines (main-window)
  (setf (ir-rendered-lines main-window) (misc:make-fresh-array 0)
        (ir-lines main-window) (misc:make-fresh-array 0))
  main-window)

(defclass main-frame (gui:frame)
  ((gemtext-widget
    :initform nil
    :initarg :gemtext-widget
    :accessor gemtext-widget)
   (gemtext-font-scaling
    :initform 1.0
    :initarg :gemtext-font-scaling
    :accessor gemtext-font-scaling)
   (tool-bar
    :initform nil
    :initarg  :tool-bar
    :accessor tool-bar)
   (toc-frame
    :initform nil
    :initarg  :toc-frame
    :accessor toc-frame)
   (info-frame
    :initform nil
    :initarg  :info-frame
    :accessor info-frame)
   (info-text
    :initform nil
    :initarg  :info-text
    :accessor info-text)
   (search-frame
    :initform nil
    :initarg  :search-frame
    :accessor search-frame)
   (gemini-paned-frame
    :initform nil
    :initarg  :gemini-paned-frame
    :accessor gemini-paned-frame)
   (ir-rendered-lines
    :initform (misc:make-fresh-array 0)
    :initarg  :ir-rendered-lines
    :accessor ir-rendered-lines)
   (ir-lines
    :initform (misc:make-fresh-array 0)
    :initarg  :ir-lines
    :accessor ir-lines)))

(defmethod initialize-instance :after ((object main-frame) &key &allow-other-keys)
  (with-accessors ((main-window        main-window)
                   (tool-bar           tool-bar)
                   (toc-frame          toc-frame)
                   (info-frame         info-frame)
                   (search-frame       search-frame)
                   (info-text          info-text)
                   (gemtext-widget     gemtext-widget)
                   (gemini-paned-frame gemini-paned-frame)) object
    (setf gemini-paned-frame (make-instance 'gui:paned-window
                                            :orientation :horizontal
                                            :master      object))
    (setf tool-bar (make-instance 'tool-bar :master object))
    (set-bookmark-button-false object)
    (setf toc-frame (make-instance 'toc-frame :master gemini-paned-frame))
    (let* ((gemtext-font  (gui-conf:gemini-text-font-configuration))
           (padding       (client-configuration:config-gemtext-padding))
           (padding-pixel (* padding (gui:font-measure gemtext-font "0"))))
      (multiple-value-bind (select-bg select-fg)
          (gui-conf:main-window-select-colors)
        (setf gemtext-widget (make-instance 'gui:scrolled-text
                                            :background (gui-conf:gemini-window-colors)
                                            :selectbackground select-bg
                                            :selectforeground select-fg
                                            :takefocus  (nodgui.utils:lisp-bool->tcl nil)
                                            :padx       padding-pixel
                                            :master     gemini-paned-frame
                                            :read-only  t
                                            :font       gemtext-font)))
      (gui:configure gemtext-widget :wrap :word))
    (setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1))
    (setf info-text (make-instance 'gui:text :height 2 :wrap :none :master info-frame))
    (gui:configure info-text :font gui:+tk-small-caption-font+)
    (setf search-frame (client-search-frame:init-window object))
    (gui:grid info-text 0 0 :sticky :news)
    (gui-goodies:gui-resize-grid-all info-frame)
    (gui:grid tool-bar  0 0 :sticky :news)
    (gui:add-pane gemini-paned-frame toc-frame)
    (gui:add-pane gemini-paned-frame gemtext-widget)
    (gui:grid gemini-paned-frame 1 0 :sticky :news)
    (gui:grid search-frame   2 0 :sticky :news)
    (gui:grid-forget search-frame)
    (gui:grid info-frame     3 0 :sticky :ews)
    (gui:grid-columnconfigure object 0 :weight 1)
    (gui:grid-rowconfigure    object 1 :weight 1)
    (setup-main-window-events object)
    (gui:focus (nodgui.mw:autocomplete-entry-widget (iri-entry (tool-bar object))))
    object))

(defgeneric toc-char-width (object))

(defgeneric toc-clear (object))

(defmethod toc-char-width ((object main-frame))
  (gui:cget (gui:listbox (toc-listbox (toc-frame object)))
            :width))

(defmethod toc-clear ((object main-frame))
  (gui:listbox-delete (toc-listbox (toc-frame object))))

(defgeneric fit-toc-char-width (object new-width))

(defmethod fit-toc-char-width ((object main-frame) new-width)
  (with-accessors ((toc-frame          toc-frame)
                   (gemini-paned-frame gemini-paned-frame)) object
    (a:when-let* ((inner-listbox (gui:listbox (toc-listbox (toc-frame object))))
                  (listbox-items (gui:listbox-all-values inner-listbox))
                  (font          (gui:cget inner-listbox :font))
                  (longest-value (reduce (lambda (a b)
                                           (if (> (length a) (length b))
                                               a
                                               b))
                                         listbox-items))
                  (width-pixel (gui:font-measure font (strcat longest-value "MM"))))
      (gui:configure inner-listbox :width new-width)
      (when (client-configuration:config-toc-autoresize-p)
        (gui:sash-place gemini-paned-frame 0 width-pixel)))))

(defun print-info-message (message &key
                                     (color (gui-goodies:parse-color "black"))
                                     (bold nil))
  (let ((info-widget (info-text gui-goodies:*main-frame*)))
    (setf (gui:text info-widget) message)
    (let ((color-tag (gui:tag-create info-widget
                                     (nodgui.utils:create-tag-name)
                                     (gui:make-indices-start)
                                     (gui:make-indices-end))))
      (if bold
          (gui:tag-configure info-widget
                             color-tag
                             :foreground color
                             :font "bold")
          (gui:tag-configure info-widget
                             color-tag
                             :foreground color)))))

(defun print-error-message (message)
  (print-info-message message :color (gui-goodies:parse-color "red") :bold t))

(defun clear-gemtext (main-window)
  (setf (gui:text (gemtext-widget main-window)) "")
  (gui:configure-mouse-pointer (gemtext-widget main-window) :xterm))

(defun set-text-gemtext (main-window text)
  (setf (gui:text (gemtext-widget main-window)) text))

(defun set-address-bar-text (main-window text)
  (let* ((autocomplete-entry (iri-entry (tool-bar main-window)))
         (entry (nodgui.mw:autocomplete-entry-widget autocomplete-entry)))
    (setf (gui:text (iri-entry (tool-bar main-window))) text)
    (gui:clear-selection entry)))

(defun set-focus-to-gemtext (main-window)
  (gui:focus (gui:inner-text (gemtext-widget main-window))))

(defun get-address-bar-text (main-window)
  (trim-blanks (gui:text (iri-entry (tool-bar main-window)))))

(defun scale-gemtext (main-window offset)
  (ev:with-enqueued-process-and-unblock ()
    (clear-gemtext main-window)
    (setf (gemtext-font-scaling main-window)
          (if offset
              (max 0.1 (+ (gemtext-font-scaling main-window) offset))
              1.0)))
  (render-ir-lines (get-address-bar-text main-window) main-window))

(defun initialize-keybindings (main-window target)
  (gui:bind target
            (client-configuration:get-keybinding :quit)
            (lambda (e)
              (declare (ignore e))
              (menu:quit)))
  (gui:bind target
            (client-configuration:get-keybinding :search)
            (lambda (e)
              (declare (ignore e))
              (funcall (menu:show-search-frame-clsr main-window)))
            :exclusive t)
  (gui:bind target
            (client-configuration:get-keybinding :stream)
            (lambda (e)
              (declare (ignore e))
              (menu:show-streams))
            :exclusive t)
  (gui:bind target
            (client-configuration:get-keybinding :certificates)
            (lambda (e)
              (declare (ignore e))
              (menu:show-certificates))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-tour-manage)
            (lambda (e)
              (declare (ignore e))
              (menu:show-tour))
            :exclusive t)
  (gui:bind target
            (client-configuration:get-keybinding :gemlog)
            (lambda (e)
              (declare (ignore e))
              (menu:manage-gemlogs))
            :exclusive t)
  (gui:bind target
            (client-configuration:get-keybinding :about)
            (lambda (e)
              (declare (ignore e))
              (menu:help-about))
            :exclusive t)
  (gui:bind target
            (client-configuration:get-keybinding :type-address)
            (lambda (e)
              (declare (ignore e))
              (let* ((autocomplete-entry (iri-entry (tool-bar main-window)))
                     (entry (nodgui.mw:autocomplete-entry-widget autocomplete-entry)))
                (gui:focus entry)
                (gui:set-selection entry 0 :end)))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-tour-shuffle)
            (lambda (e)
              (declare (ignore e))
              (client-tour-window:enqueue-shuffle-tour))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-tour-next)
            (lambda (e)
              (declare (ignore e))
              (funcall (tour-visit-next-iri-clsr main-window)))
            :exclusive t)
  (gui:bind target
            (client-configuration:get-keybinding :back)
            (lambda (e)
              (declare (ignore e))
              (funcall (back-iri-clsr main-window)))
            :exclusive t)
  (gui:bind target
            (client-configuration:get-keybinding :up)
            (lambda (e)
              (declare (ignore e))
              (funcall (up-iri-clsr main-window)))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-bookmark-toggle)
            (lambda (e)
              (declare (ignore e))
              (funcall (toggle-bookmark-iri-clsr main-window)))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-bookmark-show)
            (lambda (e)
              (declare (ignore e))
              (funcall (menu:show-bookmarks-clsr main-window)))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-gemtext-scaling-increase)
            (lambda (e)
              (declare (ignore e))
              (scale-gemtext main-window 0.1))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-gemtext-scaling-decrease)
            (lambda (e)
              (declare (ignore e))
              (scale-gemtext main-window -0.1))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-gemtext-scaling-reset)
            (lambda (e)
              (declare (ignore e))
              (scale-gemtext main-window nil))
            :exclusive t)
  (gui:bind target
            (client-configuration:config-keybinding-gemtext-refresh)
            (lambda (e)
              (declare (ignore e))
              (funcall (reload-iri-clsr main-window)))
            :exclusive t))

(defun init-main-window (starting-iri)
  (setf gui:*debug-tk* nil)
  (gui:with-nodgui (:title +program-name+ :debugger-class 'gui:graphical-condition-handler)
    (icons:load-icons)
    (setf gui-goodies:*toplevel* gui:*tk*)
    (setf gui-goodies:*gui-server* gui:*wish*)
    (client-events:start-events-loop)
    (let ((main-frame (make-instance 'main-frame)))
      (setf gui-goodies:*main-frame* main-frame)
      (initialize-menu gui:*tk* main-frame)
      (gui:grid main-frame 0 0 :sticky :nswe)
      (initialize-keybindings main-frame (gui:inner-text (gemtext-widget main-frame)))
      (initialize-keybindings main-frame (gui:root-toplevel))
      (gui-goodies:gui-resize-grid-all gui-goodies:*toplevel*)
      (gui:wait-complete-redraw)
      (when (string-not-empty-p starting-iri)
        (set-address-bar-text main-frame starting-iri)
        (open-iri starting-iri main-frame nil)))))