From 8f9b4d0cf5f1ade690147c1066c9b54142a35974 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Wed, 7 Jun 2023 16:31:30 +0200
Subject: [PATCH] - [GUI] fixed image positioning.

---
 src/gui/client/main-window.lisp | 48 ++++++++++++++++++++-------------
 1 file changed, 30 insertions(+), 18 deletions(-)

diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp
index 4ec3184..c632080 100644
--- a/src/gui/client/main-window.lisp
+++ b/src/gui/client/main-window.lisp
@@ -419,20 +419,23 @@
   (let* ((file-path (slurp-iri main-window link-value))
          (image     (gui:make-image file-path))
          (coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
-    (gui:insert-image (gemtext-widget main-window) image coordinates)
     (with-accessors ((ir-lines          ir-lines)
-                     (ir-rendered-lines ir-rendered-lines)) main-window
+                     (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
-                                    line-index))
+                                    (1- line-index)))
         (setf ir-rendered-lines
-              (fresh-vector-insert@ ir-lines
+              (fresh-vector-insert@ ir-rendered-lines
                                     ""
-                                    line-index))))))
+                                    (1- line-index)))))))
 
 (defun inline-all-images (main-window)
   (gui-goodies:with-busy* (main-window)
@@ -449,7 +452,7 @@
   (lambda ()
     (inline-all-images main-window)))
 
-(defun contextual-menu-link-clrs (link-name link-value main-window line-count)
+(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
@@ -479,17 +482,23 @@
                                                link-value)
                                        :bold t)
                    (client-bookmark-window:init-window main-window link-value))))
-           (open-inline-callback ()
-             (if (inline-possible-p link-value)
-                 (gui-goodies:with-busy* (main-window)
-                   (inline-image main-window link-value line-count))
-                 (funcall (link-click-mouse-1-callback-clsr link-value main-window)))))
+           (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))))))
     (lambda ()
       (let* ((popup-menu (gui:make-menu nil (_"link menu")))
              (x          (gui:screen-mouse-x))
-             (y          (gui:screen-mouse-y)))
+             (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-callback))
+          (gui:make-menubutton popup-menu
+                               (_ "Inline")
+                               (open-inline-clsr (gui:cursor-index (gemtext-widget main-window)))))
         (gui:make-menubutton popup-menu (_ "Add link to bookmarks") #'bookmark-link-callback)
         (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)
@@ -541,7 +550,7 @@
                                      (format nil "~a~a" prefix-other link-name))))))
     (values link-rendered-label link-name link-value)))
 
-(defun colorize-emoji (main-window line-index color &optional (start 0))
+(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
@@ -557,9 +566,11 @@
                                                 `(:char ,(1+ i) :line ,(1+ line-index)))))
                        (gui:tag-configure gemtext-widget
                                           tag
-                                          :foreground color))
+                                          :font (gui:font-create (gui::create-name)
+                                                                 :family "Noto Color Emoji"
+                                                                 :size 11))
                        (incf skip-index (length emoji-code-points)))
-                     (incf skip-index))))))
+                     (incf skip-index)))))))
 
 (defun render-ir-lines (request-iri main-window)
   (with-accessors ((ir-lines             ir-lines)
@@ -636,8 +647,7 @@
                                            :button-3-callback
                                            (contextual-menu-link-clrs link-name
                                                                       target-iri
-                                                                      main-window
-                                                                      line-number)
+                                                                      main-window)
                                            :over-callback
                                            (lambda () (print-info-message target-iri))
                                            :leave-callback
@@ -662,6 +672,8 @@
                                         :foreground foreground
                                         :background background
                                         :justify    justification)
+                     ;; does not works because of a TK bug
+                     ;;(colorize-emoji main-window (1- line-number))
                      tag)))))
       (loop with render-line-count          =  0
             with starting-pre-block-line    = -1