resize-sheet :after

[Paul Werkowski]

(defmethod resize-sheet :after ((pane example-pane) width height)
   (window-clear pane)
   (redisplay-frame-pane (pane-frame pane) pane))

Apparently no developer has tried this as there are two time bombs 
waiting to blow up the call stack.

WINDOW-CLEAR, besides writing +background-ink+ over the pane, goes on to 
set width and height of the sheet to zero and then call 
CHANGE-SPACE-REQUIREMENTS, which calls RESIZE-SHEET --> BOOM!

REDISPLAY-FRAME-PANE is implemented using RESTART-CASE, which in my 35 
years with CL I have never had the occasion to use. Its restartable-form 
manages to call itself via CALL-NEXT-METHOD (I think) which then blows 
the stack, which then unwinds back through various restart clauses (some 
which also call WINDOW-CLEAR), finally resulting in getting back to a 
listener prompt where one can bail out.

For my use, I have re-written those two methods in a way that works for 
the several places where I use resize-sheet :after with good results. 
The attachment is one of the test cases I used to diagnose the stack 
blowup. It displays a green filled circle in the center of the pane. 
Drag a side or corner of the frame around with your pointer device to 
cause the resize events to occur.

With those two changes my 15 year old CLIM2 plotting applications works 
quite well although there is still a few places where pointer motion or 
dragging yield strange results.

One other thing, if frame startup manages to silently load the NULL 
port, it may take a very long time to figure out why the lisp listener 
is dead. 🙁

Wishing you all a great new year!

Paul





-------------- next part --------------
(defpackage :junk (:use :clim-lisp :clim))
(in-package :junk)

(defclass example-pane2 (application-pane)
  ())

#+McCLIM ; from McCLIM source
(defmethod window-clear ((pane example-pane2))
  (stream-close-text-output-record pane)
  (let ((output-history (stream-output-history pane)))
    (with-bounding-rectangle* (left top right bottom) output-history
      (when (sheet-viewable-p pane)
        (medium-clear-area (sheet-medium pane) left top right bottom)))
    (clear-output-record output-history))
  (window-erase-viewport pane)
  (alexandria:when-let ((cursor (stream-text-cursor pane)))
    (setf (cursor-position cursor)
          (clim-extensions:stream-cursor-initial-position pane)))
  #+()
  (progn ; why is this here? Infinite recursion results
  (setf (climi::stream-width pane) 0)
  (setf (climi::stream-height pane) 0)
  (scroll-extent pane 0 0)
  (change-space-requirements pane)))

#+McCLIM
(defmethod redisplay-frame-pane :around
  ((frame application-frame) (pane climi::pane-display-mixin) &key force-p)
  (declare (ignore force-p))
  (funcall (climi::pane-display-function pane) (pane-frame pane) pane))

(defmethod resize-sheet :after ((pane example-pane2) x y)
  (declare (ignore x y))
  (window-clear pane)
  #| stack blown with redisplay-frame-pane
  44 Clear the output history of the pane and reattempt forceful redisplay.
  45 Clear the output history of the pane, but don't redisplay.
  46 Skip this redisplay.
  47 Clear the output history of the pane and reattempt forceful redisplay.
  48 Clear the output history of the pane, but don't redisplay.
  49 Skip this redisplay.
  50 (abort) Return to top loop level 0.
  |#
  ;#+clim-2.0
  (redisplay-frame-pane (pane-frame pane) pane)
  ;#+McCLIM (cpd2 (pane-frame pane) pane)
  )

(defun cpd2 (frame pane) ; display function
  (with-bounding-rectangle* (x1 y1 x2 y2) pane
    (let* ((w (- x2 x1))
           (h (- y2 y1))
           (r (* .1 (min w h))))
      (updating-output (pane)
        (draw-ellipse* pane (/ w 2) (/ h 2) r 0 0 r :ink +green+)))))

(define-application-frame test2 ()
  ()
  (:panes
   (p1 (make-pane 'example-pane2
                  :width  300 :max-width  +fill+
                  :height 300 :max-height +fill+
                  :display-function 'cpd2
                  :incremental-redisplay t
                  )))
  (:layouts 
   (vertically  p1)))

(defun tryit ()
  ;; grab edge or corner with mouse pointer and stretch
  #+:CLX
  (pushnew :clx *default-server-path*)
  (run-frame-top-level
   (make-application-frame 'test2)))