;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: XIT; Base: 10; -*-
;;;_________________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: PANED-WINDOW
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Hohl, Hubertus
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/paned-window.lisp
;;; File Creation Date: 9/05/90 13:15:09
;;; Last Modification Time: 09/29/92 14:36:31
;;; Last Modification By: Hubertus Hohl
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;; 11/28/1991 (Hubertus)  added ADD-CONFIGURATION, REMOVE-CONFIGURATION and
;;;                        CHANGE-CONFIGURATIONS for dynamically changing 
;;;                        the set of configurations.
;;; 12/19/1991 (Matthias)  DO-CONSTRINTS-INTERNAL: changed contact-total-width 
;;;                        to adjusted-total-width (dto. for height)
;;;                        Allows specification of :ask for more parts
;;;
;;; 01/13/1992 (Juergen)   adjust-size? for paned-window and its parts can
;;;                        now be set to t.  If not specified it still
;;;                        defaults to nil.
;;; 07/16/1992 (Hubertus)  fixed some bugs for paned-windows (panes) with 
;;;                        adjust-size? set to t.
;;;
;;; 07/27/1992 (Hubertus)  Incompatible change:  The value for the adjust-size? 
;;;                        attribute for paned-windows and panes now comes
;;;                        from the default supplied in the window's class definition
;;;                        (usually T) unless overridden explicitely in the :parts 
;;;                        description. This means that panes whose size is
;;;                        determined by the paned-window's constraint 
;;;                        specification should have :adjust-size? nil in their 
;;;                        part description.
;;;                        Additionally, paned-windows with a fized size should
;;;                        explicitely set their adjust-size? attribute to NIL.
;;; 08/04/1992 (Matthias)  supplemented: adjusted-window-size, returns maximum
;;;                        of root-node size and bounding-box of parts.
;;; 
;;; 09/29/92 (Hubertus)    Incompatible change to pane-layouters: 
;;;                        The generic function CONFIGURATIONS now returns a 
;;;                        list of configurations as specified by the 
;;;                        :configurations initarg or by (SETF CONFIGURATIONS).
;;;
;;;________________________________________________________________________________ 


(in-package :xit)

