Re: SET-PART-COLOR for table-items

[bill@cambridge.apple.com (Bill St. Clair)]

At  5:04 PM 6/16/94 +0000, Karsten Poeck wrote:
>I would like to use SET-PART-COLOR to set the color of a particular cell in
>a table-dialog-item with tons of cells (20 X 10).
>
>this works fine, but forces a complete redraw of the table, since
>set-part-color for dialog-items calls invalidate-view.
>
>As a workaround i copied parts of the set-part-color source for the
>table-dialog-item and modified is as follows
>
>(defmethod set-cell-color ((part table-dialog-item) cell new-color)
>  (if new-color
>    (setf (getf (slot-value part 'ccl::color-list) cell) new-color)
>    (remf (slot-value part 'ccl::color-list) cell))
>  )
>
>and call an explicit redraw-cell afterwards.
>
>This works as expected, but however I don't feel comfortable with using
>undocumented mcl internals. Is there a better way do do this, perhaps with
>invalidate-cell, if such a beast exists?

I can't think of a better way to do it. If it makes you feel better,
I've changed the MCL sources as you suggested, and have put the following
patch in my patch folder, for release whenever we package up the
next MCL patch.

---------------------------------------------------------------------------

; faster-cell-color-patch.lisp
;
; Karsten Poeck's idea to beautify changing the color of a single
; cell of a table-dialog-item. Redraw only the changed cell,
; not the entire table

(in-package :ccl)

(let ((*warn-if-redefine* nil)
      (*warn-if-redefine-kernel* nil))

(defmethod set-part-color ((d table-dialog-item) part new-color)
  (without-interrupts
   (if (integerp part)
     ; Change the color of one cell
     (progn
       (if new-color
         (setf (getf (slot-value d 'color-list) part) new-color)
         (remf (slot-value d 'color-list) part))
       (redraw-cell d part))
     ; Change some other color attribute
     (progn
       (call-next-method)
       (let ((handle (dialog-item-handle d)))
         (when (and (wptr d)
                    handle
                    (setq part (%cdr (assq part *control-color-part-alist*))))
           (with-macptrs ((h-scroll (rref handle :listrec.hscroll))
                          (v-scroll (rref handle :listrec.vscroll)))
             (with-focused-dialog-item (d)
               (unless (%null-ptr-p h-scroll)
                 (set-control-part-color h-scroll part new-color))
               (unless (%null-ptr-p v-scroll)
                 (set-control-part-color v-scroll part new-color))))))))))

)