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