;;; -*- Mode:COMMON-LISP; Package:X11; Base:10.; Fonts:(MEDFNB hl12B hl12bi) -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ;;; ;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved. ;;; Change history: ;;; ;;; Date Author Description ;;; ------------------------------------------------------------------------------------- ;;; 03/31/89 WJB Patch 1.68; In EXPOSE-WINDOW-PORTION, skip unmapped and input-only children. ;;; Eliminate unnecessary trace junk during expose event processing. ;;; 03/29/89 WJB Patch 1.64; In MAP-WINDOW use with-tree-locked when exposing to prevent error. ;;; 03/16/89 WJB Patch 1.47; In PAINT-REGION-BACKGROUND, adjust bg tile to align with parent. ;;; 03/15/89 WJB Patch 1.45; In UNLINK-WINDOW, protect from windows already unlinked. ;;; 03/09/89 WJB Patch 1.36; Change DESTROY-WINDOW to remove window from save-sets ;;; 03/09/89 WJB Patch 1.35; In Change-SaveSet, ensure window belongs to an other client. ;;; Also changed MAP-WINDOW to pass state as an arg to window-substructure-redirect-mask. ;;; 02/24/89 WJB Patch 1.24; Mapping a window with backing store the first time would ;;; wipe out overlapping siblings. Modified MAP-WINDOW, EXPOSE-EVENT, and ;;; EXPOSE-WINDOW-PORTION. ;;; 02/20/89 WJB Patch 1.18; Fix error in EXPOSE-WINDOW-PORTION, and change UNMAP-WINDOW to ;;; call remove-window *after* occlusion stacks are updated. ;;; 02/20/89 DAN Patch 1.16; Fixed UNMAP-WINDOW to remove any grabs/events associated ;;; with the window being unmapped. ;;; 02/16/89 WJB Patch 1.14; Change CIRCULATE-WINDOW to pass state arg to reflect-stack-change ;;; 02/10/89 DAN Patch 1.11; Fix REMOVE-WINDOW to not do anything if the window was INPUT-ONLY. ;;; 02/07/89 WJB Patch 1.7: Correct expose events with moving/restacking windows (the right way). ;;; In EXPOSE-WINDOW-PORTION, add optional arg to indicate whether we are ;;; dealing with old or new occlusion-stacks (i.e. have o.s. been ;;; updated since the new region was exposed). Also fix expose event counter. ;;; 02/01/89 WJB Patch 1.4: Added optional arg save-exposures to ;;; GENERATE-INFERIOR-OCCLUSION-STACKS ;;; which will record newly exposed areas in the window.exposures slot. ;;; 01/13/89 DAN Fixed GENERATE-INFERIOR-OCCLUSION-STACKS, REMOVE-WINDOW, and ;;; CIRCULATE-WINDOW to check for INPUT-ONLY windows. ;;; 12/21/88 LGO 1Fix unmap-subwindows to to from bottom to top stacking order.* ;;; 12/16/88 WJB 1Fix GENERATE-INFERIOR-OCCLUSION-STACKS for case where parent is occluded but child is not.* ;;; 12/07/88 WJB 1Changed MAP-WINDOW to generate expose events according to the occlusion stack.* ;;; 12/06/88 WJB 1Changed EXPOSE-EVENT back to calling PAINT-REGION-BACKGROUND which in turn was* ;;; changed to call X-BITBLT-CLIPPED. ;;; 11/28/88 DAN Fix MODIFY-OCCLUSION-STACK in GENERATE-INFERIOR-OCCLUSION-STACKS. ;;; 11/21/88 LGO 1Use paint-window-background instead of paint-region-background in expose-event* ;;; 11/21/88 LGO 1Move tree-lock from unmap-window to unmap-window-request to avoid configure-window deadlocks* ;;; 10/31/88 WJB Changed EXPOSE-EVENT to call PAINT-WINDOW-BACKGROUND to account for ;;; occlusion stack. Changed P-W-B to take optional args to specify a region. ;;; 10/26/88 WJB Added cursor locking/removal to requests as necessary. ;;; 10/114*/88 LGO 1Ensure map-window doesn't expose occluded regions.* ;;; 10/11/88 LGO 1When reparent moves a window, ensure the occlusion stack is moved too.* ;;; 10/11/88 WJB Wrapped perform-graphics around DRAW-BORDER code. ;;; 10/10/88 LGO Fix REPARENT-WINDOW to handle the only child case correctly. ;;; 10/10/88 LGO Replace 1all *(DOLIST (CHILD (MAKE-CHILD-LIST-REVERSE WINDOW)) ... ;;; with (loop for child being the xwindow-children of window doing... ;;; 9/130*/88 LGO 1Fix unmap-window to update the occlusion stacks for all affected windows.* ;;; 9/27/88 LGO Align the background properly in PAINT-REGION-BACKGROUND ;;; 9/26/88 DAN Fix MAP-WINDOW to pass the correct thing to MAP-REQUEST-EVENT. ;;; 9/23/88 LGO Fix destructive list bug in GENERATE-INFERIOR-OCCLUSION-STACKS ;;; 9/22/88 LGO 1Don't draw borders when width is zero* ;;; 9/20/88 LGO Fix MAP-WINDOW to not send exposure events on unrealized windows ;;; 9/07/88 LGO 1Remove redundent call to window-border from DRAW-BORDERS and *EXPOSE-WINDOW-PORTION ;;; 9/07/88 LGO 1Remove redundent call to window-background from *PAINT-REGION-BACKGROUND1 and *MAP-WINDOW ;;; 9/07/88 LGO 1Fix destroy-window to not unlink until after children are destroyed * ;;; 9/07/88 LGO 1Re-write unlink-window to handle the only child case correctly.* ;;; 9/06/88 LGO Don't bomb in CIRCULATE-WINDOW when there aren't any children. ;;; 8/24/88 DAN Added call to REMOVE-RESOURCE to DESTROY-WINDOW. ;;; 7/06/88 WJB Fixed MAP-WINDOW to pass correct args to MAP-REQUEST-EVENT. ;;; 6/14/88 TWE Fixed REPARENT-WINDOW and MAP-WINDOW to handle children. ;;; 6/07/88 DAN Fixed MAP-WINDOW to handle override-redirect correctly. ;;; 6/01/88 TWE Fixed EXPOSE-EVENT to do clipping of its arguments to the ;;; window's boundaries. ;;; 5/10/88 TWE Implemented reparent-window, circulate-window and query-tree. ;;; 5/06/88 TWE Implemented the WINDOW.REALIZED-P slot in the map and unmap code. ;;; 5/05/88 TWE Added a new argument to EXPOSE-EVENT and EXPOSE-EVENTS to allow ;;; one to only wipe out the window's contents and not generate the ;;; event. ;;; 4/26/88 TWE Updated several functions that refer to the backing store so that ;;; they also make sure the backing store is the right size. ;;; 4/18/88 TWE Implemented GENERATE-ALL-INFERIORS-OCCLUSION-STACKS. ;;; 4/15/88 TWE Fixed unmap-window to not unlink the window too. ;;; 4/15/88 TWE Fixed GENERATE-INFERIOR-OCCLUSION-STACKS to restrict a child to ;;; only its parent's interior. ;;; 4/08/88 TWE Wrote EXPOSE-EVENTS as an easy-to-use interface to EXPOSE-EVENT. ;;; 3/31/88 TWE Moved configure-window code to a separate file. ;;; 3/29/88 TWE Added PAINT-WINDOW-BACKGROUND and PAINT-REGION-BACKGROUND, ;;; RESTORE-AREAS and SAVE-AREAS ;;; 3/10/88 TWE Filled in the events that were stubbed out. ;;; 3/02/88 TWE Changed GENERATE-INFERIOR-OCCLUSION-STACKS to call ;;; WINDOWS-RESTRUCTURED like the C code does. ;;; 3/01/88 KDB Fixed up MAP-WINDOW to call expose-event with the proper X,Y ;;; window corner. ;;; 2/19/88 TWE Changed trace code to call the server-trace function instead. ;;; 1/29/88 TWE Fixed more problems with deeply nested children having parts of ;;; them becoming visible. ;;; 1/28/88 TWE Fixed expose-event to use x-bitblt instead of X-COPY-TO-WINDOW. ;;; The coordinates given were absolute, X-COPY-TO-WINDOW assumed ;;; they were window-relative, which incorrectly modified the ;;; screen. ;;; 1/25/88 TWE Made various fixes to GENERATE-INFERIOR-OCCLUSION-STACKS and ;;; EXPOSE-EVENT. ;;; 1/22/88 TWE Updated GENERATE-INFERIOR-OCCLUSION-STACKS to handle the case ;;; where the parent isn't completely visible. In that case, the ;;; child occlusion stack starts out to be that part of the child ;;; which is visible through the parent. ;;; 1/19/88 TWE Changed unmap code to not refresh screen if one of its ancesters ;;; isn't mapped. ;;; 1/16/88 TWE Fixed an infinite loop in GENERATE-INFERIOR-OCCLUSION-STACKS. ;;; 1/15/88 TWE Fixed a problem in EXPOSE-WINDOW-PORTION. Implemented ;;; destroy-window and destroy-subwindows. ;;; 1/13/88 TWE Modified the expose event handler to update the region with the ;;; background tile, if any is present. Changed references to ;;; tv:initial-lisp-listener to *monochrome-server-trace*. Fixed ;;; various bugs in the unmap-window request. ;;; 1/11/88 TWE Implemented unmap-window, and its support code. ;;; 1/06/88 TWE Changed make-window-box to use absolute coordinates so that ;;; bitblt-under-mask would be easier to implement. ;;; 1/05/88 TWE Fixed map-window to also update the occlusion stack for the ;;; parent window, instead of just to the window's inferiors. ;;; 12/21/87 TWE Added code to implement the occlusion stack. ;;; 12/18/87 TWE Implemented map-window, map-subwindows and partially implemented ;;; unmap-window. ;;; 12/15/87 TWE Moved requests from the REQUESTS file. Implemented the ;;; change-save-set request. (defreq Change-SaveSet ((mode (CARD8 Saveset-Insert Saveset-Delete)) (window WINDOW)) (CHANGE-SAVE-SET STATE MODE WINDOW)) (DEFUN CHANGE-SAVE-SET (STATE MODE WINDOW) (IF (EQ (WINDOW.CLIENT WINDOW) STATE) ;; Client cannot add own window to save-set. (BAD-MATCH) (IF (= MODE SAVESET-INSERT) (PUSHNEW WINDOW (STATE.SAVE-SET STATE)) ;;ELSE - Saveset delete (SETF (STATE.SAVE-SET STATE) (REMOVE WINDOW (STATE.SAVE-SET STATE)))))) (DEFUN MAP-REQUEST-EVENT (STATE WINDOW) (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW)) (LET ((EVENT (MAKE-EVENT-MAP-REQUEST :TYPE MAP-REQUEST-EVENT :PARENT (WINDOW.PARENT WINDOW) :WINDOW WINDOW))) (MAYBE-DELIVER-EVENTS-TO-CLIENT (WINDOW.PARENT WINDOW) EVENT 1 SUBSTRUCTURE-REDIRECT-MASK STATE))) (DEFUN MAP-NOTIFY-EVENT (STATE WINDOW) (DECLARE (IGNORE STATE) (TYPE WINDOW WINDOW)) (LET ((EVENT (MAKE-EVENT-MAP-NOTIFY :TYPE MAP-NOTIFY-EVENT :WINDOW WINDOW :OVERRIDE (WINDOW.OVERRIDE-REDIRECT WINDOW)))) (DELIVER-EVENTS WINDOW EVENT 1 NIL))) (DEFUN PAINT-REGION-BACKGROUND (WINDOW X Y WIDTH HEIGHT) ;; The miexpose.c code in /server/ddx/mi/ restores the background tile, if one exists. ;; If there was a background pixel, we already converted it to ;; a pixmap and store it into the background-pixmap attribute. ;; any background-pixmap specified. (LET ((BACKGROUND-PIXMAP (WINDOW-BACKGROUND WINDOW)) INSIDE-X INSIDE-Y) #+comment (SERVER-TRACE "~%PAINT-REGION-BACKGROUND: window= ~s x= ~d y= ~d width= ~d height= ~d~ BACKGROUND-PIXMAP= ~s" WINDOW X Y WIDTH HEIGHT BACKGROUND-PIXMAP) (UNLESS (EQL BACKGROUND-PIXMAP UNIVERSAL-NONE) ;; For parent-relative background, adjust the offset into the pixmap ;; to align the tile with existing background (LOOP FOR W FIRST WINDOW THEN (WINDOW.PARENT W) UNTIL (OR (NOT (EQL (WINDOW.BACKGROUND-PIXMAP W) PARENT-RELATIVE)) (NULL (WINDOW.PARENT W))) FINALLY (SETQ INSIDE-X (WINDOW.ABSOLUTE-INSIDE-X W) INSIDE-Y (WINDOW.ABSOLUTE-INSIDE-Y W))) (X-BITBLT-CLIPPED GX-COPY WIDTH HEIGHT (PIXMAP.ARRAY BACKGROUND-PIXMAP) (MOD (- X INSIDE-X) (PIXMAP.WIDTH BACKGROUND-PIXMAP)) (MOD (- Y INSIDE-Y) (PIXMAP.HEIGHT BACKGROUND-PIXMAP)) (DEVICE-PRIVATE-ARRAY WINDOW) X Y)))) (DEFUN PAINT-WINDOW-BACKGROUND (WINDOW &OPTIONAL X Y WIDTH HEIGHT) (LET ((OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW))) ;;(server-trace "~%Entering PAINT-WINDOW-BACKGROUND: window= ~s x= ~s y= ~s width= ~s height= ~s OCCLUSION-STACK= ~s" window x y width height OCCLUSION-STACK) (COND ((NULL X) ;;(server-trace "~%In PAINT-WINDOW-BACKGROUND: painting entire window") ;; Paint entire window (COND ((NULL OCCLUSION-STACK) ;; Can't see the window. Don't do anything ) ((EQ T OCCLUSION-STACK) (PAINT-REGION-BACKGROUND WINDOW (WINDOW.ABSOLUTE-INSIDE-X WINDOW) (WINDOW.ABSOLUTE-INSIDE-Y WINDOW) (WINDOW.WIDTH WINDOW) (WINDOW.HEIGHT WINDOW))) (T (LOOP FOR BOX IN OCCLUSION-STACK DO (PAINT-REGION-BACKGROUND WINDOW (BOX.LEFT BOX) (BOX.TOP BOX) (BOX.WIDTH BOX) (BOX.HEIGHT BOX)))))) (:ELSE ;;(server-trace "~%In PAINT-WINDOW-BACKGROUND: painting specified area") ;; Paint specified area (COND ((NULL OCCLUSION-STACK) ;;(server-trace "~%In PAINT-WINDOW-BACKGROUND: Can't see the window. Don't do anything") ;; Can't see the window. Don't do anything ) ((EQ OCCLUSION-STACK T) ;;(server-trace "~%In PAINT-WINDOW-BACKGROUND: All visible, calling PAINT-REGION-BACKGROUND") (PAINT-REGION-BACKGROUND WINDOW X Y WIDTH HEIGHT)) (T ;;(server-trace "~%In PAINT-WINDOW-BACKGROUND: Partially visible, calling PAINT-REGION-BACKGROUND in loop") ;; Partially visible. ;; Iterate through each box of the occlusion stack which ;; intersects with specified part of the window. (LOOP FOR INNER-BOX IN (SET-INTERSECT-BOXES OCCLUSION-STACK (MAKE-BOX :LEFT X :TOP Y :WIDTH WIDTH :HEIGHT HEIGHT)) DO (PAINT-REGION-BACKGROUND WINDOW (BOX.LEFT INNER-BOX) (BOX.TOP INNER-BOX) (BOX.WIDTH INNER-BOX) (BOX.HEIGHT INNER-BOX)))))))) ;;(server-trace "~Exiting PAINT-WINDOW-BACKGROUND") ) (DEFUN EXPOSE-EVENT (STATE WINDOW X Y WIDTH HEIGHT &OPTIONAL (COUNT 0) (GENERATE-EVENT T)) ;; The (X,Y) values are absolute coordinates for X-BITBLT. (DECLARE (IGNORE STATE) (TYPE WINDOW WINDOW) (TYPE INTEGER X Y WIDTH HEIGHT COUNT)) (LET* ((WINDOW-WIDTH (WINDOW.WIDTH WINDOW)) (WINDOW-HEIGHT (WINDOW.HEIGHT WINDOW)) (ABS-X (WINDOW.ABSOLUTE-INSIDE-X WINDOW)) (ABS-Y (WINDOW.ABSOLUTE-INSIDE-Y WINDOW)) (RIGHT-EDGE (+ ABS-X WINDOW-WIDTH)) (BOTTOM-EDGE (+ ABS-Y WINDOW-HEIGHT))) ;;(server-trace "~%Entering EXPOSE-EVENT: window= ~s x= ~s y= ~s width= ~s height= ~s" window x y width height) (WHEN (> X RIGHT-EDGE ) (SETQ X RIGHT-EDGE)) (WHEN (> Y BOTTOM-EDGE) (SETQ Y BOTTOM-EDGE)) (WHEN (> (+ X WIDTH ) RIGHT-EDGE ) (SETQ WIDTH (- RIGHT-EDGE X))) (WHEN (> (+ Y HEIGHT) BOTTOM-EDGE) (SETQ HEIGHT (- BOTTOM-EDGE Y))) ;;(server-trace "~%In EXPOSE-EVENT: plusp w & h= ~s" (AND (PLUSP WIDTH) (PLUSP HEIGHT))) (WHEN (AND (PLUSP WIDTH) (PLUSP HEIGHT)) (WHEN (WINDOW.REALIZED-P WINDOW) (PAINT-WINDOW-BACKGROUND WINDOW X Y WIDTH HEIGHT)) (WHEN GENERATE-EVENT (SERVER-TRACE "~%Expose event for window #x~16R, (~D,~D) (W,H)=(~d,~d), count=~D" (WINDOW.ID WINDOW) X Y WIDTH HEIGHT COUNT) (LET ((EVENT (MAKE-EVENT-EXPOSE :TYPE EXPOSE-EVENT :WINDOW WINDOW ;; Convert the absolute coordinates to be relative to ;; the window's origin. :X (- X (WINDOW.ABSOLUTE-INSIDE-X WINDOW)) :Y (- Y (WINDOW.ABSOLUTE-INSIDE-Y WINDOW)) :WIDTH WIDTH :HEIGHT HEIGHT :COUNT COUNT))) (DELIVER-EVENTS WINDOW EVENT (1+ COUNT) NIL))))) ;;(server-trace "~%Exiting EXPOSE-EVENT") ) ;;; Easy-to-use interface to EXPOSE-EVENT. (DEFUN EXPOSE-EVENTS (STATE WINDOW BOXES &OPTIONAL (GENERATE-EVENT T)) (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW) (TYPE LIST BOXES)) ;;(server-trace "~%Entering EXPOSE-EVENTS: window= ~s boxes= ~s" window boxes) (LOOP FOR BOX IN BOXES FOR COUNT DOWNFROM (1- (LENGTH BOXES)) DO (EXPOSE-EVENT STATE WINDOW (BOX.LEFT BOX) (BOX.TOP BOX) (BOX.WIDTH BOX) (BOX.HEIGHT BOX) COUNT GENERATE-EVENT))) (DEFUN RESTORE-AREAS (WINDOW &OPTIONAL (OCCLUSION-STACK NIL OCCLUSION-STACK-SUPPLIED)) "Restore areas from backing-store that are no longer obscured." (DECLARE (TYPE WINDOW WINDOW)) (server-trace "~%Entering RESTORE-AREAS: window= ~s OCCLUSION-STACK= ~s" window OCCLUSION-STACK) (VALIDATE-BACKING-STORE WINDOW) ;; Allow the caller to also specify which areas are to be restored. (WHEN (NOT OCCLUSION-STACK-SUPPLIED) (SETQ OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW))) (LET ((BACKING-STORE (WINDOW.BACKING-STORE WINDOW))) (COND ((NULL OCCLUSION-STACK) (server-trace "~%RESTORE-AREAS: Not visible - do nothing") ;; Not visible at all. Do nothing. ) ((EQ OCCLUSION-STACK T) (server-trace "~%RESTORE-AREAS: completely visible - calling x-copy-to-window") ;; Completely visible. Copy backing store to display. (X-COPY-TO-WINDOW (WINDOW.WIDTH WINDOW) (WINDOW.HEIGHT WINDOW) BACKING-STORE 0 0 WINDOW 0 0)) (T (server-trace "~%RESTORE-AREAS: partially visible - calling x-copy-to-window in loop") ;; Partially visible. Make those parts we can see visible. ;; Iterate through each box of the occlusion stack which ;; intersects with the interior part of the window. (LOOP WITH ABSOLUTE-X = (WINDOW.ABSOLUTE-INSIDE-X WINDOW) WITH ABSOLUTE-Y = (WINDOW.ABSOLUTE-INSIDE-Y WINDOW) FOR INNER-BOX IN (SET-INTERSECT-BOXES OCCLUSION-STACK (MAKE-WINDOW-BOX-INTERIOR WINDOW)) FOR BOX-X = (- (BOX.LEFT INNER-BOX) ABSOLUTE-X) FOR BOX-Y = (- (BOX.TOP INNER-BOX) ABSOLUTE-Y) DO (X-COPY-TO-WINDOW (BOX.WIDTH INNER-BOX) (BOX.HEIGHT INNER-BOX) BACKING-STORE BOX-X BOX-Y WINDOW BOX-X BOX-Y))))) (server-trace "~%Exiting RESTORE-AREAS")) (DEFUN SAVE-AREAS (WINDOW) ;1; Update backing store from the screen* (DECLARE (TYPE WINDOW WINDOW)) (refresh-from-backing-store window) ;1; Update screen from backing store (just in case)* (LET ((OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) (BACKING-STORE (WINDOW.BACKING-STORE WINDOW))) ;; Can't save anything without a backing store. (WHEN (and (EQ OCCLUSION-STACK T) BACKING-STORE (not (window.backing-store-valid window))) (validate-backing-store window) ;; Save the window contents on the backing store. (X-COPY-FROM-WINDOW (WINDOW.WIDTH WINDOW) (WINDOW.HEIGHT WINDOW) WINDOW 0 0 BACKING-STORE 0 0) (setf (window.backing-store-valid window) t)))) (DEFREQ MAP-WINDOW ((WINDOW WINDOW)) (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW) (MAP-WINDOW STATE WINDOW))) (ZWEI:DEFINE-INDENTATION CHECK-INFERIORS (1 1)) (ZWEI:DEFINE-INDENTATION EXPOSE-CHILDREN (1 1)) (DEFUN MAP-WINDOW (STATE WINDOW) ;; If the window is already mapped then we are done. (WHEN (NOT (WINDOW.MAPPED-P WINDOW)) (LET* ((PARENT (WINDOW.PARENT WINDOW)) (REDIRECT-CLIENT (WINDOW-SUBSTRUCTURE-REDIRECT-MASK PARENT STATE))) ;;(SERVER-TRACE "~%in MAP-WINDOW: (WINDOW.OVERRIDE-REDIRECT WINDOW)= ~s (WINDOW-SUBSTRUCTURE-REDIRECT-MASK PARENT)= ~s" ;;(WINDOW.OVERRIDE-REDIRECT WINDOW) (WINDOW-SUBSTRUCTURE-REDIRECT-MASK PARENT)) (IF (AND (= (WINDOW.OVERRIDE-REDIRECT WINDOW) FALSE) REDIRECT-CLIENT) (MAP-REQUEST-EVENT STATE WINDOW) ;;(MAP-REQUEST-EVENT (OTHER-CLIENT.CLIENT REDIRECT-CLIENT) WINDOW) ;;1ELSE* (PROGN (VALIDATE-BACKING-STORE WINDOW) (SETF (WINDOW.MAPPED-P WINDOW) T) ;; A window is realized if it and its ancestors are mapped. (SETF (WINDOW.REALIZED-P WINDOW) (LET ((ANCESTOR PARENT)) (LOOP (WHEN (NOT (WINDOW.MAPPED-P ANCESTOR)) (RETURN NIL)) (SETQ ANCESTOR (WINDOW.PARENT ANCESTOR)) (WHEN (NULL ANCESTOR) (RETURN T))))) ;; Need to do the same for children. (WHEN (WINDOW.REALIZED-P WINDOW) (LABELS ((CHECK-INFERIORS (WINDOW) "Check inferiors of WINDOW to see if they are realized." (LET ((CHILD (WINDOW.FIRST-CHILD WINDOW)) (LAST-CHILD (WINDOW.LAST-CHILD WINDOW))) (WHEN CHILD (LOOP (WHEN (WINDOW.MAPPED-P CHILD) (SETF (WINDOW.REALIZED-P CHILD) T) (CHECK-INFERIORS CHILD)) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))))) (CHECK-INFERIORS WINDOW))) (SERVER-TRACE "~% before MAP-NOTIFY-EVENT") (MAP-NOTIFY-EVENT STATE WINDOW) (SERVER-TRACE "~% after MAP-NOTIFY-EVENT") ;; The following was taken from the protocol spec, dated September 1987. ;; If the window is now viewable and its contents had been discarded, then the window ;; is tiled with its background and exposure events are generated. If a backing ;; store has been maintained while the window was unmapped, no exposure events are ;; generated. If a backing store will now be maintained, a full-window exposure is ;; always generated; otherwise only visible regions may be reported. Similar tiling ;; and exposure take place for any newly viewable inferiors. ;; Regenerate the occlusion stack for this window's parent. (WITH-TREE-LOCKED (PARENT) (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS PARENT) (SERVER-TRACE "~% Parent occlusion stack = ~A" (WINDOW.OCCLUSION-STACK PARENT)) (SERVER-TRACE "~% My occlusion stack = ~A" (WINDOW.OCCLUSION-STACK WINDOW)) (WHEN (AND (NOT (WINDOW.BACKING-STORE WINDOW)) (NOT (= (WINDOW.BACKING-STORE-SUPPORT WINDOW) STORE-NOT-USEFUL))) ;; We don't have a backing store but the backing store attribute ;; indicates that we need to have one. (VALIDATE-BACKING-STORE WINDOW :CREATE :BACKGROUND) ;; 1First time, *Generate an exposure event on the window1 to fill the backing store* (EXPOSE-EVENT STATE WINDOW (WINDOW.ABSOLUTE-INSIDE-X WINDOW) (WINDOW.ABSOLUTE-INSIDE-Y WINDOW) (WINDOW.WIDTH WINDOW) (WINDOW.HEIGHT WINDOW))) ;; If there was a background pixel, we already converted it to ;; a pixmap and store it into the background-pixmap attribute. ;; any background-pixmap specified. (EXPOSE-WINDOW-PORTION WINDOW STATE (LIST (MAKE-WINDOW-BOX-INTERIOR WINDOW))))))))) (DEFUN WINDOWS-INTERSECT-P (WINDOW1 WINDOW2) "1Returns T if WINDOW1 intersects WINDOW2*." (NOT (OR (<= (+ (WINDOW.OUTSIDE-WIDTH WINDOW2) (WINDOW.X WINDOW2)) (WINDOW.X WINDOW1)) (<= (+ (WINDOW.OUTSIDE-WIDTH WINDOW1) (WINDOW.X WINDOW1)) (WINDOW.X WINDOW2)) (<= (+ (WINDOW.OUTSIDE-HEIGHT WINDOW2) (WINDOW.Y WINDOW2)) (WINDOW.Y WINDOW1)) (<= (+ (WINDOW.OUTSIDE-HEIGHT WINDOW1) (WINDOW.Y WINDOW1)) (WINDOW.Y WINDOW2))))) (DEFUN MAKE-WINDOW-BOX (WINDOW) "Returns a box structure representing the window, including its borders. The absolute coordinate system is used." (MAKE-BOX :LEFT (WINDOW.ABSOLUTE-X-CORNER WINDOW) :TOP (WINDOW.ABSOLUTE-Y-CORNER WINDOW) :WIDTH (WINDOW.OUTSIDE-WIDTH WINDOW) :HEIGHT (WINDOW.OUTSIDE-HEIGHT WINDOW))) (DEFUN MAKE-WINDOW-BOX-INTERIOR (WINDOW) "Returns a box structure representing the window, excluding its borders. The absolute coordinate system is used." (MAKE-BOX :LEFT (WINDOW.ABSOLUTE-INSIDE-X WINDOW) :TOP (WINDOW.ABSOLUTE-INSIDE-Y WINDOW) :WIDTH (WINDOW.WIDTH WINDOW) :HEIGHT (WINDOW.HEIGHT WINDOW))) (DEFUN SEND-VISIBILITY-NOTIFY (WINDOW) (DECLARE (TYPE WINDOW WINDOW)) (LET* ((OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) (EVENT (MAKE-EVENT-VISIBILITY :TYPE VISIBILITY-NOTIFY-EVENT :WINDOW WINDOW :STATE (COND ((EQ OCCLUSION-STACK T) Visibility-Unobscured) ((EQ OCCLUSION-STACK NIL) Visibility-Fully-Obscured) (T Visibility-Partially-Obscured))))) (DELIVER-EVENTS WINDOW EVENT 1 NIL))) (DEFUN BOX-SORTER (BOX1 BOX2) "Key for SORT to do a lessp predicate on boxes 1 and 2." (COND ((< (BOX.LEFT BOX1) (BOX.LEFT BOX2)) T) ((< (BOX.TOP BOX1) (BOX.TOP BOX2)) T) ((< (BOX.RIGHT BOX1) (BOX.RIGHT BOX2)) T) ((< (BOX.BOTTOM BOX1) (BOX.BOTTOM BOX2)) T) (T NIL))) #| Test cases for box-sorter: (box-sorter (make-box :left 0 :top 0 :width 10 :height 10) (make-box :left 0 :top 0 :width 10 :height 10)) (box-sorter (make-box :left 0 :top 0 :width 10 :height 10) (make-box :left 0 :top 0 :width 10 :height 11)) (box-sorter (make-box :left 0 :top 0 :width 10 :height 10) (make-box :left 0 :top 0 :width 11 :height 10)) (box-sorter (make-box :left 0 :top 0 :width 10 :height 10) (make-box :left 0 :top 1 :width 10 :height 9)) (box-sorter (make-box :left 0 :top 0 :width 10 :height 10) (make-box :left 1 :top 0 :width 9 :height 10)) |# (ZWEI:DEFINE-INDENTATION OVERLAPS-SIBLING (1 1)) (ZWEI:DEFINE-INDENTATION MODIFY-OCCLUSION-STACK (1 1)) (DEFUN GENERATE-INFERIOR-OCCLUSION-STACKS (WINDOW &OPTIONAL SAVE-EXPOSURES) "Create the occlusion stacks for the inferiors of WINDOW. This represents those parts of the children which can be seen on the screen." (FLET ((OVERLAPS-SIBLING (WINDOW) "Returns the higher-level sibling window which overlaps WINDOW, or NIL if no window overlaps WINDOW." (LET ((CHILD (WINDOW.FIRST-CHILD (WINDOW.PARENT WINDOW)))) (LOOP (WHEN (EQ CHILD WINDOW) ;; We are back to our window, which means that no other window ;; overlaps us. (RETURN NIL)) (WHEN (AND (WINDOW.MAPPED-P CHILD) (NOT (EQL (window.class child) input-only)) (WINDOWS-INTERSECT-P WINDOW CHILD)) ;; A mapped window intersects us. (RETURN CHILD)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))) (MODIFY-OCCLUSION-STACK (WINDOW VALUE) "Change the occlusion stack for WINDOW, generating a Visibility-Notify event if the value really changes." (LET* ((OLD-OCCLUSION-BOXES (OCCLUSION-STACK-TO-LIST WINDOW (WINDOW.OCCLUSION-STACK WINDOW))) (NEW-OCCLUSION-BOXES (OCCLUSION-STACK-TO-LIST WINDOW VALUE)) (CHANGED-P ;; Do the quick and easy checks first leaving the more complex ones for last. (COND ((EQ OLD-OCCLUSION-BOXES NEW-OCCLUSION-BOXES) NIL) ((EQUAL OLD-OCCLUSION-BOXES NEW-OCCLUSION-BOXES) NIL) ((NOT (= (LENGTH OLD-OCCLUSION-BOXES) (LENGTH NEW-OCCLUSION-BOXES))) T) (T (LET ((NOT-SURE ;; Assume that the order of the two lists is the same first. (LOOP FOR OLD-BOX IN OLD-OCCLUSION-BOXES FOR NEW-BOX IN NEW-OCCLUSION-BOXES DO (WHEN (OR (NOT (= (BOX.LEFT OLD-BOX) (BOX.LEFT NEW-BOX))) (NOT (= (BOX.TOP OLD-BOX) (BOX.TOP NEW-BOX))) (NOT (= (BOX.RIGHT OLD-BOX) (BOX.RIGHT NEW-BOX))) (NOT (= (BOX.BOTTOM OLD-BOX) (BOX.BOTTOM NEW-BOX)))) (RETURN T)) FINALLY (RETURN NIL)))) (IF NOT-SURE (PROGN ;; We have a difference, but we don't know for sure if this ;; is really a difference, or is just because the ordering ;; of the two box lists is different. We need to sort the ;; two box lists and then compare again. (setq old-occlusion-boxes (sort old-occlusion-boxes 'box-sorter)) ;1; Sort is destructive, so put the sorted list back.* (unless (eq (window.occlusion-stack window) t) (setf (window.occlusion-stack window) old-occlusion-boxes)) (setq new-occlusion-boxes (sort new-occlusion-boxes 'box-sorter)) (unless (eq value t) (setq value new-occlusion-boxes)) (LOOP FOR OLD-BOX IN old-occlusion-boxes FOR NEW-BOX IN new-occlusion-boxes DO (WHEN (OR (NOT (= (BOX.LEFT OLD-BOX) (BOX.LEFT NEW-BOX))) (NOT (= (BOX.TOP OLD-BOX) (BOX.TOP NEW-BOX))) (NOT (= (BOX.RIGHT OLD-BOX) (BOX.RIGHT NEW-BOX))) (NOT (= (BOX.BOTTOM OLD-BOX) (BOX.BOTTOM NEW-BOX)))) (RETURN T)) FINALLY (RETURN NIL))) T)))))) (WHEN CHANGED-P (WHEN SAVE-EXPOSURES ;; Save newly exposed areas (new-occlusion-stack minus old) (SETF (WINDOW.EXPOSURES WINDOW) (SET-SUBTRACT-BOXES NEW-OCCLUSION-BOXES OLD-OCCLUSION-BOXES))) (SETF (WINDOW.OCCLUSION-STACK WINDOW) VALUE) (SEND-VISIBILITY-NOTIFY WINDOW))))) (WHEN (WINDOW.FIRST-CHILD WINDOW) ;; If this window didn't have any children than we wouldn't have anything to do. (IF (LET ((PARENT WINDOW)) (LOOP (WHEN (NULL PARENT) (RETURN NIL)) (WHEN (NOT (WINDOW.MAPPED-P PARENT)) (RETURN T)) (SETQ PARENT (WINDOW.PARENT PARENT)))) ;; Can't see this window if it or one of its parents isn't mapped. (LET ((CHILD (WINDOW.FIRST-CHILD WINDOW)) (LAST-CHILD (WINDOW.LAST-CHILD WINDOW))) (LOOP (MODIFY-OCCLUSION-STACK CHILD NIL) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD)))) ;;1ELSE* (LET* ((CHILD (WINDOW.FIRST-CHILD WINDOW)) CHILD-BOX (LAST-CHILD (WINDOW.LAST-CHILD WINDOW)) CHILD-WITHIN-PARENT (WINDOW-OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) (WINDOW-BOX-INTERIOR (MAKE-WINDOW-BOX-INTERIOR WINDOW)) ;; --> T If the window is completely visible. (WINDOW-COMPLETE-P (EQ WINDOW-OCCLUSION-STACK T)) OVERLAPING-SIBLING BOX-LIST) (LOOP (COND ((NOT (WINDOW.MAPPED-P CHILD)) ;; An unmapped window isn't visible at all. (MODIFY-OCCLUSION-STACK CHILD NIL)) ((EQL (window.class child) INPUT-ONLY) (MODIFY-OCCLUSION-STACK CHILD T)) ((SETQ OVERLAPING-SIBLING (OVERLAPS-SIBLING CHILD)) (SETQ CHILD-BOX (MAKE-WINDOW-BOX CHILD)) (WHEN (NOT (SUBBOX-P WINDOW-BOX-INTERIOR CHILD-BOX)) ;; The child extends beyond its parent. Restrict it so that it doesn't. ;; Note that this will still be a single box, just a bit smaller. (SETQ CHILD-BOX (INTERSECT-BOXES CHILD-BOX WINDOW-BOX-INTERIOR))) ;; This window overlaps with another window, and possibly others as well. ;; We will construct a box-list of which represents the occlusion stack. ;; Initially this will be the child's box minus the window that overlaps it. (SETQ BOX-LIST (IF WINDOW-COMPLETE-P ;; The parent is completely visible. This means that the ;; only thing that keeping this child from being seen is ;; one of its sibblings. (SUBTRACT-BOX CHILD-BOX (MAKE-WINDOW-BOX OVERLAPING-SIBLING)) ;;ELSE ;; The parent is occluded. This means that we may only ;; be able to see part of this child. (SUBTRACT-BOX ;; This first part is the largest part of the child ;; that we could see if the child had no siblings ;; occluding it. From the part of the child that ;; is viewable through the parent, we subtract the ;; overlaping sibling to get an initial box-list. (SET-INTERSECT-BOXES WINDOW-OCCLUSION-STACK CHILD-BOX) (MAKE-WINDOW-BOX OVERLAPING-SIBLING)))) (LOOP (SETQ OVERLAPING-SIBLING (WINDOW.NEXT-SIB OVERLAPING-SIBLING)) (WHEN (EQ OVERLAPING-SIBLING CHILD) ;; We have reached every window that could possibly overlap this child. ;; The windows beyond this are below this child. (RETURN NIL)) (WHEN (AND (WINDOW.MAPPED-P OVERLAPING-SIBLING) (NOT (EQL (window.class OVERLAPING-SIBLING) input-only)) (WINDOWS-INTERSECT-P OVERLAPING-SIBLING CHILD)) ;; This is window is mapped and it intersects. (SETQ BOX-LIST (SUBTRACT-BOX BOX-LIST (MAKE-WINDOW-BOX OVERLAPING-SIBLING))))) (MODIFY-OCCLUSION-STACK CHILD BOX-LIST)) (T ;; This window doesn't overlap any of its siblings. This means ;; that it has the same overlap as its parent, intersected with its edges. (SETQ CHILD-BOX (MAKE-WINDOW-BOX CHILD)) (SETQ CHILD-WITHIN-PARENT (SUBBOX-P WINDOW-BOX-INTERIOR CHILD-BOX)) (WHEN (NOT CHILD-WITHIN-PARENT) ;; The child extends beyond its parent. Restrict it so that it doesn't. ;; Note that this will still be a single box, just a bit smaller. (SETQ CHILD-BOX (INTERSECT-BOXES CHILD-BOX WINDOW-BOX-INTERIOR))) (MODIFY-OCCLUSION-STACK CHILD (COND (WINDOW-COMPLETE-P ;; If the child is completely inside its parent then the ;; child is completely1 *visible --> T. Otherwise we ;; can only see the part of the1 *child that is within its ;; parent. (OR CHILD-WITHIN-PARENT ;; If the child was1 *completely outside of its ;; parent then child-box will1 *be nil. (and CHILD-BOX (LIST CHILD-BOX)))) ((NULL WINDOW-OCCLUSION-STACK) NIL) (T (LET ((OS (SET-INTERSECT-BOXES WINDOW-OCCLUSION-STACK CHILD-BOX))) (IF (AND (= 1 (LENGTH OS)) (EQUALP CHILD-BOX (CAR OS))) T OS))))))) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))))) (WINDOWS-RESTRUCTURED)) (DEFUN GENERATE-ALL-INFERIORS-OCCLUSION-STACKS (WINDOW &OPTIONAL SAVE-EXPOSURES) "Create the occlusion stacks for all of the inferiors of WINDOW." (LET ((LAST-CHILD (WINDOW.LAST-CHILD WINDOW)) (CHILD (WINDOW.FIRST-CHILD WINDOW))) (GENERATE-INFERIOR-OCCLUSION-STACKS WINDOW SAVE-EXPOSURES) (WHEN CHILD (LOOP (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS CHILD SAVE-EXPOSURES) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD)))))) ;;; Debug code #| (setq window (window.last-child win) WINDOW-OCCLUSION-STACK (IF WINDOW (WINDOW.OCCLUSION-STACK WINDOW) ;;ELSE ;; The root is completely visible. T) ;; --> T If the parent is completely visible. WINDOW-COMPLETE-P (EQ WINDOW-OCCLUSION-STACK T)) |# (DEFUN DRAW-BORDERS (WINDOW) (LET* ((BORDER-PIXMAP (WINDOW-BORDER WINDOW)) (BORDER-WIDTH (WINDOW.BWIDTH WINDOW)) (TWICE-BORDER-WIDTH (* 2 (WINDOW.BWIDTH WINDOW))) (OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) (WIDTH (WINDOW.WIDTH WINDOW)) (HEIGHT (WINDOW.HEIGHT WINDOW))) ;; If we don't have anything to draw with, then we can't draw. (when (and (plusp border-width) (not (eql BORDER-PIXMAP universal-none))) (COND ((EQ OCCLUSION-STACK T) ;; Draw the top border. (X-COPY-TO-WINDOW (+ WIDTH TWICE-BORDER-WIDTH) BORDER-WIDTH BORDER-PIXMAP 0 0 WINDOW (- BORDER-WIDTH) (- BORDER-WIDTH)) ;; Draw the right border. (X-COPY-TO-WINDOW BORDER-WIDTH HEIGHT BORDER-PIXMAP 0 0 WINDOW WIDTH 0) ;; Draw the left border. (X-COPY-TO-WINDOW BORDER-WIDTH HEIGHT BORDER-PIXMAP 0 0 WINDOW (- BORDER-WIDTH) 0) ;; Draw the bottom border. (X-COPY-TO-WINDOW (+ WIDTH TWICE-BORDER-WIDTH) BORDER-WIDTH BORDER-PIXMAP 0 0 WINDOW (- BORDER-WIDTH) HEIGHT)) ((NULL OCCLUSION-STACK) ;; Can't see the window, nothing to draw. ) (T ;; Window is partially visible. We need to calculate the parts of the ;; border which are visible. (LET ((ABSOLUTE-X (WINDOW.ABSOLUTE-INSIDE-X WINDOW)) (ABSOLUTE-Y (WINDOW.ABSOLUTE-INSIDE-Y WINDOW))) ;; Go through each border and determine what part intersects with the ;; occlusion stack. Draw each intersecting part. (DOLIST (BORDER-BOX (LIST ;; Left border. (MAKE-BOX :left (- absolute-x border-width) :TOP ABSOLUTE-Y :WIDTH BORDER-WIDTH :HEIGHT HEIGHT) ;; Top border. (MAKE-BOX :LEFT (- ABSOLUTE-X BORDER-WIDTH) :top (- absolute-y border-width) :WIDTH (+ WIDTH TWICE-BORDER-WIDTH) :HEIGHT BORDER-WIDTH) ;; Right border. (MAKE-BOX :LEFT (+ ABSOLUTE-X WIDTH) :TOP ABSOLUTE-Y :WIDTH BORDER-WIDTH :HEIGHT HEIGHT) ;; Bottom border. (MAKE-BOX :LEFT (- ABSOLUTE-X BORDER-WIDTH) :TOP (+ ABSOLUTE-Y HEIGHT) :WIDTH (+ WIDTH TWICE-BORDER-WIDTH) :HEIGHT BORDER-WIDTH))) ;; For a border, intersect it with the occlusion stack and draw those ;; intersecting parts. (DOLIST (A-BOX (SET-INTERSECT-BOXES OCCLUSION-STACK BORDER-BOX)) (X-COPY-TO-WINDOW (BOX.WIDTH A-BOX) (BOX.HEIGHT A-BOX) BORDER-PIXMAP 0 0 WINDOW (- (BOX.LEFT A-BOX) ABSOLUTE-X) (- (BOX.TOP A-BOX) ABSOLUTE-Y)))))))))) #| Debug code. (setq window (window.last-child win)) (setq window (window.first-child (window.last-child win))) (setq window (window.last-child (window.last-child win))) (SETQ *resources* (SYS:SYMEVAL-IN-STACK-GROUP 'X11:*RESOURCES* (FUNCALL (LOOP FOR PROCESS IN SI:ALL-PROCESSES WHEN (STRING-EQUAL (FUNCALL PROCESS :NAME) "X Server") RETURN PROCESS) :STACK-GROUP)) OCCLUSION-STACK (IF WINDOW (WINDOW.OCCLUSION-STACK WINDOW) ;;ELSE ;; The root is completely visible. T) ;; --> T If the parent is completely visible. ABSOLUTE-X (WINDOW.ABSOLUTE-INSIDE-X WINDOW) ABSOLUTE-Y (WINDOW.ABSOLUTE-INSIDE-Y WINDOW) BORDER-PIXMAP (WINDOW-BORDER WINDOW) BORDER-WIDTH (WINDOW.BWIDTH WINDOW) TWICE-BORDER-WIDTH (* 2 (WINDOW.BWIDTH WINDOW)) width (window.width window) height (window.height window)) |# (DEFREQ MAP-SUBWINDOWS ((WINDOW WINDOW)) (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW) (MAP-SUBWINDOWS STATE WINDOW))) (DEFUN MAP-SUBWINDOWS (STATE WINDOW) (LET ((CHILD (WINDOW.FIRST-CHILD WINDOW)) (LAST-CHILD (WINDOW.LAST-CHILD WINDOW))) (WHEN CHILD (LOOP (MAP-WINDOW STATE CHILD) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD)))))) (DEFUN UNMAP-NOTIFY-EVENT (STATE WINDOW FROM-CONFIGURE) (DECLARE (IGNORE STATE) (TYPE WINDOW WINDOW) (TYPE BOOLEAN FROM-CONFIGURE)) (LET ((EVENT (MAKE-EVENT-UNMAP-NOTIFY :TYPE UNMAP-NOTIFY-EVENT :WINDOW WINDOW :FROM-CONFIGURE FROM-CONFIGURE))) (DELIVER-EVENTS WINDOW EVENT 1 NIL))) (DEFREQ UNMAP-WINDOW ((WINDOW WINDOW)) (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW) (WITH-TREE-LOCKED ((window.parent window)) (UNMAP-WINDOW STATE WINDOW)))) (DEFUN EXPOSE-WINDOW-PORTION (WINDOW STATE BOXES &OPTIONAL (OCCLUSION-STACKS-UPDATED T)) "Try to expose the portion of WINDOW indicated by BOXES." ;; We will either draw the portion of the WINDOW from the backing store, or tell ;; the application that part of WINDOW needs to be updated. ;; We are guaranteed that WINDOW is mapped. Note that it could be that WINDOW ;; has children which need to be exposed. We will look at the children to see ;; if any of them overlap BOXES and call ourselves recursively. (SERVER-TRACE "~%EXPOSE-WINDOW-PORTION; window=~S boxes=~S" WINDOW BOXES) (WHEN (AND BOXES (WINDOW.MAPPED-P WINDOW) (NOT (EQL (WINDOW.CLASS WINDOW) INPUT-ONLY))) (VALIDATE-BACKING-STORE WINDOW) (LET* ((INTERIOR-BOX (MAKE-WINDOW-BOX-INTERIOR WINDOW)) (BACKING-STORE (AND (WINDOW.BACKING-STORE-VALID WINDOW) (WINDOW.BACKING-STORE WINDOW))) (ABSOLUTE-X (WINDOW.ABSOLUTE-INSIDE-X WINDOW)) (ABSOLUTE-Y (WINDOW.ABSOLUTE-INSIDE-Y WINDOW)) (FRAME-BUFFER (DEVICE-PRIVATE-WINDOW-ARRAY WINDOW)) (BOXES-TO-DRAW (SET-INTERSECT-BOXES BOXES INTERIOR-BOX)) (OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) INTERSECT-BOXES) ;; Output the borders before we do anything else. ;; If we don't have anything to draw with, then we can't draw. ;; We need to obtain boxes for the interior part of the window. (IF OCCLUSION-STACKS-UPDATED ;; O.S. are up to date - only expose parts of window that ;; are visible *now* and intersect boxes-to-draw (SETQ INTERSECT-BOXES (SET-INTERSECT-BOX-SETS BOXES-TO-DRAW (OCCLUSION-STACK-TO-LIST WINDOW OCCLUSION-STACK))) ;; O.S. are old - just expose anything that intersects with window interior (SETQ INTERSECT-BOXES BOXES-TO-DRAW)) ;; The following would report only exposed areas that are not obscured by children #+COMMENT (LOOP WHILE INTERSECT-BOXES FOR CHILD BEING THE XWINDOW-CHILDREN OF WINDOW WHEN (AND (WINDOW.MAPPED-P CHILD) (WINDOW.REALIZED-P CHILD) (NOT (EQL (WINDOW.CLASS CHILD) INPUT-ONLY))) DO (SETQ INTERSECT-BOXES (SUBTRACT-BOX INTERSECT-BOXES (MAKE-WINDOW-BOX CHILD)))) (WHEN INTERSECT-BOXES (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW) (DRAW-BORDERS WINDOW) (LOOP FOR BOX IN INTERSECT-BOXES ;; Count is the number of boxes remaining after this one. FOR COUNT DOWNFROM (1- (LENGTH INTERSECT-BOXES)) FOR BOX-LEFT = (BOX.LEFT BOX) FOR BOX-TOP = (BOX.TOP BOX) FOR BOX-WIDTH = (BOX.WIDTH BOX) FOR BOX-HEIGHT = (BOX.HEIGHT BOX) DO (IF BACKING-STORE ;; We have enough data to generate the parts of the window which ;; are now visible. (X-BITBLT GX-COPY BOX-WIDTH BOX-HEIGHT (PIXMAP.ARRAY BACKING-STORE) (- BOX-LEFT ABSOLUTE-X) (- BOX-TOP ABSOLUTE-Y) FRAME-BUFFER BOX-LEFT BOX-TOP) ;;ELSE ;; We didn't have anything on the window, so it is up to the ;; application to update itself. (EXPOSE-EVENT STATE WINDOW BOX-LEFT BOX-TOP BOX-WIDTH BOX-HEIGHT COUNT T) )))) (WHEN BOXES-TO-DRAW (LOOP FOR CHILD BEING THE XWINDOW-CHILDREN OF WINDOW DO (WHEN (AND (WINDOW.MAPPED-P CHILD) (NOT (EQL (WINDOW.CLASS CHILD) INPUT-ONLY))) (EXPOSE-WINDOW-PORTION CHILD STATE BOXES OCCLUSION-STACKS-UPDATED)))) ))) (DEFUN REMOVE-WINDOW (WINDOW STATE VULTURE-RECTANGLE &OPTIONAL (STILL-MAPPED T)) "Visually remove WINDOW from its position in the hierarchy. STILL-MAPPED is non-NIL if WINDOW remains mapped, NIL if it becomes unmapped." ;; This function is used for the unmap-window request and the `bury' case ;; of the configure-window request. We don't affect data structures to really ;; remove this window from the window hierarchy. ;; The idea of this is to place WINDOW at the bottom of the hierarchy if ;; STILL-MAPPED is non-NIL or to remove WINDOW completely if STILL-MAPPED is ;; NIL. We start with a rectangle representing WINDOW and check for ;; intersecting windows below WINDOW in the occlusion stack. When we get to ;; the last window in the occlusion stack, we will either give the rest to ;; the parent of WINDOW (if STILL-MAPPED is NIL) or to WINDOW (if ;; STILL-MAPPED is non-NIL). (The term vulture-rectangle is used to signify ;; that other windows are picking away at WINDOW, only leaving what they ;; don't need. (UNLESS (EQL (window.class window) input-only) (LET* ((SIBLING (WINDOW.NEXT-SIB WINDOW)) SIBLING-BOX (PARENT (WINDOW.PARENT WINDOW)) (LAST-SIBLING (WINDOW.LAST-CHILD PARENT))) (SAVE-AREAS WINDOW) (WHEN (AND (NOT (EQ LAST-SIBLING WINDOW)) VULTURE-RECTANGLE) ;; WINDOW is not at the bottom of the occlusion stack. (LOOP (WHEN (AND (WINDOW.MAPPED-P SIBLING) (NOT (EQL (window.class sibling) input-only)) (WINDOWS-INTERSECT-P WINDOW SIBLING)) (SETQ SIBLING-BOX (MAKE-WINDOW-BOX SIBLING)) (EXPOSE-WINDOW-PORTION SIBLING STATE VULTURE-RECTANGLE T) (SETQ VULTURE-RECTANGLE (SUBTRACT-BOX VULTURE-RECTANGLE SIBLING-BOX))) (WHEN (EQ SIBLING LAST-SIBLING) (RETURN NIL)) (SETQ SIBLING (WINDOW.NEXT-SIB SIBLING)))) ;; If STILL-MAPPED is T then we are all done with the drawing part ;; since the only part of WINDOW which remains is that part which its ;; lower level siblings left alone. (WHEN (NULL STILL-MAPPED) (EXPOSE-WINDOW-PORTION PARENT STATE VULTURE-RECTANGLE T))))) (DEFUN UNMAP-WINDOW (STATE WINDOW) ;; If the window is already unmapped then we are done. (WHEN (WINDOW.MAPPED-P WINDOW) (LET* ((PARENT (WINDOW.PARENT WINDOW)) (ANCESTERS-MAPPED T) (ANCESTER PARENT)) (LOOP (WHEN (NOT (WINDOW.MAPPED-P ANCESTER)) (SETQ ANCESTERS-MAPPED NIL) (RETURN NIL)) (SETQ ANCESTER (WINDOW.PARENT ANCESTER)) (WHEN (NULL ANCESTER) (RETURN NIL))) (progn ;1; *WITH-TREE-LOCKED (PARENT)1 ;; lock moved to unmap-window-request - LGO* (SETF (WINDOW.MAPPED-P WINDOW) NIL) (WHEN ANCESTERS-MAPPED (LET ((OLD-OCCLUSION-STACK (OCCLUSION-STACK-TO-LIST WINDOW (WINDOW.OCCLUSION-STACK WINDOW)))) (GENERATE-ALL-INFERIORS-OCCLUSION-STACKS PARENT) ;; Visually remove the window. (REMOVE-WINDOW WINDOW STATE OLD-OCCLUSION-STACK NIL))) (UNMAP-NOTIFY-EVENT STATE WINDOW NIL))) ;1;Make sure any grabs and events associated with this window are removed.* (WHEN (window.realized-p window) (delete-window-from-any-events window nil)) ;; A window is realized if it and its ancestors are mapped. (SETF (WINDOW.REALIZED-P WINDOW) NIL) ;; Need to do the same for children. (LABELS ((CHECK-INFERIORS (WINDOW) "Check inferiors of WINDOW to make then unrealized." (LET ((CHILD (WINDOW.FIRST-CHILD WINDOW)) (LAST-CHILD (WINDOW.LAST-CHILD WINDOW))) (WHEN CHILD (LOOP (SETF (WINDOW.REALIZED-P CHILD) NIL) (CHECK-INFERIORS CHILD) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))))) (CHECK-INFERIORS WINDOW)))) (defun unlink-window (window) "Unlink WINDOW from the hierarchy." (let ((parent (window.parent window)) (next-sib (window.next-sib window)) (prev-sib (window.prev-sib window))) (when (and next-sib prev-sib) ;protect from already unlinked windows. (if (eq next-sib window) ;1; only one window* (setf (window.first-child parent) nil (window.last-child parent) nil) ;; Set the previous window's `next' pointer to my `next' pointer. (setf (window.next-sib prev-sib) next-sib) ;; Set the previous window's `prev' pointer to my `prev' pointer. (setf (window.prev-sib next-sib) prev-sib) (when (eq (window.first-child parent) window) ;; We are at the head of the occlusion stack. Set up a new head. (setf (window.first-child parent) next-sib)) (when (eq (window.last-child parent) window) ;; We are at the tail of the occlusion stack. Set up a new tail. (setf (window.last-child parent) prev-sib))) ;; Empty out my prev/next components since they are meaningless now. (setf (window.prev-sib window) nil) (setf (window.next-sib window) nil)))) (DEFREQ UNMAP-SUBWINDOWS ((WINDOW WINDOW)) (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW) (UNMAP-SUBWINDOWS STATE WINDOW))) (compiler:make-obsolete MAKE-CHILD-LIST (loop (over) the xwindow-children)) (DEFUN MAKE-CHILD-LIST (WINDOW) (loop for child being the xwindow-children-reverse of window collect child)) (compiler:make-obsolete MAKE-CHILD-LIST-REVERSE (loop (over) the xwindow-children-reverse)) (DEFUN MAKE-CHILD-LIST-REVERSE (WINDOW) (loop for child being the xwindow-children of window collect child)) (DEFUN UNMAP-SUBWINDOWS (STATE WINDOW) "Performs an UnmapWindow request on all mapped children of the window, in bottom to top stacking order." ;; We need to create the list first because we clean out the prev/next-sib slots ;; in the window object when we unmap it. This looks a lot simpler anyway. (loop for child being the xwindow-children-reverse of window doing (UNMAP-WINDOW STATE CHILD))) (DEFREQ DESTROY-WINDOW ((:SOLO) (WINDOW WINDOW)) (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW) (DESTROY-WINDOW STATE WINDOW))) (DEFUN DESTROY-NOTIFY-EVENT (STATE WINDOW) (DECLARE (IGNORE STATE) (TYPE WINDOW WINDOW)) (LET ((EVENT (MAKE-EVENT-DESTROY-NOTIFY :TYPE DESTROY-NOTIFY-EVENT :WINDOW WINDOW))) (DELIVER-EVENTS WINDOW EVENT 1 NIL))) (DEFUN DESTROY-WINDOW (STATE WINDOW) "If the argument window is mapped, an UnmapWindow request is performed automatically. The window and all inferiors are then destroyed, and a DestroyNotify event is generated for each window. The ordering of the DestroyNotify events is such that for any given window, DestroyNotify is generated on all inferiors of the window before being generated on the window itself. The ordering among siblings and across subhierarchies is not otherwise constrained. Normal exposure processing on formerly obscured windows is performed. If the window is a root window, this request has no effect." (WHEN (WINDOW.PARENT WINDOW) ;; This is not the root window. (UNMAP-WINDOW STATE WINDOW) ;; Go through all of WINDOW's inferiors, causing massive destruction. (loop for child = (window.first-child window) while child do (DESTROY-WINDOW STATE CHILD)) (UNLINK-WINDOW WINDOW) (remove-resource (window.id window) :drawable) ;; Remove window from all save-sets (dolist (a-state (global-state.states *globals*)) (setf (state.save-set a-state) (delete window (state.save-set a-state)))) (DESTROY-NOTIFY-EVENT STATE WINDOW))) (DEFREQ DESTROY-SUBWINDOWS ((:SOLO) (WINDOW WINDOW)) (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW) (DESTROY-SUBWINDOWS STATE WINDOW))) (DEFUN DESTROY-SUBWINDOWS (STATE WINDOW) "Performs a DestroyWindow on all children of the window, in bottom to top stacking order." ;; Go through all of WINDOW's inferiors, causing massive destruction. (loop for child = (window.first-child window) while child do (DESTROY-WINDOW STATE CHILD))) (DEFREQ REPARENT-WINDOW ((:SOLO) (WINDOW WINDOW) (PARENT WINDOW) (X INT16) (Y INT16)) (WITH-CURSOR-LOCKED (:SERVER) (MAYBE-REMOVE-CURSOR WINDOW T) (REPARENT-WINDOW STATE WINDOW PARENT X Y))) (ZWEI:DEFINE-INDENTATION MOVE-ALL-INFERIORS (1 1)) (DEFUN REPARENT-WINDOW (STATE WINDOW PARENT X Y) (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW PARENT) (TYPE INTEGER X Y)) ;; Do the extra error checking before we start anything. ;; A match error is generated if the ;; new parent is not on the same screen as the old parent ;; new parent is WINDOW or an inferior of WINDOW ;; WINDOW has a parent-relative background and the new parent is not the same ;; depth as the window (SERVER-TRACE "~%ENTERING REPARENT-WINDOW, WINDOW=~A, PARENT=~A, (~D,~D)" WINDOW PARENT X Y) (COND ((OR (NOT (EQ (SCREEN-FOR-WINDOW WINDOW) (SCREEN-FOR-WINDOW PARENT))) (EQ WINDOW PARENT) (IS-PARENT WINDOW PARENT)) (BAD-MATCH)) (T (LET ((WINDOW-WAS-MAPPED (WINDOW.MAPPED-P WINDOW)) (OLD-PARENT (WINDOW.PARENT WINDOW)) (NEW-ABS-X (+ (WINDOW.ABSOLUTE-INSIDE-X PARENT) X)) (NEW-ABS-Y (+ (WINDOW.ABSOLUTE-INSIDE-Y PARENT) Y))) (SERVER-TRACE "~%IN REPARENT-WINDOW, window-was-mapped=~A, moving to (~D,~D)" WINDOW-WAS-MAPPED NEW-ABS-X NEW-ABS-Y) (WHEN WINDOW-WAS-MAPPED (UNMAP-WINDOW STATE WINDOW)) (LET ((EVENT (MAKE-EVENT-REPARENT :TYPE REPARENT-NOTIFY-EVENT :WINDOW WINDOW :PARENT PARENT :X X :Y Y :OVERRIDE (WINDOW.OVERRIDE-REDIRECT WINDOW)))) (DELIVER-EVENTS WINDOW EVENT 1 PARENT)) (UNLINK-WINDOW WINDOW) ;; Insert WINDOW as a child of PARENT at the top of the stack with respect ;; to its siblings. The following code came from the create-window ;; request. See the comment there to see what is going on here. (WITH-TREE-LOCKED (PARENT) (SETF (WINDOW.NEXT-SIB WINDOW) (WINDOW.FIRST-CHILD PARENT)) (SETF (WINDOW.PREV-SIB WINDOW) (WINDOW.LAST-CHILD PARENT)) (WHEN (WINDOW.FIRST-CHILD PARENT) (SETF (WINDOW.PREV-SIB (WINDOW.FIRST-CHILD PARENT)) WINDOW)) (WHEN (WINDOW.LAST-CHILD PARENT) (SETF (WINDOW.NEXT-SIB (WINDOW.LAST-CHILD PARENT)) WINDOW)) (WHEN (NULL (WINDOW.FIRST-CHILD PARENT)) ;; The parent previously had no children. This window becomes both ;; the first and last child. (SETF (WINDOW.LAST-CHILD PARENT) WINDOW) ;1; the window is its own next and previous sibling* (setf (window.prev-sib window) window) (setf (window.next-sib window) window)) (SETF (WINDOW.FIRST-CHILD PARENT) WINDOW)) ;; Change the window's position (SERVER-TRACE "~%IN REPARENT-WINDOW (1), window=~A" WINDOW) ;; ;; Old parent ;; .-----------------------------. ;; |\ | ;; | \ | ;; | \ | ;; | \ | ;; | \New Parent | ;; | .-------------. | ;; | | | | ;; | | | | ;; | | | | ;; | | | | ;; | `-------------' | ;; `-----------------------------' ;; ;; Part of the idea here is that we are moving WINDOW from its old ;; absolute origin within its old parent to its new absolute ;; origin within its new parent. To show this change, we subtract ;; the old parent's absolute origin from the new parent's absolute ;; origin (i.e. new-old). The other part is that we are ;; adjusting the location of WINDOW with respect to its parent. ;; To show this part of the change, we subtract the window's old ;; location from its new location (i.e. new-old). These changes ;; get reflected together by summing them. (LET ((DELTA-X (+ (- (WINDOW.ABSOLUTE-INSIDE-X PARENT) (WINDOW.ABSOLUTE-INSIDE-X OLD-PARENT)) (- X (WINDOW.X WINDOW)))) (DELTA-Y (+ (- (WINDOW.ABSOLUTE-INSIDE-Y PARENT) (WINDOW.ABSOLUTE-INSIDE-Y OLD-PARENT)) (- Y (WINDOW.Y WINDOW))))) (SERVER-TRACE "~%IN REPARENT-WINDOW (2), DELTAS=(~D,~D)" DELTA-X DELTA-Y) (SETF (WINDOW.X WINDOW) X) (SETF (WINDOW.Y WINDOW) Y) (LABELS ((MOVE-ALL-INFERIORS (WINDOW) "Move WINDOW and all of the inferiors of WINDOW." (LET ((LAST-CHILD (WINDOW.LAST-CHILD WINDOW)) (CHILD (WINDOW.FIRST-CHILD WINDOW)) (occlusions (window.occlusion-stack window))) (SERVER-TRACE "~%IN REPARENT-WINDOW (MOVE-ALL-INFERIORS), window=~A, ~ OLD-ABS=(~D,~D)" WINDOW (WINDOW.ABSOLUTE-X-CORNER WINDOW) (WINDOW.ABSOLUTE-Y-CORNER WINDOW)) (INCF (WINDOW.ABSOLUTE-X-CORNER WINDOW) DELTA-X) (INCF (WINDOW.ABSOLUTE-Y-CORNER WINDOW) DELTA-Y) ;1; Move the occlusion-stack too* (when (consp occlusions) (dolist (box occlusions) (decf (box.left box) delta-x) (decf (box.top box) delta-y) (decf (box.right box) delta-x) (decf (box.bottom box) delta-y))) (SERVER-TRACE ", NEW-ABS=(~D,~D)" (WINDOW.ABSOLUTE-X-CORNER WINDOW) (WINDOW.ABSOLUTE-Y-CORNER WINDOW)) ;1; Adjust the children of window too.* (WHEN CHILD (LOOP (MOVE-ALL-INFERIORS CHILD) (WHEN (EQ CHILD LAST-CHILD) (RETURN NIL)) (SETQ CHILD (WINDOW.NEXT-SIB CHILD))))))) (MOVE-ALL-INFERIORS WINDOW))) (SETF (WINDOW.PARENT WINDOW) PARENT) (SERVER-TRACE "~%IN REPARENT-WINDOW (3), window=~A" WINDOW) (WHEN WINDOW-WAS-MAPPED (MAP-WINDOW STATE WINDOW)) (SERVER-TRACE "~%IN REPARENT-WINDOW (4), window=~A" WINDOW) (RECALCULATE-DELIVERABLE-EVENTS PARENT)))) (WHEN (AND (WINDOW.FIRST-CHILD WINDOW) (EQ (WINDOW.FIRST-CHILD WINDOW) (WINDOW.LAST-CHILD WINDOW))) ;1; Have window (i.e. 40008) has one child (i.e. 40009)* (SERVER-TRACE "~%IN REPARENT-WINDOW, child is ~A" (WINDOW.FIRST-CHILD WINDOW))) (SERVER-TRACE "~%EXITING REPARENT-WINDOW")) (DEFREQ CIRCULATE-WINDOW ((DIRECTION (CARD8 CIRC-RAISE-LOWEST CIRC-LOWER-HIGHEST)) (WINDOW WINDOW)) (CIRCULATE-WINDOW STATE WINDOW DIRECTION)) (DEFUN CIRCULATE-WINDOW (STATE PARENT DIRECTION) (DECLARE (TYPE STATE STATE) (TYPE WINDOW PARENT) (TYPE CIRCULATE-TYPE DIRECTION)) ;; For raise-lowest, raises the lowest mapped child (if any) that is ;; obscured by another child to the top of the stack. For lower-highest, ;; lowers the highest mapped child (if any) that is obscuring another ;; child to the bottom of the stack. (block ALL-DONE (LET* ((CHILD (IF (= DIRECTION CIRC-RAISE-LOWEST) (LOOP WITH FIRST-CHILD = (WINDOW.FIRST-CHILD PARENT) FOR WINDOW FIRST (WINDOW.LAST-CHILD PARENT) THEN (WINDOW.PREV-SIB WINDOW) DO (PROGN (WHEN (or (null window) 1; no children* (EQ WINDOW FIRST-CHILD)) ;1 done all children* ;; All done. There weren't any overlaps. (return-from ALL-DONE NIL)) (WHEN (AND (WINDOW.MAPPED-P WINDOW) (NOT (EQL (window.class window) input-only)) (ANY-WINDOW-OVERLAPS-ME WINDOW (MAKE-WINDOW-BOX WINDOW))) (RETURN WINDOW)))) ;;ELSE - lower-highest (LOOP WITH LAST-CHILD = (WINDOW.LAST-CHILD PARENT) FOR WINDOW FIRST (WINDOW.FIRST-CHILD PARENT) THEN (WINDOW.NEXT-SIB WINDOW) DO (PROGN (WHEN (or (null window) ;1 no children* (EQ WINDOW LAST-CHILD)) ;1 done all children* ;; All done. There weren't any overlaps. (return-from ALL-DONE NIL)) (WHEN (AND (WINDOW.MAPPED-P WINDOW) (NOT (EQL (window.class window) input-only)) (I-OVERLAP-ANY-WINDOW WINDOW (MAKE-WINDOW-BOX WINDOW))) (RETURN WINDOW)))))) (EVENT (MAKE-EVENT-CIRCULATE :TYPE CIRCULATE-REQUEST-EVENT :WINDOW CHILD :PARENT PARENT :EVENT PARENT :PLACE (IF (= DIRECTION CIRC-RAISE-LOWEST) PLACE-ON-TOP ;;ELSE PLACE-ON-BOTTOM)))) (IF (NOT (ZEROP (LOGAND (WINDOW.ALL-EVENT-MASKS PARENT) SUBSTRUCTURE-REDIRECT-MASK))) (IF (= 1 (MAYBE-DELIVER-EVENTS-TO-CLIENT PARENT EVENT 1 SUBSTRUCTURE-REDIRECT-MASK STATE)) (return-from ALL-DONE NIL))) (REFLECT-STACK-CHANGE STATE CHILD (IF (= DIRECTION CIRC-RAISE-LOWEST) (WINDOW.FIRST-CHILD PARENT) ;;ELSE NIL)) (SETF (X-EVENT-CIRCULATE.TYPE EVENT) CIRCULATE-NOTIFY-EVENT) (DELIVER-EVENTS PARENT EVENT 1 NIL)))) (DEFREQ QUERY-TREE ((WINDOW WINDOW)) (QUERY-TREE STATE WINDOW)) (DEFUN QUERY-TREE (STATE WINDOW) (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW)) (LET ((PARENT (WINDOW.PARENT WINDOW)) (nchildren (loop for child being the xwindow-children of window count t))) (FORMAT-REPLY (STATE nchildren) :LONG (WINDOW.ID (ROOT-FOR-WINDOW WINDOW)) :LONG (IF PARENT (WINDOW.ID PARENT) UNIVERSAL-NONE) :WORD nchildren)) (loop for child being the xwindow-children of window WITH INDEX = 0 DO (SETQ INDEX (SIMPLE-REPLY (STATE INDEX) :LONG (WINDOW.ID CHILD))) FINALLY (PROGN (SERVER-STRING-OUT STATE (RESPONSE.BYTES (STATE.RESPONSE STATE)) INDEX) (SERVER-PUSH STATE))))