1
0
Fork 0

- forced colors to selected line in line oriented-window.

This commit is contained in:
cage 2021-08-29 15:39:48 +02:00
parent c73861a9f2
commit d85a865eed
3 changed files with 31 additions and 12 deletions

View File

@ -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)
(let ((tui-text (to-tui-string (selected-text row))))
(print-text object
(right-pad-text (text-ellipsis (selected-text row)
(tui-string-apply-colors (right-pad-text (text-ellipsis tui-text
max-line-size)
max-line-size)
x y
:bgcolor (selected-bg row)
:fgcolor (selected-fg row))
(selected-fg row)
(selected-bg row))
x y))
(print-text object
(right-pad-text (text-ellipsis (normal-text row)
max-line-size)

View File

@ -1299,6 +1299,7 @@
:with-print-error-message
:make-tui-char
:make-tui-string
:tui-string-apply-colors
:apply-attributes))
(defpackage :command-line

View File

@ -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)))