mirror of https://codeberg.org/cage/tinmop/
- forced colors to selected line in line oriented-window.
This commit is contained in:
parent
c73861a9f2
commit
d85a865eed
|
@ -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)
|
||||
|
|
|
@ -1299,6 +1299,7 @@
|
|||
:with-print-error-message
|
||||
:make-tui-char
|
||||
:make-tui-string
|
||||
:tui-string-apply-colors
|
||||
:apply-attributes))
|
||||
|
||||
(defpackage :command-line
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue