From d85a865eedba701e27f42881a90de187cba72b31 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Sun, 29 Aug 2021 15:39:48 +0200
Subject: [PATCH] - forced colors to selected line in line oriented-window.

---
 src/line-oriented-window.lisp | 21 +++++++++------------
 src/package.lisp              |  1 +
 src/tui-utils.lisp            | 21 +++++++++++++++++++++
 3 files changed, 31 insertions(+), 12 deletions(-)

diff --git a/src/line-oriented-window.lisp b/src/line-oriented-window.lisp
index 5821f6d..166d794 100644
--- a/src/line-oriented-window.lisp
+++ b/src/line-oriented-window.lisp
@@ -402,11 +402,6 @@ this exact quantity would go beyond the length or rows or zero."
     :initarg  :unselected-line-fg
     :accessor unselected-line-fg
     :documentation "The foreground color for a unselected line")
-   ;; (line
-   ;;  :initform :red
-   ;;  :initarg  :selected-line-fg
-   ;;  :accessor selected-line-fg
-   ;;  :documentation "The foreground color for a selected line")
    (top-horizontal-padding
     :initform 0
     :initarg  :top-horizontal-padding
@@ -438,13 +433,15 @@ this exact quantity would go beyond the length or rows or zero."
             for ct from 0
             for row in rows do
               (if (selectedp row)
-                  (print-text object
-                              (right-pad-text (text-ellipsis (selected-text row)
-                                                             max-line-size)
-                                              max-line-size)
-                              x y
-                              :bgcolor (selected-bg row)
-                              :fgcolor (selected-fg row))
+                  (let ((tui-text (to-tui-string (selected-text row))))
+                    (print-text object
+                                (tui-string-apply-colors (right-pad-text (text-ellipsis tui-text
+                                                                                        max-line-size)
+                                                                         max-line-size)
+                                                         (selected-fg row)
+                                                         (selected-bg row))
+
+                                x y))
                   (print-text object
                               (right-pad-text (text-ellipsis (normal-text row)
                                                              max-line-size)
diff --git a/src/package.lisp b/src/package.lisp
index a7a4ff1..54b713a 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1299,6 +1299,7 @@
    :with-print-error-message
    :make-tui-char
    :make-tui-string
+   :tui-string-apply-colors
    :apply-attributes))
 
 (defpackage :command-line
diff --git a/src/tui-utils.lisp b/src/tui-utils.lisp
index 5bb92e5..cddadda 100644
--- a/src/tui-utils.lisp
+++ b/src/tui-utils.lisp
@@ -147,6 +147,9 @@ as argument `complex-string'."
 (defmethod to-tui-string ((object string) &key &allow-other-keys)
   (make-tui-string object))
 
+(defmethod to-tui-string ((object complex-string) &key &allow-other-keys)
+  object)
+
 (defgeneric cat-complex-string (a b &key color-attributes-contagion)
   (:documentation "Return  a new `complex-string' that  is the results
   of concatenating `a' and 'b'. If `color-attributes-contagion' is non
@@ -412,6 +415,16 @@ latter has a length equals to `total-size'"))
                     last-char-bg))))
         res))))
 
+(defun tui-string-apply-colors (text fgcolor bgcolor &key (destructive nil))
+  (let ((results (if destructive
+                     text
+                     (croatoan::copy-complex-string text))))
+    (with-accessors ((complex-char-array complex-char-array)) results
+      (loop for char across complex-char-array do
+        (setf (fgcolor char) fgcolor)
+        (setf (bgcolor char) bgcolor)))
+    results))
+
 (defgeneric apply-attributes (object index attributes))
 
 (defmethod apply-attributes ((object complex-string) (index fixnum) attributes)
@@ -434,6 +447,14 @@ latter has a length equals to `total-size'"))
 (defmethod apply-attributes (object (index null) attributes)
   object)
 
+(defmethod apply-attributes ((object complex-string) (index (eql :all)) attributes)
+  (loop for char across (complex-char-array object) do
+    (setf (attributes char) attributes))
+  object)
+
+(defmethod apply-attributes ((object string) (index (eql :all)) attributes)
+  (apply-attributes (to-tui-string object) :all attributes))
+
 (defmethod remove-corrupting-utf8-chars ((object complex-string))
   (setf (complex-char-array object)
         (remove-if (lambda (a) (display-corrupting-utf8-p (simple-char a)))