controls.lisp

(in-package :able)

(defclass statusbar (ltk:frame)
  ((label :accessor label)
   (cached-message :initform "" :accessor cached-message)))

(defmethod initialize-instance :after ((sb statusbar) &key)
  (setf (label sb) (make-instance 'ltk:label :master sb :font *buffer-font*))
  ;;(ltk:configure sb :background *highlight-background*)
  (ltk:configure (label sb)
                 :background *highlight-background*
                 :foreground *highlight-text*)
  (ltk:pack (label sb) :side :left :pady 1 :padx 5 :fill :both))

(defmethod set-message ((sb statusbar) msg &optional (highlight *highlight-text*))
  (unless (equalp msg (cached-message sb))
    (setf (cached-message sb) msg)
    (setf (ltk:text (label sb)) msg)
    (ltk:configure (label sb) :foreground highlight)))