[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