[mcclim-cvs] CVS mcclim/Apps/Inspector
thenriksen
thenriksen at common-lisp.net
Tue Jan 1 22:51:03 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector
In directory clnet:/tmp/cvs-serv9218/Apps/Inspector
Modified Files:
inspector.lisp
Log Message:
Make Clouseau remember the scrolling position during redisplay, to
ease navigating large object trees.
Warning: somewhat of a hack.
--- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/12/20 10:46:54 1.38
+++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/01/01 22:51:03 1.39
@@ -53,6 +53,24 @@
(declare (ignore args))
(setf (gethash (obj frame) (dico frame)) t))
+;; Remember the scrolling state between redisplays.
+(defmethod redisplay-frame-panes :around ((frame inspector) &key force-p)
+ (declare (ignore force-p))
+ ;; `Make-clim-stream-pane' creates bizarro object hierarchies, so
+ ;; getting the actual scrollable is not obvious.
+ (let* ((scrollable-pane (sheet-parent (sheet-parent (find-pane-named frame 'app))))
+ (viewport (pane-viewport scrollable-pane)))
+ (multiple-value-bind (x-displacement y-displacement)
+ (transform-position (sheet-transformation scrollable-pane) 0 0)
+ (call-next-method)
+ (scroll-extent scrollable-pane
+ (min (- x-displacement)
+ (- (bounding-rectangle-width scrollable-pane)
+ (bounding-rectangle-width viewport)))
+ (min (- y-displacement)
+ (- (bounding-rectangle-height scrollable-pane)
+ (bounding-rectangle-height viewport)))))))
+
(defmethod redisplay-frame-pane :after ((frame inspector)
(pane application-pane)
&key force-p)
More information about the Mcclim-cvs
mailing list