;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Reason: If the last sibling received a Configure-Window request, it was always ;;; moved to the top of the sibling list. ;;; RESTRICTED RIGHTS LEGEND ;;; ;;; Use, duplication, or disclosure by the Government is subject to ;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;; Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Patch file for X11M version 6.6 ;;; Written 06/23/89 11:00:42 by buehring, ;;; while running on Spud from band LOD9 ;;; With SYSTEM 6.9, VIRTUAL-MEMORY 6.1, EH 6.3, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0, ;;; BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.1, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.4, TV 6.11, DATALINK 6.0, CHAOSNET 6.0, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.0, ;;; SYSLOG 6.1, STREAMER-TAPE 6.3, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.3, ;;; Experimental DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0, ;;; IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0, ;;; NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, TI-CLOS 6.8, CLEH 6.4, IP 3.46, ;;; Experimental BUG 11.10, CLX 6.0, CLUE 6.0, X11M 6.5, microcode 429, Band Name: Rel6 5/22+SLE+hacks #!C ; From file CONFIGURE-WINDOW.LISP#> X11M.SERVER; MR-X: #10R X11#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "X11M: SERVER; CONFIGURE-WINDOW.#" (DEFUN CONFIGURE-WINDOW (WINDOW VALUE-MASK LONGS LONG-OFFSET WORDS WORD-OFFSET STATE) (DECLARE (TYPE WINDOW WINDOW) (TYPE INTEGER VALUE-MASK LONG-OFFSET WORD-OFFSET) (TYPE ARRAY LONGS WORDS) (TYPE STATE STATE)) ;; Move the word offset to the start of the values. The long-offset has already been ;; adjusted so we don't need to bother with that. (INCF WORD-OFFSET 6) (server-trace-value-mask value-mask longs long-offset '#(X Y Width Height Border-Width Sibling Stack-Mode)) (block RETURN-VALUE (LET ((SIBLING NIL) (WIDTH (WINDOW.WIDTH WINDOW)) (HEIGHT (WINDOW.HEIGHT WINDOW)) (BORDER-WIDTH (WINDOW.BWIDTH WINDOW)) (STACK-MODE STACK-ABOVE) ;; The following are constants. The compiler should do constant-folding so that ;; they will really be their values. (RESTACK-WIN 0) (MOVE-WIN 1) (RESIZE-WIN 2) (CHANGE-MASK (LOGIOR CW-X CW-Y CW-WIDTH CW-HEIGHT)) X Y BEFORE-X BEFORE-Y ACTION T-MASK INDEX) (DECLARE (TYPE INTEGER WIDTH HEIGHT BORDER-WIDTH RESTACK-WIN MOVE-WIN RESIZE-WIN CHANGE-MASK)) (macrolet ((GET-CARD16 () '(PROG1 (AREF WORDS WORD-OFFSET) (INCF WORD-OFFSET 2) (INCF LONG-OFFSET)))) (COND ((zerop value-mask) (return-from return-value nil)) #+comment ;; configure window works for input-only windows too - LGO ((and (eql (window.class window) Input-Only) (logtest value-mask (lognot (logior CW-X CW-Y CW-WIDTH CW-HEIGHT CW-BORDER-WIDTH)))) (BAD-MATCH)) ((AND (LOGTEST CW-SIBLING VALUE-MASK) (NOT (LOGTEST CW-STACK-MODE VALUE-MASK))) ;; User specified a sibling but didn't specify stack-mode. (BAD-MATCH)) (T ;; I'm not sure about these calculations since the C server has a different ;; meaning for the absolute X/Y corner. (SETQ X (WINDOW.X WINDOW) Y (WINDOW.Y WINDOW)) (server-trace "~%In change-w-a: x= ~d y= ~d" x y) (SETQ BEFORE-X X BEFORE-Y Y ACTION RESTACK-WIN) ;; Now we decide what kind of action we will perform. (COND ((AND (OR (LOGTEST CW-X VALUE-MASK) (LOGTEST CW-Y VALUE-MASK)) (NOT (LOGTEST CW-WIDTH VALUE-MASK)) (NOT (LOGTEST CW-HEIGHT VALUE-MASK))) (WHEN (LOGTEST CW-X VALUE-MASK) (SETQ X (card16->int16 (GET-CARD16)))) (WHEN (LOGTEST CW-Y VALUE-MASK) (SETQ Y (card16->int16 (GET-CARD16)))) (SETQ ACTION MOVE-WIN)) ((OR (LOGTEST CW-X VALUE-MASK) (LOGTEST CW-Y VALUE-MASK) (LOGTEST CW-WIDTH VALUE-MASK) (LOGTEST CW-HEIGHT VALUE-MASK)) (WHEN (LOGTEST CW-X VALUE-MASK) (SETQ X (card16->int16 (GET-CARD16)))) (WHEN (LOGTEST CW-Y VALUE-MASK) (SETQ Y (card16->int16 (GET-CARD16)))) (WHEN (LOGTEST CW-WIDTH VALUE-MASK) (SETQ WIDTH (GET-CARD16))) (WHEN (LOGTEST CW-HEIGHT VALUE-MASK) (SETQ HEIGHT (GET-CARD16))) (SETQ ACTION RESIZE-WIN))) (server-trace "~%In change-w-a after checking action: x= ~d y= ~d" x y) ;; Turn off the X/Y/WIDTH/HEIGHT bits in and put into T-MASK. (SETQ T-MASK (LOGAND VALUE-MASK (LOGNOT CHANGE-MASK))) (LOOP (WHEN (ZEROP T-MASK) (RETURN NIL)) (SETQ INDEX (ASH 1 (1- (FFS T-MASK))) T-MASK (LOGXOR INDEX T-MASK)) (COND ((= INDEX CW-BORDER-WIDTH) (SETQ BORDER-WIDTH (GET-CARD16))) ((= INDEX CW-SIBLING) (PROCESS-VALUES (VALUE-MASK LONGS LONG-OFFSET) () (((CW-SIBLING WINDOW SIBLING)))) (WHEN (OR (NOT (EQ (WINDOW.PARENT SIBLING) (WINDOW.PARENT WINDOW))) (EQ SIBLING WINDOW)) (BAD-MATCH) (RETURN-FROM RETURN-VALUE 0))) ((= INDEX CW-STACK-MODE) (PROCESS-VALUES (VALUE-MASK LONGS LONG-OFFSET) () (((CW-STACK-MODE (CARD8 STACK-ABOVE STACK-BELOW STACK-TOP-IF STACK-BOTTOM-IF STACK-OPPOSITE) STACK-MODE)))) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, STACK-MODE=~D" STACK-MODE)) (T (BAD-MATCH) (RETURN-FROM RETURN-VALUE 0)))) ;; Root can't be reconfigured, so just return. (WHEN (NULL (WINDOW.PARENT WINDOW)) (RETURN-FROM RETURN-VALUE 1)) ;; Figure out if the window should be moved. Doesn't make ;; the changed to the window if event sent. (SETQ SIBLING (IF (LOGTEST CW-STACK-MODE VALUE-MASK) (WHERE-DO-I-GO-IN-THE-STACK WINDOW SIBLING X Y (WINDOW.OUTSIDE-WIDTH WINDOW) (WINDOW.OUTSIDE-HEIGHT WINDOW) STACK-MODE) ;;ELSE (IF (EQ (WINDOW.NEXT-SIB WINDOW) (WINDOW.FIRST-CHILD (WINDOW.PARENT WINDOW))) ;; Window is last (because Next points back to First) - don't let it change. NIL (WINDOW.NEXT-SIB WINDOW)))) (WHEN (AND (NOT (WINDOW.OVERRIDE-REDIRECT WINDOW)) (LOGTEST SUBSTRUCTURE-REDIRECT-MASK (WINDOW.ALL-EVENT-MASKS (WINDOW.PARENT WINDOW)))) (LET ((EVENT (MAKE-EVENT-CONFIGURE-REQUEST :TYPE CONFIGURE-REQUEST-EVENT :WINDOW WINDOW :PARENT (WINDOW.PARENT WINDOW) :SIBLING (IF (LOGTEST CW-SIBLING VALUE-MASK) SIBLING NIL) :X X :Y Y :WIDTH WIDTH :HEIGHT HEIGHT :BORDER-WIDTH BORDER-WIDTH :VALUE-MASK VALUE-MASK))) (WHEN (= (MAYBE-DELIVER-EVENTS-TO-CLIENT (WINDOW.PARENT WINDOW) EVENT 1 SUBSTRUCTURE-REDIRECT-MASK STATE) 1) (RETURN-FROM RETURN-VALUE 1)))) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, ACTION=~A" (COND ((= ACTION RESIZE-WIN) :RESIZE-WIN) ((= ACTION RESTACK-WIN) :RESTACK-WIN) ((= ACTION MOVE-WIN) :MOVE-WIN))) (WHEN (= ACTION RESIZE-WIN) (LET ((SIZE-CHANGE (OR (NOT (= (WINDOW.WIDTH WINDOW) WIDTH)) (NOT (= (WINDOW.HEIGHT WINDOW) HEIGHT))))) (DECLARE (TYPE BOOLEAN SIZE-CHANGE)) (WHEN (AND SIZE-CHANGE (LOGTEST RESIZE-REDIRECT-MASK (WINDOW.ALL-EVENT-MASKS WINDOW))) (LET ((EVENT (MAKE-EVENT-RESIZE-REQUEST :TYPE RESIZE-REQUEST-EVENT :WINDOW WINDOW :WIDTH WIDTH :HEIGHT HEIGHT))) (WHEN (= (MAYBE-DELIVER-EVENTS-TO-CLIENT WINDOW EVENT 1 RESIZE-REDIRECT-MASK STATE) 1) (SETQ WIDTH (WINDOW.WIDTH WINDOW) HEIGHT (WINDOW.HEIGHT WINDOW) SIZE-CHANGE NIL)))) (WHEN (NOT SIZE-CHANGE) (COND ((LOGTEST (LOGIOR CW-X CW-Y) VALUE-MASK) (SETQ ACTION MOVE-WIN)) ((LOGTEST (LOGIOR CW-STACK-MODE CW-BORDER-WIDTH) VALUE-MASK) (SETQ ACTION RESTACK-WIN)) (T ;; Really nothing to do. (RETURN-FROM RETURN-VALUE 1)))))) (when (or (= ACTION RESIZE-WIN) ;; We've already checked whether ther's really a size change. (AND (LOGTEST CW-X VALUE-MASK) (NOT (= X BEFORE-X))) (AND (LOGTEST CW-Y VALUE-MASK) (NOT (= Y BEFORE-Y))) (AND (LOGTEST CW-BORDER-WIDTH VALUE-MASK) (NOT (= BORDER-WIDTH (WINDOW.BWIDTH WINDOW)))) (AND (LOGTEST CW-STACK-MODE VALUE-MASK) (NOT (EQ SIBLING ;; In the C code, the next sibling for the last child is NIL. ;; In the Lisp code, the next sibling for the last child ;; is the first child. (IF (EQ (WINDOW.LAST-CHILD (WINDOW.PARENT WINDOW)) WINDOW) NIL ;;ELSE (WINDOW.NEXT-SIB WINDOW)))))) (LET ((EVENT (MAKE-EVENT-CONFIGURE-NOTIFY :TYPE CONFIGURE-NOTIFY-EVENT :WINDOW WINDOW :ABOVE-SIBLING (OR SIBLING NIL) :X X :Y Y :WIDTH WIDTH :HEIGHT HEIGHT :BORDER-WIDTH BORDER-WIDTH :OVERRIDE (WINDOW.OVERRIDE-REDIRECT WINDOW)))) (DELIVER-EVENTS WINDOW EVENT 1 NIL) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, AFTER DELIVER-EVENTS") (WHEN (LOGTEST CW-BORDER-WIDTH VALUE-MASK) (IF (= ACTION RESTACK-WIN) (CHANGE-BORDER-WIDTH STATE WINDOW BORDER-WIDTH) ;;ELSE (SETF (WINDOW.BWIDTH WINDOW) BORDER-WIDTH))) (COND ((= ACTION MOVE-WIN) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, moving window") (MOVE-WINDOW STATE WINDOW X Y SIBLING)) ((= ACTION RESIZE-WIN) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, sliding and sizing window") (SLIDE-AND-SIZE-WINDOW STATE WINDOW X Y WIDTH HEIGHT SIBLING)) ((LOGTEST CW-STACK-MODE VALUE-MASK) (SERVER-TRACE "~%IN CONFIGURE-WINDOW, restacking window") (REFLECT-STACK-CHANGE STATE WINDOW SIBLING)))))))))) (SERVER-TRACE "~%LEAVING CONFIGURE-WINDOW")) ))