Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8355
Modified Files: panes.lisp Log Message: Add some convenience to viewports.
--- /project/mcclim/cvsroot/mcclim/panes.lisp 2006/07/09 06:23:22 1.170 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2006/10/16 23:53:52 1.171 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA.
-;;; $Id: panes.lisp,v 1.170 2006/07/09 06:23:22 ahefner Exp $ +;;; $Id: panes.lisp,v 1.171 2006/10/16 23:53:52 thenriksen Exp $
(in-package :clim-internals)
@@ -1849,6 +1849,29 @@ (defmethod note-input-focus-changed ((pane viewport-pane) state) (note-input-focus-changed (sheet-child pane) state))
+;; This method ensures that when the child changes size, the viewport +;; will move its focus so that it will not display a region outside of +;; `child' (if at all possible, this ideal can be circumvented by +;; creating a child sheet that is smaller than the viewport). I do not +;; believe having a viewport look at "empty" space is ever useful. +(defmethod note-space-requirements-changed ((pane viewport-pane) child) + (let ((viewport-width (bounding-rectangle-width pane)) + (viewport-height (bounding-rectangle-height pane)) + (child-width (bounding-rectangle-width child)) + (child-height (bounding-rectangle-height child))) + (destructuring-bind (horizontal-scroll vertical-scroll) + (mapcar #'- (multiple-value-list + (transform-position (sheet-transformation child) 0 0))) + (scroll-extent child + (if (> (+ horizontal-scroll viewport-width) + child-width) + (max 0 (- child-width viewport-width)) + horizontal-scroll) + (if (> (+ vertical-scroll viewport-height) + child-width) + (max 0 (- child-height viewport-height)) + vertical-scroll))))) + ;;;; ;;;; SCROLLER PANE ;;;;