;;;_____________________________________________________________________________
;;; 
;;;		             Paned Windows
;;;_____________________________________________________________________________
;;;
;;; A Paned-Window is an intel, that layouts its parts (called panes) 
;;; based on a set of constraints that specify size and position of panes 
;;; symbolically. This set of constraints splits up the paned-window into
;;; panes that do not overlap each other. In general, a paned-window can have 
;;; many different configurations. Each configuration is described in the 
;;; constraint language, and each specifies one way of splitting up the paned-window.
;;; While the application is running, one can switch a paned-window from one
;;; configuration to another. Note that it is possible for panes to appear in
;;; more than one configuration.
;;; 
;;; Panes are defined by the :PARTS initialization keyword.
;;; Note that you must supply a unique :name <name> for the pane.
;;; This name is used in the :CONFIGURATIONS specification to refer 
;;; to an individual pane.
;;;
;;; The initial configuration is specified by the :CONFIGURATION init 
;;; keyword to the paned-window's layouter. Changing configurations 
;;; is performed by calling the layouter's (SETF CONFIGURATION) function.
;;; The SWITCH-CONFIGURATION function may be used to step successively through 
;;; configurations.
;;; 
;;; The :CONFIGURATIONS initarg for the layouter of the paned-window 
;;; describes the individual configurations, their panes and constraints. 
;;; It is an alist of the form:
;;;    
;;; ((<configuration-name> <pane-description>) ...)
;;;
;;; <configuration-name>   - a symbol that makes configurations distinguishable. 
;;; <pane-description>     - specifies the layout and constraints among the panes
;;;                          of the configuration
;;;
;;; <pane-description> ::= ((<name> <size> [<stacking-order> . <pane-description>])
;;;			    ...)
;;;
;;; <name> ::= <pane-name> | <non-pane-name>
;;; <pane-name> ::= <symbol>
;;; <non-pane-name> ::= <symbol>
;;; <part-name> ::= <symbol>
;;;
;;; <size> ::= <pixels> | <percent> | :even | :rest |
;;;            :ask | (:ask <pane-name> {<pixels>}) | (:ask <part-name> {<pixels>})
;;;
;;; <stacking-order> ::= :h | :v
;;;
;;; <pixels> ::= <fixnum>
;;; <percent> ::= <float> | <ratio>
;;; 
;;; The <name> of a pane description may either specify a pane (i.e. a part's 
;;; unique contact-name) or a space that can be further subdivided. In this case
;;; [<stacking-order> . <pane-description>] recursively specifies the division of the 
;;; space in subspaces. If a non-pane space is not subdivided, the layouter will leave
;;; this space empty. 
;;; Note that the toplevel pane descriptions are stacked vertically in the given order, 
;;; succeeding (nested) pane descriptions are stacked according to their stacking order
;;; (either horizontally or vertically). To stack the panes horizontally on the toplevel 
;;; use the following description: ((whole 1.0 :h ...)).
;;; Multiple spaces or panes with :REST or :EVEN size specs on the same level are 
;;; divided evenly.
;;; A space that uses (:ASK <pane-name>) as its size constraint gets its 
;;; corresponding size (total-width if stacked horizontally, total-height if stacked vertically) from
;;; the pane specified by <pane-name>. If the space describes a pane, the short form
;;; :ASK can be used to get pane's size.
;;; A space that is occupied by a pane and uses (:ASK <part-name>) as its size
;;; constraint gets its size from its part specified by <part-name>.
;;; For both long form versions of (:ASK ...) the optional third parameter specifies
;;; an additional size in pixels to be added to the size of the pane or part name.
;;;
;;; Note that the process of applying constraints to panes of a given configuration
;;; starts with the toplevel of the paned-window's layout description. By propagating
;;; constraints downwards along the nested levels of the constraint description,
;;; new values of position and size for each pane are calculated. During this
;;; process inconsistencies at lower levels are resolved in favor of higher level 
;;; descriptions. 
;;; Note that the process of applying constraints also depends on the adjust-size? 
;;; attributes of the paned-window and its panes. The value for this attribute comes
;;; from the default supplied in the window's class definition unless overridden 
;;; explicitely in the :parts description. If adjust-size? of the paned-window 
;;; is T (default), the paned-window adjusts its size depending on the sizes of 
;;; its panes. In this case at least one non-relative size description for a pane 
;;; has to be specified. If adjust-size? of the paned-window is NIL, the process 
;;; of applying constraints starts with the current width and height of the 
;;; paned-window. 
;;; 
;;;
;;; A typical paned-window :configuration setup might be:
;;;  
;;;  (config1 ((top-strip (:ask title) :h (title :rest) (icon :ask))
;;;            (middle-strip 0.3 :h (menu1 :even) (form 200) (menu2 :even))
;;;            (contents :rest)))
;;;
;;;  CONFIG1:     +---------------------------------------+
;;;               |          title                 | icon |
;;;               +--------------+---------+--------------+
;;;               |              |         |              |
;;;               |    menu1     |   form  |    menu2     |
;;;               |              |         |              |
;;;               +--------------+---------+--------------+
;;;               |                                       |
;;;               |                                       |
;;;               |               contents                |
;;;               |                                       |
;;;               |                                       |
;;;               |                                       |
;;;               +---------------------------------------+
;;;
;;; For the example above the height of the TOP-STRIP is determined by
;;; the (total) height of the TITLE pane. The MIDDLE-STRIP takes 30%
;;; of the paned-window's full height, the CONTENTS pane takes the rest.
;;; The panes MENU1 and MENU2 have equal width, together they occupy the 
;;; a width that results by subtracting 200 pixels (for the FORM pane) 
;;; from the full width of the paned-window.
;;;
;;; Another example:
;;;
;;;  (config2 ((menu1 :even)
;;;	       (middle-strip 150 :h (form :rest)
;;;				    (column (:ask icon) :v (icon :ask)))
;;;	       (menu2 :even)))
;;;
;;;  CONFIG2:     +---------------------------------------+
;;;               |                menu1                  |
;;;               |                                       |
;;;               +---------------------------------------+
;;;               |                               | icon  |
;;;               |          form                 +-------+
;;;               |                               |       |
;;;               |                               |       |
;;;               +-------------------------------+-------+
;;;               |                menu2                  |
;;;               |                                       |             
;;;               +---------------------------------------+
;;;
;;; As you can see, the MIDDLE-STRIP is divided into two columns:
;;; the right one holds the ICON pane and empty space below
;;; (its description (empty :rest) can be omitted because it is the last 
;;; space on this level!); the left column is the FORM pane.
;;; The width of the right column results from the ICON pane's width,
;;; the height of the ICON pane is asked from the pane itself.
;;; 


