Hello fellow lispers,
while playing with LISP-PANE gadget, I noticed that the highlighting color was not set properly in many
cases to mark the selected item, resulting in an invisible item (the selected item text itself being
written in white on white).
After some investigation, I found the code for HANDLE-REPAINT method of GENERIC-LIST-PANE (in .....\mcclim-20190107-git\Core\clim-core\gadgets.lisp) was correct, but "misinterpreted" by the SBCL
compiler, as it was working properly only with (debug 3) option...
It is the MULTIPLE-VALUE-BIND form setting background/foreground inks that seems to suffer bad optimisation or whatever and does not work all the time !?
I'll submit this to SBCL as it is not a McClim bug... but in the meantime, replacing the
HANDLE-REPAINT method of GENERIC-LIST-PANE by the proposed code below seems to works fine.
It does exactly the same thing without using multiple values.
Best regards and thank you for reviving CLIM, it reminds me of the good ol' days on my Symbolics 3645.
Frederic Bastenaire (fbast at fbast dot net)
----------------------------------------------------------------------------------------
;; Modified version with "multiple-value-bind" replaced by regular SETQ for background/foreground
(defmethod handle-repaint ((pane generic-list-pane) region)
(with-bounding-rectangle* (sx0 sy0 sx1 sy1) (sheet-region pane)
(declare
(ignore sx1 sy1)
)
(with-bounding-rectangle* (rx0 ry0 rx1 ry1)
(if (bounding-rectangle-p region)
region
(or (pane-viewport-region pane) ; workaround for +everywhere+
(sheet-region pane)))
(let ((item-height (generic-list-pane-item-height pane))
(highlight-ink (list-pane-highlight-ink pane)))
(do* ((index (floor (- ry0 sy0) item-height) (1+ index))
(elt-index (+ index (items-origin pane)) (1+ elt-index)))
((or (> (+ sy0 (* item-height index)) ry1)
(>= elt-index (generic-list-pane-items-length pane))
(>= elt-index (+ (items-origin pane) (visible-items pane)))))
(let ((y0 (+ sy0 (* index item-height)))
(y1 (+ sy0 (* (1+ index) item-height)))
(bg (pane-background pane))
(fg (pane-foreground pane)))
(when (and (slot-boundp pane 'value) ; when value bound and item selected
(if (list-pane-exclusive-p pane)
(funcall (list-pane-test pane) ; exclusive-selectable
(elt (generic-list-pane-item-values pane)
elt-index)
(gadget-value pane))
(member (elt (generic-list-pane-item-values pane) ;multi-selectable
elt-index)
(gadget-value pane)
:test (list-pane-test pane))))
(setq bg highlight-ink ;then hilight!
fg (pane-background pane))
)
(draw-rectangle* pane rx0 y0 rx1 y1 :filled t :ink bg)
(let ((x sx0)
(y (+ y0 (text-style-ascent (pane-text-style pane) pane)))
(el (elt (generic-list-pane-item-strings pane)
elt-index)))
(if (gadget-active-p pane)
(draw-text* pane el x y
:ink fg
:text-style (pane-text-style pane))
(progn
(draw-text* pane el (1+ x) (1+ y)
:ink *3d-light-color*
:text-style (pane-text-style pane))
(draw-text* pane el (1+ x) (1+ y)
:ink *3d-dark-color*
:text-style (pane-text-style pane)))))))))))
