view bug and fix

[Andrew L. M. Shalit <alms>]

Here's a bug report from a user, followed by a fix.

     -andrew

-----bug report starts here------

If you remember, I called a while back with a question about views that don't
go away in MACL 1.3.2.  It seems that if there are more than two views in a
window, then after window-close is called, there are still ClipRgns in one or
more of them.  Here's a code snippet that reproduces it:
 
(setq wind (oneof *window*))
(setq view1 (oneof *view*
                   :view-position #@(0 0)
                   :content-size #@(16 16)
                   :view-container wind))
(setq view2 (oneof *view*
                   :view-position #@(0 0)
                   :content-size #@(16 16)
                   :view-container wind))
(setq view3 (oneof *view*
                   :view-position #@(0 0)
                   :content-size #@(16 16)
                   :view-container wind))
 
This of course creates a new window with three views attached.  If you now
close the window, then inspect it, you'll see that the view-subviews list still
contains a view, and that view's cliprgn still exists.  The same experiment
with only two views works fine.
-------bug report ends here-------

------fix starts here-------------
;put this code in a file, and load it to get the fix

(in-package :ccl)

(require 'traps)
(require 'records)

(ask *window*
  (fhave '%%window-close #'window-close))

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

(defobfun (window-close *window*) ()
  (when (ownp 'wptr)
    (let* ((wp wptr))
      (when wp
        (without-interrupts
         (map nil #'(lambda (subview)
                      (ask subview (set-view-container nil)))
              (copy-seq (objvar view-subviews)))
         (with-port wp (_ValidRect :ptr (rref wp window.portrect)))
         (setq *window-object-alist* 
               (delete (assoc wp *window-object-alist*)
                       *window-object-alist*))
         (_DisposWindow :ptr wp)
         (setf (objvar wptr) nil)
         (%%window-close)))))))

#|
(setq wind (oneof *window*))
(setq view1 (oneof *view*
                   :view-position #@(0 0)
                   :view-container wind))
(setq view2 (oneof *view*
                   :view-position #@(0 0)
                   :view-container wind))
(setq view3 (oneof *view*
                   :view-position #@(0 0)
                   :view-container wind))

;(inspect wind)
 
|#

-----bug fix ends here--------