(defcontact paned-window (intel)
  ((name :initform :paned-window)
   (border-width :initform 1)
   (layouter :initform 'pane-layouter))
  (:documentation
    "Intels that maintain their parts (called panes) based on a set of constraints."))

(defmethod add-part ((self paned-window) &rest part-init-list &key)
  (let ((part (call-next-method)))
    ;; ensure that the geometry of a pane is initialized
    (with-slots (width height) part
      (or (plusp width)
	  (setf width 1))
      (or (plusp height)
	  (setf height 1)))
    part))

(defmethod initialize-instance :around ((self paned-window) &rest initargs)
  (prog1 (call-next-method)
    (with-slots (width height) self
      ;; ensure width and height are initialized
      (or (plusp width)
	  (setf width 1))
      (or (plusp height)
	  (setf height 1)))
    (initialize-configurations (layouter self))))


(defmethod layouted-parts ((self paned-window))
  (get-panes (layouter self)))

(defmethod adjusted-window-size ((self paned-window))
  ;; integrate the maybe empty space at the bottom of the paned-window's
  ;; current configuration (don't use bounding-size information)
  ;; 08/04/1992 (Matthias) maximize with bounding-box etc.
  (let* ((config (configuration (layouter self)))
	 (root-node (cadr (assoc config (parsed-configurations (layouter self))))))
    (if root-node
	(multiple-value-bind (width height)
	    (call-next-method)
	(values (max width (+ (constraint-node-width root-node) (x-margins self)))
		(max height (+ (constraint-node-height root-node) (y-margins self)))))
      (call-next-method))))

;;; CHANGE-LAYOUT takes care to rearrange the panes according to 
;;; the current configuration (i.e. set of active panes) and the
;;; constraints among them. 
;;; Additionally layout changes are propagated downwards to panes.
;;; 
(defmethod change-layout ((self paned-window) &optional newly-managed)
  (with-slots (children layouter layout-window?) self
    (when layout-window?
      (if layouter
	  (when (configurations-initialized-p layouter)
	    ;; ensure that constraints have already been parsed
	    ;; (change-layout may be called via update-state, before
	    ;; the configurations of the layouter have been initialized).
	    (do-constraints layouter)
	    (dolist (child (layouted-parts self))
	      (when (managed-p child)	; pane is active!
		(multiple-value-bind (x y w h b) (layout layouter child)
		  (change-geometry child :x x :y y :width w :height h
				   :border-width b)
		  (when (typep child 'layouted-window)
		    (without-adjusting-size child
		      (change-layout child)))))))
	  (call-next-method)) 
      (adjust-window-size self))))


;;; this relayouts paned-windows after size changes by the user
;;;
(defmethod resize-window-with-mouse :after ((self paned-window))
  (change-layout self))


;;;
;;;  a Layouter for Paned-Windows
;;;

(defclass pane-layouter (layouter)
  ((configurations :initform nil
		   :initarg :configurations
		   :accessor configurations)
   (parsed-configurations :initform nil
			  :reader parsed-configurations)
   (configuration :initform nil
		  :initarg :configuration
		  :accessor configuration))
  (:documentation "a layouter for paned-windows."))

  
;;; this code should really belong to an initialize-instance :after,
;;; however, when instantiating the layouter, the parts of the 
;;; paned-window are not yet around!
;;;
(defmethod initialize-configurations ((self pane-layouter))
  ;; initialize and process configurations from the value supplied
  ;; by the slot configurations
  (with-slots (window configuration configurations parsed-configurations) self
    (setf configurations
	(or configurations
	    (default-configurations self)))
    (parse-configurations self)
    (setf (configuration self)
	(or configuration (caar configurations)))))

(defmethod default-configurations ((self pane-layouter))
  ;; provide default configurations with all parts stacked vertically
  ;; (same size)
  (with-slots (window) self
    `((main
       ,(mapcan #'(lambda (part)
		    (when (slot-value part 'layouted?) ; filter out shadows etc.
		      `((,(contact-name part) :even))))
		(parts window))))))

