minimal case for box highlighting obtrusion in clim

(defclass a ()
  (slot1
   slot2))

(defclass b ()
  (slot1
   slot2))

(defclass c (a b)
  (slot1))

(defclass d (c)
  (slot2))

(defun my-info ()
  (let* ((*print-pretty* nil)
     (mystream (or (frame-standard-output *application-frame*) *standard-output*))
     (instance-a (make-instance 'a))
     (instance-b (make-instance 'b))
     (instance-c (make-instance 'c))
     (instance-d (make-instance 'd))
     (class-of-a (slot-value (class-of instance-a) 'sb-pcl::name))
     (class-of-b (slot-value (class-of instance-b) 'sb-pcl::name))
     (class-of-c (slot-value (class-of instance-c) 'sb-pcl::name))
     (class-of-d (slot-value (class-of instance-d) 'sb-pcl::name))
     (slots-in-a (with-slots (sb-pcl::slots) (class-of instance-a) sb-pcl::slots))
     (slots-in-b (with-slots (sb-pcl::slots) (class-of instance-b) sb-pcl::slots))
     (slots-in-c (with-slots (sb-pcl::slots) (class-of instance-c) sb-pcl::slots))
     (slots-in-d (with-slots (sb-pcl::slots) (class-of instance-d) sb-pcl::slots))
     (first-from-a (slot-value (first slots-in-a) 'sb-pcl::allocation-class))
     (first-from-b (slot-value (first slots-in-b) 'sb-pcl::allocation-class))
     (first-from-c (slot-value (first slots-in-c) 'sb-pcl::allocation-class))
     (first-from-d (slot-value (first slots-in-d) 'sb-pcl::allocation-class))
     (second-from-a (slot-value (slot-value (second slots-in-a) 'sb-pcl::allocation-class) 'sb-pcl::name))
     (second-from-b (slot-value (slot-value (second slots-in-b) 'sb-pcl::allocation-class) 'sb-pcl::name))
     (second-from-c (slot-value (slot-value (second slots-in-c) 'sb-pcl::allocation-class) 'sb-pcl::name))
     (second-from-d (slot-value (slot-value (second slots-in-d) 'sb-pcl::allocation-class) 'sb-pcl::name))
     (cpl-a (mapcar (lambda (obj) (slot-value obj 'sb-pcl::name))
            (sb-pcl::class-precedence-list (class-of instance-a))))
     (cpl-b (mapcar (lambda (obj) (slot-value obj 'sb-pcl::name))
            (sb-pcl::class-precedence-list (class-of instance-b))))
     (cpl-c (mapcar (lambda (obj) (slot-value obj 'sb-pcl::name))
            (sb-pcl::class-precedence-list (class-of instance-c))))
     (cpl-d (mapcar (lambda (obj) (slot-value obj 'sb-pcl::name))
            (sb-pcl::class-precedence-list (class-of instance-d)))))

    (with-output-as-presentation
     (mystream instance-a (presentation-type-of instance-a))
     (format mystream "~%Instance: ~a" instance-a))
    (with-output-as-presentation
     (mystream (first slots-in-a) (presentation-type-of (first slots-in-a)) :single-box :position)
     (format mystream "~%Slot Allocation for Slot ~a" (first slots-in-a))
     (with-output-as-presentation
      (mystream first-from-a (presentation-type-of first-from-a) :single-box :highlighting)
      (format mystream "~%is from: ~a" first-from-a)))
    (with-output-as-presentation
     (mystream '(slots-in-a second-from-a) (presentation-type-of '(slots-in-a second-from-a)))
     (format mystream "~%Slot Allocation for Slot ~a is from: ~a"
         (second slots-in-a) second-from-a))
    (with-output-as-presentation
     (mystream '(instance-a class-of-a cpl-a) (presentation-type-of '(instance-a class-of-a cpl-a)))
     (format mystream "~%class-precedence-list for Instance ~a of Class ~a:~% ~a~%"
         instance-a class-of-a cpl-a))
    (with-output-as-presentation
     (mystream instance-b (presentation-type-of instance-b))
     (format mystream "~%Instance: ~a" instance-b))
    (with-output-as-presentation
     (mystream '(slots-in-b first-from-b) (presentation-type-of '(slots-in-b first-from-b)))
     (format mystream "~%Slot Allocation for Slot ~a is from: ~a"
         (first slots-in-b) first-from-b))
    (with-output-as-presentation
     (mystream '(slots-in-b second-from-b) (presentation-type-of '(slots-in-b second-from-b)))
     (format mystream "~%Slot Allocation for Slot ~a is from: ~a"
         (second slots-in-b) second-from-b))
    (with-output-as-presentation
     (mystream '(instance-b class-of-b cpl-b) (presentation-type-of '(instance-b class-of-b cpl-b)))
     (format mystream "~%class-precedence-list for Instance ~a of Class ~a:~% ~a~%"
         instance-b class-of-b cpl-b))
    (with-output-as-presentation
     (mystream instance-c (presentation-type-of instance-c))
     (format mystream "~%Instance: ~a" instance-c))
    (with-output-as-presentation
     (mystream '(slots-in-c first-from-c) (presentation-type-of '(slots-in-c first-from-c)))
     (format mystream "~%Slot Allocation for Slot ~a is from: ~a"
         (first slots-in-c) first-from-c))
    (with-output-as-presentation
     (mystream '(slots-in-c second-from-c) (presentation-type-of '(slots-in-c second-from-c)))
     (format mystream "~%Slot Allocation for Slot ~a is from: ~a"
         (second slots-in-c) second-from-c))
    (with-output-as-presentation
     (mystream '(instance-c class-of-c cpl-c) (presentation-type-of '(instance-c class-of-c cpl-c)))
     (format mystream "~%class-precedence-list for Instance ~a of Class ~a:~% ~a~%"
         instance-c class-of-c cpl-c))
    (with-output-as-presentation
     (mystream instance-d (presentation-type-of instance-d))
     (format mystream "~%Instance: ~a" instance-d))
    (with-output-as-presentation
     (mystream '(slots-in-d first-from-d) (presentation-type-of '(slots-in-d first-from-d)))
     (format mystream "~%Slot Allocation for Slot ~a is from: ~a"
         (first slots-in-d) first-from-d))
    (with-output-as-presentation
     (mystream '(slots-in-d second-from-d) (presentation-type-of '(slots-in-d second-from-d)))
     (format mystream "~%Slot Allocation for Slot ~a is from: ~a"
         (second slots-in-d) second-from-d))
    (with-output-as-presentation
     (mystream '(instance-d class-of-d cpl-d) (presentation-type-of '(instance-d class-of-d cpl-d)))
     (format mystream "~%class-precedence-list for Instance ~a of Class ~a:~% ~a~%"
         instance-d class-of-d cpl-d))
    (values)))