(defmethod (setf configuration) :after (new-config (self pane-layouter))
  (change-active-panes self))


;;; Changing the set of configurations 
;;;

(defmethod (setf configurations) :after (new-value (self pane-layouter))
  (initialize-configurations self))

(defmethod change-configurations ((self pane-layouter) new-configurations
				  &optional current-configuration)
  (with-slots (configuration) self
    (setf configuration (or (and (assoc current-configuration
					new-configurations)
				 current-configuration)
			    (caar new-configurations))))
  (setf (configurations self) new-configurations))

(defmethod add-configuration ((self pane-layouter) configuration)
  (with-slots (configurations) self
    (let ((old-config  (assoc (car configuration) configurations)))
      (when old-config
	(setf configurations (delete old-config configurations)))
      (change-configurations self (cons configuration configurations)))))

(defmethod remove-configuration ((self pane-layouter) configuration-name)
  (with-slots (configurations) self
    (let ((old-config (assoc configuration-name configurations)))
      (when old-config
	(change-configurations self (delete old-config configurations))))))
      
;;; stepping tru configurations
;;; 
(defmethod switch-configuration ((self pane-layouter) &optional backwards-p)
  (with-slots (configurations) self
    (let ((configurations
	   (if backwards-p
	       (reverse configurations)
	     configurations)))
      (setf (configuration self)
	  (or
	   (caadr
	    (member (configuration self) configurations :key #'car))
	   (caar configurations))))))

;;;
;;; Parsing Constraints
;;;

(defstruct constraint-node
  name			   ; name of this node
  size			   ; size as specified by the user
  (subnodes nil)	   ; list of constraint subnodes
  order			   ; stacking order (:h or :v) of subnodes
  x			   ; node's current geometry
  y
  width
  height
  )
  
(defmethod parse-configurations ((self pane-layouter))
  ;; all unprocessed constraints specified by CONFIGURATIONS are parsed
  ;; and converted into an internal tree of constraint nodes, indexed by
  ;; configurations.
  (with-slots (window (parsed-configs parsed-configurations) configurations) self
    (let ((pane-nodes nil)
	  (parsed-configurations nil))
      (labels ((parse-constraints-internal (pane-description)
		 (mapcar #'(lambda (node-description)
			     (let* ((subs (parse-constraints-internal
					    (cdddr node-description)))
				    (node (make-constraint-node
					    :name (first node-description)
					    :size  (second node-description)
					    :order (third node-description)
					    :subnodes subs)))
			       (unless subs
				 (when (part window (first node-description))
				   (push node pane-nodes)))
			       node))
			 pane-description)))
	(dolist (config configurations)
	  (setq pane-nodes nil)
	  (push (list (first config)
		      (make-constraint-node
		       :subnodes (parse-constraints-internal (second config))
		       :name (gentemp "ROOT"))
		      pane-nodes)
		parsed-configurations))
	(setf parsed-configs (nreverse parsed-configurations))))))

(defmethod configurations-initialized-p ((self pane-layouter)
					 &optional configuration)
  (with-slots ((current-configuration configuration)) self
    (get-constraint-pane-nodes self (or (first configuration)
					current-configuration))))    

(defmethod get-constraint-pane-nodes ((self pane-layouter) configuration)
  (with-slots (parsed-configurations) self
    (caddr (assoc configuration parsed-configurations))))

(defmethod get-pane-constraints ((self pane-layouter) pane-name configuration)
  ;; returns pane's current x, y, width, height constraints or nil if
  ;; pane is not member of configuration.
    (let ((pane-node (find pane-name (get-constraint-pane-nodes self configuration)
			   :test #'eq
			   :key #'constraint-node-name)))
      (when pane-node
	(values (constraint-node-x pane-node)
		(constraint-node-y pane-node)
		(constraint-node-width pane-node)
		(constraint-node-height pane-node)))))

(defmethod get-panes ((self pane-layouter) &optional configuration)
  "Returns all panes belonging to configuration."
  (with-slots (window (config configuration)) self
    (mapcar #'(lambda (pane-node)
		(part window (constraint-node-name pane-node)))
	    (get-constraint-pane-nodes self (or configuration config)))))

(defmethod get-all-panes ((self pane-layouter))
  (with-slots (parsed-configurations) self
    (let ((panes nil))
      (dolist (config parsed-configurations)
	(dolist (pane (get-panes self (car config)))
	  (pushnew pane panes)))
      panes)))

(defmethod change-active-panes ((self pane-layouter))
  (with-slots (window) self
    (let ((active-panes (get-panes self)))
      (with-final-layout window
	(dolist (pane (get-all-panes self))
	  (setf (contact-state pane)
		(if (member pane active-panes)
		    :mapped
		    :withdrawn)))))))


;;; 
;;; Processing Constraints
;;;

(defmethod do-constraints ((self pane-layouter) &optional (stacking-order :v))
  ;; Given the current width and height of the paned-window, calculate new values
  ;; of position and size for each constraint node of the current configuration.
  (with-slots (window configuration parsed-configurations) self
    (with-slots (width height adjust-size?) window
      (let ((root-node (cadr (assoc configuration parsed-configurations))))
	(setf (constraint-node-x root-node) (x-margin window)
	      (constraint-node-y root-node) (y-margin window)
	      (constraint-node-width root-node) (if adjust-size? nil
						  (- width (x-margins window)))
	      (constraint-node-height root-node) (if adjust-size? nil
						   (- height (y-margins window)))
	      (constraint-node-order root-node) stacking-order)
	(do-constraints-internal self root-node)))))

(defun ask-p (list)
  (eq (car list) :ask))

(defmethod do-constraints-internal ((self pane-layouter) node)
  (with-slots (window) self
    (flet ((compute-node-first-dimension (node)
	     (when (constraint-node-subnodes node)
	       (let* ((stacking-order (constraint-node-order node))
		      (dim (case stacking-order
			     (:v (constraint-node-width node))
			     (:h (constraint-node-height node)))))
		 (unless dim
		   (let ((max-dim 0) pane)
		     (dolist (subnode (constraint-node-subnodes node))
		       (when (and (setq pane
				      (part window (constraint-node-name subnode)))
				  (adjust-size? pane))
			 (maxf max-dim
			       (case stacking-order
				 (:v (adjusted-total-width pane))
				 (:h (adjusted-total-height pane))))))
		     (case stacking-order
		       (:v (setf (constraint-node-width node) max-dim))
		       (:h (setf (constraint-node-height node) max-dim))))))))
	   (compute-node-second-dimension (node absolute-size relative-nodes)
	     (when (constraint-node-subnodes node)
	       (let* ((stacking-order (constraint-node-order node))
		      (dim (case stacking-order
			     (:v (constraint-node-height node))
			     (:h (constraint-node-width node))))
		      (ratios 0))
		 (unless dim
		   (dolist (node relative-nodes)
		     (incf ratios (constraint-node-size node)))
		   (when (or (zerop absolute-size)
			     (>= ratios 1))
		     (error "Attempt to specify subnodes with relative sizes only for adjustable node ~S."
			    node))
		   (case stacking-order
		     (:v (setf (constraint-node-height node)
			     (ceiling (/ absolute-size (- 1 ratios)))))
		     (:h (setf (constraint-node-width node)
			     (ceiling (/ absolute-size (- 1 ratios)))))))))))
      
      ;; determine node's width (height) for vertical (horizontal)
      ;; stacking order
      (compute-node-first-dimension node)

      (let ((x (constraint-node-x node))
	    (y (constraint-node-y node))
	    (width (constraint-node-width node))
	    (height (constraint-node-height node))
	    (stacking-order (constraint-node-order node))
	    (constraints (constraint-node-subnodes node))
	    (relative-nodes nil)
	    (rest-nodes nil)
	    (used-size 0))

	;; then determine height (width) for subnodes with absolute sizes
	(dolist (subnode constraints)
	  (multiple-value-bind (proposed-width proposed-height)	  
	      (etypecase (constraint-node-size subnode)
		(fixnum (case stacking-order
			  (:v (values width (constraint-node-size subnode)))
			  (:h (values (constraint-node-size subnode) height))))
		((or float ratio)
		 (push subnode relative-nodes)
		 (values nil nil))
		((member :ask)
		 (let ((pane (part window (constraint-node-name subnode))))
		   (case stacking-order
		     (:v (if (adjust-size? pane)
			     (values (adjusted-total-width pane)
				     (adjusted-total-height pane))
			   (values width (contact-total-height pane))))
		     (:h (if (adjust-size? pane)
			     (values (adjusted-total-width pane)
				     (adjusted-total-height pane))
			   (values (contact-total-width pane) height))))))
		((and list (satisfies ask-p))
		 (let* ((part-asked (or (part window (second (constraint-node-size subnode)))
				       (part (part window (constraint-node-name subnode))
					     (second (constraint-node-size subnode)))))
			(part-adjust-size? (adjust-size? part-asked)))
		   (case stacking-order
		     (:v (values width
				 (+
				  (if part-adjust-size?
				      (adjusted-total-height part-asked)
				    (contact-total-height part-asked))
				  (or (third (constraint-node-size subnode))
				      0))))
		     (:h (values (+
				  (if part-adjust-size?
				      (adjusted-total-width part-asked)
				    (contact-total-width part-asked))
				  (or (third (constraint-node-size subnode))
				      0))
				 height)))))
		((member :rest :even)
		 (push subnode rest-nodes)
		 (values nil nil)))
	    (when (and proposed-width proposed-height)
	      (case stacking-order
		(:v (setf (constraint-node-width subnode) proposed-width
			  (constraint-node-height subnode) (max 0 proposed-height))
		    (incf used-size (constraint-node-height subnode)))
		(:h (setf (constraint-node-width subnode) (max 0 proposed-width)
			  (constraint-node-height subnode) proposed-height)
		    (incf used-size (constraint-node-width subnode)))))))

	;; now determine node's height (width) using relative sizes
	(compute-node-second-dimension node used-size relative-nodes)

	;; now determine relative node height (width)
	(dolist (subnode relative-nodes)
	  (case stacking-order
	    (:v (setf (constraint-node-width subnode)
		      (constraint-node-width node)
		      (constraint-node-height subnode)
		      (max 0 (round (* (constraint-node-height node)
				       (constraint-node-size subnode)))))
		(incf used-size (constraint-node-height subnode)))
	    (:h (setf (constraint-node-width subnode)
		    (max 0 (round (* (constraint-node-width node)
				     (constraint-node-size subnode))))
		    (constraint-node-height subnode)
		    (constraint-node-height node))
		(incf used-size (constraint-node-width subnode)))))

	;; finally divide rest space evenly among rest nodes
	(when rest-nodes
	  (multiple-value-bind (rest-size rest-rest)
	      (floor (case stacking-order
		       (:v (max 0 (- (constraint-node-height node) used-size)))
		       (:h (max 0 (- (constraint-node-width node) used-size))))
		     (length rest-nodes))
	    (dolist (rnode rest-nodes)
	      (case stacking-order
		(:v (setf (constraint-node-height rnode)
			  rest-size
			  (constraint-node-width rnode)
			  (constraint-node-width node)))
		(:h (setf (constraint-node-width rnode)
			  rest-size
			  (constraint-node-height rnode)
			  (constraint-node-height node)))))
	    (case stacking-order
	      (:v (incf (constraint-node-height (first rest-nodes)) rest-rest))
	      (:h (incf (constraint-node-width (first rest-nodes)) rest-rest)))))

	;; now calculate new positions of subnodes
	(dolist (subnode constraints)
	  (setf (constraint-node-x subnode) x
		(constraint-node-y subnode) y)
	  (case stacking-order
	    (:v (incf y (constraint-node-height subnode)))
	    (:h (incf x (constraint-node-width subnode)))))
      
	;; and propagate constraints to subnodes by recursive descent
	(dolist (subnode constraints)
	  (do-constraints-internal self subnode))
	))))


(defmethod layout ((self pane-layouter) pane)
  (with-slots ((parent window) configuration) self
    (with-slots (border-width (px x) (py y) (pw width) (ph height)) pane
      (let ((origin (extent-origin parent)))
	(multiple-value-bind (x y width height)
	    (get-pane-constraints self (contact-name pane) configuration)
	  ;; Note that change-layout may be called while parts are added
	  ;; (via update-state -> initialize-geometry), however the layouter
	  ;; is not set up at that time. In this case we use the initial geometry
	  ;; of the pane (change-layout is called after initializing
	  ;; the paned-window anyway).
	  (if (and x y width height)
	      (values (+ (point-x origin) x)
		      (+ (point-y origin) y)
		      (max 1 (- width border-width border-width))
		      (max 1 (- height border-width border-width))
		      border-width)
	      (values px py pw ph border-width)))))))
