(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "ROOMS") (IL:FILECREATED " 5-Dec-2020 16:26:33"  IL:|{DSK}arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>ROOMS-WINDOW-HIDER.;2| 30816 IL:|previous| IL:|date:| "17-Aug-90 13:34:55" IL:|{DSK}arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>ROOMS-WINDOW-HIDER.;1|) ; Copyright (c) 1987, 1988, 1990, 2020 by Venue & Xerox Corporation. All rights reserved. (IL:PRETTYCOMPRINT IL:ROOMS-WINDOW-HIDERCOMS) (IL:RPAQQ IL:ROOMS-WINDOW-HIDERCOMS ((FILE-ENVIRONMENTS IL:ROOMS-WINDOW-HIDER) (IL:P (EXPORT '(HIDE-WINDOW UN-HIDE-WINDOW WINDOW-HIDDEN? ALL-WINDOWS LOST-WINDOWS)) (REQUIRE "ROOMS")) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP T) IL:WINDOW IL:FILEIO IL:LLDISPLAY IL:TTYIN )) (IL:VARIABLES *HIDDEN-WINDOWS*) (IL:FUNCTIONS ALL-WINDOWS LOST-WINDOWS) (IL:FUNCTIONS HIDE-ALL-WINDOWS HIDE-WINDOW HIDE-WINDOW-INTERNAL UN-HIDE-WINDOW UN-HIDE-WINDOW-INTERNAL DO-TOTOP-FUNCTIONS WINDOW-HIDDEN? %WINDOW-HIDDEN?) (IL:FNS SHAPEW1 \\CLOSEW1 MOVEW \\INTERNALTOTOPW WFROMMENU RESHOWTITLE \\RESHOWBORDER1 TTYIN.SETUP) (IL:GLOBALVARS IL:LAMBDASPLST IL:\\EM.DISPINTERRUPT IL:\\SCREENBITMAPS IL:\\TTYIN.LAST.FONT IL:\\TTYIN.LAST.COMMENTFONT) (EVAL-WHEN (LOAD) (IL:P (IL:MOVD 'SHAPEW1 'IL:SHAPEW1) (IL:MOVD '\\CLOSEW1 'IL:\\CLOSEW1) (IL:MOVD 'MOVEW 'IL:MOVEW) (IL:MOVD '\\INTERNALTOTOPW 'IL:\\INTERNALTOTOPW) (IL:MOVD 'WFROMMENU 'IL:WFROMMENU) (IL:MOVD 'RESHOWTITLE 'IL:RESHOWTITLE) (IL:MOVD '\\RESHOWBORDER1 'IL:\\RESHOWBORDER1) (IL:MOVD 'TTYIN.SETUP 'IL:TTYIN.SETUP))) (IL:ADVISE IL:ATTACHWINDOW))) (DEFINE-FILE-ENVIRONMENT IL:ROOMS-WINDOW-HIDER :COMPILER :COMPILE-FILE :PACKAGE "ROOMS" :READTABLE "XCL") (EXPORT '(HIDE-WINDOW UN-HIDE-WINDOW WINDOW-HIDDEN? ALL-WINDOWS LOST-WINDOWS)) (REQUIRE "ROOMS") (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILESLOAD (IL:LOADCOMP T) IL:WINDOW IL:FILEIO IL:LLDISPLAY IL:TTYIN) ) (DEFGLOBALVAR *HIDDEN-WINDOWS* (MAKE-HASH-TABLE :TEST 'EQ)) (DEFUN ALL-WINDOWS (&OPTIONAL INCLUDE-HIDDEN?) (IL:* IL:|;;;| "returns a list of all the window groups in bottom first order.") (LET (RESULT MAIN-WINDOW) (DOLIST (WINDOW (IL:OPENWINDOWS T) RESULT) (PUSHNEW (MAIN-WINDOW WINDOW) RESULT :TEST 'EQ)) (WHEN INCLUDE-HIDDEN? (MAPHASH #'(LAMBDA (WINDOW TRUE) (PUSHNEW (MAIN-WINDOW WINDOW) RESULT :TEST 'EQ)) *HIDDEN-WINDOWS*)) RESULT)) (DEFUN LOST-WINDOWS () (IL:* IL:|;;;| "returns the subset of all existing windows which are not in any room.") (IL:* IL:|;;;| "as UPDATE-PLACEMENTS guarentees us that all un-hidden windows belong to a room, we know that all lost windows must be hidden. ") (UPDATE-PLACEMENTS) (WITH-COLLECTION (DOLIST (WINDOW (ALL-WINDOWS T)) (UNLESS (FIND-ROOMS-CONTAINING WINDOW) (COLLECT WINDOW))))) (DEFUN HIDE-ALL-WINDOWS () (DOLIST (WINDOW (NREVERSE (ALL-WINDOWS))) (HIDE-WINDOW WINDOW))) (DEFUN HIDE-WINDOW (WINDOW) (LET ((WINDOW (MAIN-WINDOW WINDOW))) (UNLESS (WINDOW-HIDDEN? WINDOW) (LET ((ICON (WINDOW-ICON WINDOW))) (WHEN ICON (HIDE-WINDOW-INTERNAL ICON))) (HIDE-WINDOW-INTERNAL WINDOW) (IL:* IL:|;;| "return T if we succeded") T))) (DEFUN HIDE-WINDOW-INTERNAL (WINDOW) (UNLESS (WINDOW-HIDDEN? WINDOW) (DOLIST (ATTACHED-WINDOW (IL:WINDOWPROP WINDOW 'IL:ATTACHEDWINDOWS)) (IL:* IL:|;;| "recursively hide attached windows") (HIDE-WINDOW-INTERNAL ATTACHED-WINDOW)) (WHEN (IL:OPENWP WINDOW) (IL:* IL:|;;| "save the image") (IL:\\CLOSEW1 WINDOW)) (LET* ((DSP (IL:FETCH (IL:WINDOW IL:DSP) IL:OF WINDOW)) (BORDER (IL:FFETCH (IL:WINDOW IL:WBORDER) IL:OF WINDOW)) (CLIPPING-REGION (IL:DSPCLIPPINGREGION NIL DSP))) (IL:UNINTERRUPTABLY (IL:* IL:|;;| "switch the destination to the save bitmap") (IL:DSPDESTINATION (IL:FFETCH (IL:WINDOW IL:SAVE) IL:OF WINDOW) DSP) (IL:* IL:|;;| "adjust the offset") (IL:DSPXOFFSET (- BORDER (REGION-LEFT CLIPPING-REGION)) DSP) (IL:DSPYOFFSET (- BORDER (REGION-BOTTOM CLIPPING-REGION)) DSP) (IL:* IL:|;;| "so it's still IL:OPENWP") (IL:FREPLACE (IL:WINDOW IL:NEXTW) IL:OF WINDOW IL:WITH NIL)) (SETF (GETHASH WINDOW *HIDDEN-WINDOWS*) T)) T)) (DEFUN UN-HIDE-WINDOW (WINDOW) (LET* ((WINDOW (MAIN-WINDOW WINDOW)) (ICON (WINDOW-ICON WINDOW)) (SHRUNKEN? (SHRUNKEN? WINDOW))) (WHEN ICON (UN-HIDE-WINDOW-INTERNAL ICON (NOT SHRUNKEN?))) (UN-HIDE-WINDOW-INTERNAL WINDOW SHRUNKEN?) T)) (DEFUN UN-HIDE-WINDOW-INTERNAL (WINDOW &OPTIONAL NO-OPEN) (WHEN (WINDOW-HIDDEN? WINDOW) (IL:UNINTERRUPTABLY (LET* ((DSP (IL:FETCH (IL:WINDOW IL:DSP) IL:OF WINDOW)) (REGION (IL:FFETCH (IL:WINDOW IL:REG) IL:OF WINDOW)) (BORDER (IL:FFETCH (IL:WINDOW IL:WBORDER) IL:OF WINDOW)) (CLIPPING-REGION (IL:DSPCLIPPINGREGION NIL DSP))) (IL:* IL:|;;| "switch the destination to the screen") (IL:DSPDESTINATION (IL:FETCH (IL:SCREEN IL:SCDESTINATION) IL:OF (IL:FFETCH (IL:WINDOW IL:SCREEN) IL:OF WINDOW)) DSP) (IL:* IL:|;;| "adjust the offsets") (IL:DSPXOFFSET (- (+ (REGION-LEFT REGION) BORDER) (REGION-LEFT CLIPPING-REGION)) DSP) (IL:DSPYOFFSET (- (+ (REGION-BOTTOM REGION) BORDER) (REGION-BOTTOM CLIPPING-REGION)) DSP) (IL:* IL:|;;| "so it's not IL:OPENWP") (IL:FREPLACE (IL:WINDOW IL:NEXTW) IL:OF WINDOW IL:WITH 'IL:CLOSED)))) (UNLESS NO-OPEN (IL:\\OPENW1 WINDOW)) (REMHASH WINDOW *HIDDEN-WINDOWS*) (DOLIST (ATTACHED-WINDOW (IL:WINDOWPROP WINDOW 'IL:ATTACHEDWINDOWS)) (IL:* IL:|;;| "recursively un-hide attached windows") (UN-HIDE-WINDOW-INTERNAL ATTACHED-WINDOW NO-OPEN)) (UNLESS NO-OPEN (DO-TOTOP-FUNCTIONS WINDOW))) (DEFUN DO-TOTOP-FUNCTIONS (WINDOW) (LET ((TOTOPFN (IL:WINDOWPROP WINDOW 'IL:TOTOPFN))) (IL:* IL:|;;| "TOTOPFN's often look at what's behind a window & since this window now has a new screen behind it we do these. This makes buttons & icons work right. ") (WHEN (AND TOTOPFN (NOT (IL:* IL:|;;| "we take care of attached windows already") (OR (IL:EQMEMB 'IL:TOPATTACHEDWINDOWS TOTOPFN) (IL:EQMEMB 'IL:ATTACHEDWINDOWTOTOPFN TOTOPFN)))) (IL:DOUSERFNS TOTOPFN WINDOW)))) (DEFUN WINDOW-HIDDEN? (WINDOW) (%WINDOW-HIDDEN? WINDOW)) (DEFINLINE %WINDOW-HIDDEN? (WINDOW) (EQ (IL:FETCH (IL:\\DISPLAYDATA IL:|DDDestination|) IL:OF (IL:FETCH (STREAM IL:IMAGEDATA ) IL:OF (IL:FETCH (IL:WINDOW IL:DSP) IL:OF WINDOW ))) (IL:FFETCH (IL:WINDOW IL:SAVE) IL:OF WINDOW))) (IL:DEFINEQ (shapew1 (il:lambda (il:window il:region) (il:* il:\; "Edited 15-Jun-88 17:08 by drc:") (il:* il:|;;| "entry for shaping a window that does the reshape without checking for a user function.") (declare (il:localvars . t)) (il:setq il:window (il:\\insurewindow il:window)) (or (il:regionp il:region) (il:\\illegal.arg il:region)) (prog ((il:oldregion (il:|fetch| (il:window il:reg) il:|of| il:window)) (il:oldclipreg (il:dspclippingregion nil (il:|fetch| (il:window il:dsp) il:|of| il:window))) (il:wborder (il:|fetch| (il:window il:wborder) il:|of| il:window)) (il:save (il:|fetch| (il:window il:save) il:|of| il:window)) (il:screen (il:|fetch| (il:window il:screen) il:|of| il:window)) il:nusav il:nowopen? il:hidden?) (il:setq il:nusav (il:bitmapcreate (il:|fetch| (il:region il:width) il:|of| il:region) (il:|fetch| (il:region il:height) il:|of| il:region) (il:|fetch| (il:bitmap il:bitmapbitsperpixel) il:|of| (il:|fetch| (il:screen il:scdestination) il:|of| il:screen)))) (il:uninterruptably (cond ((il:openwp il:window) (il:if (window-hidden? il:window) il:then (il:setq il:hidden? t) il:else (il:* il:\; "notice whether window is open or not to call OPENFNs only if not now open.") (il:setq il:nowopen? t) (il:\\closew1 il:window)))) (il:* il:\; "Save window image") (il:|replace| (il:window il:reg) il:|of| il:window il:|with| il:region) (il:|replace| (il:window il:save) il:|of| il:window il:|with| il:nusav) (il:if il:hidden? il:then (let ((il:twiceborder (il:itimes (il:|fetch| (il:window il:wborder) il:|of| il:window) 2)) (il:dsp (il:|fetch| (il:window il:dsp) il:of il:window))) (il:dspdestination il:nusav il:dsp) (il:dspclippingregion (il:|create| il:region il:|using| (il:dspclippingregion nil il:dsp) il:width il:_ (- (il:|fetch| (il:region il:width) il:|of| il:region) il:twiceborder) il:height il:_ (+ (- (il:|fetch| (il:region il:height) il:|of| il:region) il:twiceborder) (il:|if| (il:|fetch| (il:window il:wtitle) il:|of| il:window) il:|then| (il:dsplinefeed nil (il:|fetch| (il:screen il:sctitleds) il:|of| il:screen)) il:|else| 0))) il:dsp) (il:showwframe il:window)) il:else (il:advisewds il:window il:oldregion) (il:showwframe il:window) (cond (il:nowopen? (il:\\openw1 il:window)) (t (il:openw il:window))))) (il:douserfns2 (or (il:|fetch| (il:window il:reshapefn) il:|of| il:window) (il:function il:reshapebyrepaintfn)) il:window il:save (il:|create| il:region il:left il:_ il:wborder il:bottom il:_ il:wborder il:width il:_ (il:|fetch| (il:region il:width) il:|of| il:oldclipreg) il:height il:_ (il:|fetch| (il:region il:height) il:|of| il:oldclipreg)) il:oldregion) (return il:window))) ) (\\closew1 (il:lambda (il:window) (il:* il:\; "Edited 15-Jun-88 15:36 by drc:") (il:* il:|;;| "actually does the closing operation. Is used by SHRINKW to avoid the CLOSEFN mechanism.") (let (il:screen il:nextw) (il:if (window-hidden? il:window) il:then (un-hide-window-internal il:window t) (quote il:closed) il:else (il:setq il:screen (il:|fetch| (il:window il:screen) il:|of| il:window)) (il:.while.top.ds. il:window (il:\\sw2bm (il:|fetch| (il:screen il:scdestination) il:|of| il:screen) (il:|fetch| (il:window il:reg) il:|of| il:window) (il:|fetch| (il:window il:save) il:|of| il:window) nil) (il:setq il:nextw (il:|fetch| (il:window il:nextw) il:|of| il:window)) (il:|replace| (il:screen il:sctopw) il:|of| il:screen il:|with| il:nextw) (il:setq il:\\topwds (cond (il:nextw (il:|fetch| (il:window il:dsp) il:|of| il:nextw)))) (il:* il:\; "smash the window's link to other's in the chain.") (il:|replace| (il:window il:nextw) il:|of| il:window il:|with| (quote il:closed)))))) ) (movew (il:lambda (il:window il:|POSorX| il:y) (il:* il:\; "Edited 15-Jun-88 15:42 by drc:") (il:* il:|;;| "moves a window. If window is closed and position is given, it won't open the window. It also calls the window's MOVEFN property.") (il:setq il:window (il:\\insurewindow il:window)) (prog ((il:oldregion (il:|fetch| (il:window il:reg) il:|of| il:window)) (il:usermovefn (il:|fetch| (il:window il:movefn) il:|of| il:window)) (il:open? (il:openwp il:window)) il:oldscreen il:pos il:newregion il:oldleft il:oldbottom il:oldwidth il:oldheight il:oldclipregion il:lft il:btm il:reg il:fn) (il:setq il:oldscreen (il:|fetch| (il:window il:screen) il:|of| il:window)) (cond ((cond ((il:listp il:usermovefn) (il:fmemb (quote il:don\'t) il:usermovefn)) (t (eq il:usermovefn (quote il:don\'t)))) (il:promptprint "This window cannot be moved.") (return))) (cond ((not (il:subregionp il:oldregion (il:|fetch| (il:screen il:scregion) il:|of| il:oldscreen))) (il:* il:\; "use T as an indication that the window was completely off screen.") (il:setq il:oldclipregion (or (il:\\onscreenclippingregion il:window) t)))) (il:setq il:oldleft (il:|fetch| (il:region il:left) il:|of| il:oldregion)) (il:setq il:oldbottom (il:|ffetch| (il:region il:bottom) il:|of| il:oldregion)) (il:setq il:oldwidth (il:|ffetch| (il:region il:width) il:|of| il:oldregion)) (il:setq il:oldheight (il:|ffetch| (il:region il:height) il:|of| il:oldregion)) (cond ((and il:|POSorX| (il:setq il:pos (cond ((il:positionp il:|POSorX|) il:|POSorX|) ((il:numberp il:|POSorX|) (cond ((il:numberp il:y) (il:|create| il:position il:xcoord il:_ il:|POSorX| il:ycoord il:_ il:y)) (t (il:\\illegal.arg il:y)))) ((il:regionp il:|POSorX|) (il:|create| il:position il:xcoord il:_ (il:|fetch| (il:region il:left) il:|of| il:|POSorX|) il:ycoord il:_ (il:|fetch| (il:region il:bottom) il:|of| il:|POSorX|))) (t (il:\\illegal.arg il:|POSorX|))))) (il:* il:\; "if not aready open, don't") (and il:open? (il:totopw il:window))) (t (il:* il:\; "no position to move to has been given, ask user for one.") (il:totopw il:window) (il:* il:\; "TOTOPW opens the window if it is not already.") (cond ((and (il:setq il:fn (il:windowprop il:window (quote il:calculateregionfn))) (il:setq il:reg (il:apply* il:fn il:window (quote movew)))) (il:* il:\; "prompt with a region that is calculated by the window") (il:setq il:pos (il:getboxposition (il:|fetch| (il:region il:width) il:|of| il:reg) (il:|ffetch| (il:region il:height) il:|of| il:reg) (il:setq il:lft (il:|ffetch| (il:region il:left) il:|of| il:reg)) (il:setq il:btm (il:|ffetch| (il:region il:bottom) il:|of| il:reg)))) (il:* il:|;;| "use a position that is offset by the same amount as the calculated region was from the window's region.") (il:setq il:pos (il:|create| il:position il:xcoord il:_ (il:iplus (il:|fetch| (il:position il:xcoord) il:|of| il:pos) (il:idifference il:oldleft il:lft)) il:ycoord il:_ (il:iplus (il:|ffetch| (il:position il:ycoord) il:|of| il:pos) (il:idifference il:oldbottom il:btm))))) (t (il:setq il:pos (il:getboxposition il:oldwidth il:oldheight il:oldleft il:oldbottom)))) (il:setq il:open? t))) (cond ((and (il:listp il:usermovefn) (not (il:fmemb (car il:usermovefn) il:lambdasplst))) (and (eq (il:|for| il:mfn il:|in| il:usermovefn il:|do| (il:setq il:newregion (il:apply* il:mfn il:window il:pos)) (cond ((eq il:newregion (quote il:don\'t)) (return (quote il:don\'t))) ((il:positionp il:newregion) (il:setq il:pos il:newregion)))) (quote il:don\'t)) (return))) (il:usermovefn (il:setq il:newregion (il:apply* il:usermovefn il:window il:pos)) (cond ((eq il:newregion (quote il:don\'t)) (return)) ((il:positionp il:newregion) (il:setq il:pos il:newregion))))) (cond ((or (not (eq (il:|fetch| (il:position il:xcoord) il:|of| il:pos) il:oldleft)) (not (eq (il:|ffetch| (il:position il:ycoord) il:|of| il:pos) il:oldbottom))) (il:setq il:newregion (il:|create| il:region il:left il:_ (il:|ffetch| (il:position il:xcoord) il:|of| il:pos) il:bottom il:_ (il:|ffetch| (il:position il:ycoord) il:|of| il:pos) il:width il:_ il:oldwidth il:height il:_ il:oldheight)) (il:if (window-hidden? il:window) il:then (il:* il:|;;| "just update region") (il:|replace| (il:window il:reg) il:|of| il:window il:|with| il:newregion) il:else (il:uninterruptably (cond (il:open? (il:* il:|;;| "if window is open, move it to top as its MOVEFN may have changed things and swap its bits to its new location") (il:.while.top.ds. il:window (il:\\sw2bm (il:|fetch| (il:screen il:scdestination) il:|of| il:oldscreen) il:oldregion (il:|fetch| (il:window il:save) il:|of| il:window) nil) (il:\\sw2bm (il:|ffetch| (il:window il:save) il:|of| il:window) nil (il:|ffetch| (il:screen il:scdestination) il:|of| il:oldscreen) il:newregion)))) (il:|replace| (il:window il:reg) il:|of| il:window il:|with| il:newregion) (il:advisewds il:window il:oldregion t))) (cond ((and il:open? (il:windowprop il:window (quote il:repaintfn)) il:oldclipregion) (il:* il:\; "redisplay those parts that were off the screen.") (cond ((eq il:oldclipregion t) (il:* il:\; "whole window was off.") (il:redisplayw il:window nil t)) (t (prog (il:newclippingregion il:ncl il:ocl il:ncb il:ocb il:ocr il:ncr il:ocw il:ncw il:och il:nch il:oct il:nct) (il:setq il:newclippingregion (il:\\onscreenclippingregion il:window)) (il:* il:\; "the title may be the only thing now on the screen.") (or il:newclippingregion (return)) (il:setq il:ncb (il:|fetch| (il:region il:bottom) il:|of| il:newclippingregion)) (il:setq il:ocb (il:|fetch| (il:region il:bottom) il:|of| il:oldclipregion)) (il:setq il:ocw (il:|ffetch| (il:region il:width) il:|of| il:oldclipregion)) (il:setq il:ncw (il:|ffetch| (il:region il:width) il:|of| il:newclippingregion)) (il:setq il:och (il:|ffetch| (il:region il:height) il:|of| il:oldclipregion)) (il:setq il:nch (il:|ffetch| (il:region il:height) il:|of| il:newclippingregion)) (cond ((il:ilessp (il:setq il:ncl (il:|ffetch| (il:region il:left) il:|of| il:newclippingregion)) (il:setq il:ocl (il:|ffetch| (il:region il:left) il:|of| il:oldclipregion))) (il:redisplayw il:window (il:createregion il:ncl il:ocb (il:idifference il:ocl il:ncl) il:och)))) (cond ((il:ilessp (il:setq il:ocr (il:iplus il:ocl il:ocw)) (il:setq il:ncr (il:iplus il:ncl il:ncw))) (il:* il:\; "some stuff appeared from the right.") (il:redisplayw il:window (il:createregion il:ocr il:ocb (il:idifference il:ncr il:ocr) il:och)))) (cond ((il:ilessp il:ncb il:ocb) (il:redisplayw il:window (il:createregion il:ncl il:ncb il:ncw (il:idifference il:ocb il:ncb))))) (cond ((il:ilessp (il:setq il:oct (il:iplus il:ocb il:och)) (il:setq il:nct (il:iplus il:ncb il:nch))) (il:* il:\; "some stuff appeared from the top") (il:redisplayw il:window (il:createregion il:ncl il:oct il:ncw (il:idifference il:nct il:oct))))) (cond ((il:igreaterp (il:iplus il:oldbottom il:oldheight) (il:|fetch| (il:screen il:scheight) il:|of| il:oldscreen)) (il:* il:\; "should reshow the title but don't have any entry for that.") nil))))))) (il:douserfns (il:windowprop il:window (quote il:aftermovefn)) il:window))) (return il:pos))) ) (\\internaltotopw (il:lambda (il:w1 il:rpt) (il:* il:\; "Edited 15-Jun-88 14:50 by drc:") (prog (il:screen il:screentopw) (il:setq il:w1 (il:\\insurewindow il:w1)) (il:setq il:screen (il:|fetch| (il:window il:screen) il:|of| il:w1)) (il:setq il:screentopw (il:|fetch| (il:screen il:sctopw) il:|of| il:screen)) (or (eq il:w1 il:screentopw) (window-hidden? il:w1) (cond ((null il:screentopw) (il:* il:\; "all windows are closed open this one.") (il:openw il:w1)) (t (il:uninterruptably (il:\\ttw1 il:w1 il:screentopw) (il:* il:|;;| "N.B. \\TTW1 can side effect the screen") (cond ((eq il:w1 (il:|fetch| (il:screen il:sctopw) il:|of| il:screen))) ((not il:rpt) (il:* il:\; "GC msgs or other glitches can cause W1 not to make it. Check and try ONCE more") (\\internaltotopw il:w1 t))))))))) ) (wfrommenu (il:lambda (il:menu) (il:* il:\; "Edited 15-Jun-88 19:19 by drc:") (il:* il:|;;;| "finds the window that menu is in if any.") (block wfrommenu (dolist (il:window (all-windows t)) (labels ((il:search-attached-windows (il:window) (when (il:fmemb il:menu (il:windowprop il:window (quote il:menu))) (return-from wfrommenu il:window)) (dolist (il:window (il:windowprop il:window (quote il:attachedwindows))) (il:search-attached-windows il:window)))) (il:search-attached-windows il:window))))) ) (reshowtitle (il:lambda (il:title il:window il:justdisplayflg) (il:* il:\; "Edited 15-Jun-88 18:57 by drc:") (il:* il:|;;| "updates a windows display with a new title") (prog* ((il:wreg (il:|fetch| (il:window il:reg) il:|of| il:window)) (il:titleds (il:|fetch| (il:screen il:sctitleds) il:|of| (il:|fetch| (il:window il:screen) il:|of| il:window))) (il:titleheight (il:iminus (il:dsplinefeed nil il:titleds))) (il:oldtitle (il:|fetch| (il:window il:wtitle) il:|of| il:window)) (il:border (il:|fetch| (il:window il:wborder) il:|of| il:window)) il:bm il:bmbtm il:hght) (cond (il:justdisplayflg) ((eq il:title (il:|fetch| (il:window il:wtitle) il:|of| il:window)) (return)) (t (il:|replace| (il:window il:wtitle) il:|of| il:window il:|with| il:title) (cond ((or (null il:oldtitle) (null il:title) (il:neq il:titleheight (il:idifference (il:|fetch| (il:region il:height) il:|of| il:wreg) (il:iplus (il:|fetch| (il:region il:height) il:|of| (il:dspclippingregion nil (il:|fetch| (il:window il:dsp) il:|of| il:window))) (il:itimes 2 il:border))))) (il:* il:\; "Previously no title, so make space for one") (il:* il:\; "Have to remove title") (il:* il:\; "or title height changed.") (il:* il:\; "so windows region on the screen has to be made larger.") (il:\\reshowborder1 (il:|fetch| (il:window il:wborder) il:|of| il:window) (il:|fetch| (il:window il:wborder) il:|of| il:window) il:window) (return))))) (il:* il:\; "code from here is to reprint the title in place to avoid creating any large bitmaps.") (il:setq il:bm (il:bitmapcreate (il:|fetch| (il:region il:width) il:|of| il:wreg) (il:setq il:titleheight (il:add1 il:titleheight)) (il:bitsperpixel (il:|fetch| (il:screen il:scdestination) il:|of| (il:|fetch| (il:window il:screen) il:|of| il:window))))) (il:bitblt nil nil nil il:bm 0 0 nil nil (quote il:texture) (quote il:replace) il:blackshade) (il:* il:\; "use SHOWWTITLE to put the image of the title into the auxilliary bitmap.") (il:showwtitle il:title il:bm il:border nil il:window) (cond ((il:igreaterp il:titleheight (il:setq il:hght (il:|fetch| (il:region il:height) il:|of| il:wreg))) (il:setq il:bmbtm (il:idifference (il:sub1 il:titleheight) il:hght)))) (let ((il:hidden? (window-hidden? il:window))) (il:uninterruptably (il:totopw il:window) (il:bitblt il:bm 0 (cond (il:bmbtm) ((il:igreaterp il:border 0) (il:* il:|;;| "if there is a border, the title was printed in the scratch bitmap so to leave one point of the border on top") 0) (t 1)) (il:dspdestination nil il:window) (il:if il:hidden? il:then 0 il:else (il:|fetch| (il:region il:left) il:|of| il:wreg)) (il:idifference (il:if il:hidden? il:then (il:|fetch| (il:region il:height) il:|of| il:wreg) il:else (il:|fetch| (il:region il:ptop) il:|of| il:wreg)) (cond (il:bmbtm il:hght) (t (il:iplus il:titleheight (cond ((il:igreaterp il:border 0) (il:* il:|;;| "if there is a border, the title was printed in the scratch bitmap so to leave one point of the border on top") 0) (t -1)))))) nil (cond (il:bmbtm il:hght))))))) ) (\\reshowborder1 (il:lambda (il:newborder il:oldborder il:window) (il:* il:\; "Edited 15-Jun-88 19:05 by drc:") (il:* il:|;;| "redisplays the border of a window. Is called by RESHOWBORDER and RESHOWTITLE. It doesn't check for equality between the new and old borders because it is also used when a title is added or deleted.") (prog ((il:region (il:|fetch| (il:window il:reg) il:|of| il:window)) (il:oldsave (il:|fetch| (il:window il:save) il:|of| il:window)) il:nusav il:delta il:nuwidth il:nuheight il:hidden?) (il:setq il:delta (il:idifference il:newborder il:oldborder)) (il:setq il:nuwidth (il:iplus (il:|fetch| (il:region il:width) il:|of| il:region) (il:itimes il:delta 2))) (il:setq il:nuheight (il:idifference (il:iplus (il:|fetch| (il:region il:height) il:|of| (il:dspclippingregion nil (il:|fetch| (il:window il:dsp) il:|of| il:window))) (il:itimes il:newborder 2)) (cond ((il:|fetch| (il:window il:wtitle) il:|of| il:window) (il:dsplinefeed nil (il:|fetch| (il:screen il:sctitleds) il:|of| (il:|fetch| (il:window il:screen) il:|of| il:window)))) (t 0)))) (il:setq il:nusav (il:bitmapcreate il:nuwidth il:nuheight (il:|fetch| (il:bitmap il:bitmapbitsperpixel) il:|of| il:oldsave))) (il:setq il:hidden? (window-hidden? il:window)) (il:.while.top.ds. il:window (il:* il:\; "Save window image") (or il:hidden? (il:\\sw2bm (il:|fetch| (il:screen il:scdestination) il:|of| (il:|fetch| (il:window il:screen) il:|of| il:window)) il:region (il:|fetch| (il:window il:save) il:|of| il:window) nil)) (il:* il:\; "put new save image into window") (il:|replace| (il:window il:save) il:|of| il:window il:|with| il:nusav) (il:if il:hidden? il:then (il:dspdestination il:nusav il:window)) (il:|replace| (il:window il:wborder) il:|of| il:window il:|with| il:newborder) (il:if il:hidden? il:then (il:* il:|;;| "re-adjust X & Y offset") (il:dspxoffset il:newborder il:window) (il:dspyoffset il:newborder il:window)) (il:* il:\; "create a region that coresponds to the old region with the new border.") (il:|replace| (il:window il:reg) il:|of| il:window il:|with| (il:|create| il:region il:left il:_ (il:idifference (il:|fetch| (il:region il:left) il:|of| il:region) il:delta) il:bottom il:_ (il:idifference (il:|fetch| (il:region il:bottom) il:|of| il:region) il:delta) il:width il:_ il:nuwidth il:height il:_ il:nuheight)) (il:update/scroll/reg il:window) (il:* il:\; "draw border in the new image.") (il:showwframe il:window) (il:* il:\; "copy the visible part from the old image into the new one.") (il:bitblt il:oldsave il:oldborder il:oldborder il:nusav il:newborder il:newborder (il:idifference (il:|fetch| (il:bitmap il:bitmapwidth) il:|of| il:oldsave) (il:itimes 2 il:oldborder)) (il:|fetch| (il:region il:height) il:|of| (il:dspclippingregion nil (il:|fetch| (il:window il:dsp) il:|of| il:window))) (quote il:input) (quote il:replace)) (il:* il:\; "put the new image up on the screen.") (or il:hidden? (il:\\sw2bm (il:|fetch| (il:screen il:scdestination) il:|of| (il:|fetch| (il:window il:screen) il:|of| il:window)) (il:|fetch| (il:window il:reg) il:|of| il:window) (il:|fetch| (il:window il:save) il:|of| il:window) nil))))) ) (ttyin.setup (il:lambda nil (il:* il:\; "Edited 16-Jun-88 11:37 by drc:") (il:* il:\; "Disable buttons so we can do selection") (let ((il:window (il:wfromds il:\\dsp t))) (cond (il:window (il:|replace| (il:ttyinbuffer il:ttoldrightfn) il:|of| il:\\ttyinstate il:|with| (il:windowprop il:window (quote il:rightbuttonfn) (quote il:totopw))) (il:|replace| (il:ttyinbuffer il:ttoldbuttonfn) il:|of| il:\\ttyinstate il:|with| (il:windowprop il:window (quote il:buttoneventfn) (quote il:totopw))) (il:|replace| (il:ttyinbuffer il:ttoldentryfn) il:|of| il:\\ttyinstate il:|with| (il:windowprop il:window (quote il:windowentryfn) (quote il:ttyinentryfn))) (il:|replace| (il:ttyinbuffer il:ttyinwindow) il:|of| il:\\ttyinstate il:|with| il:window) (il:windowprop il:window (quote il:ttyinstate) (il:|fetch| (il:ttyinbuffer il:ttyinwindowstate) il:|of| il:\\ttyinstate)) (il:resetsave nil (list (il:function il:ttyin.cleanup) il:\\ttyinstate)))) (cond ((or (il:imagestreamtypep il:\\dsp (quote il:text)) (il:fmemb (il:dspdestination nil il:\\dsp) il:\\screenbitmaps) (and il:window (window-hidden? il:window))) (il:setq il:\\charwidth (il:charwidth (il:charcode il:a) il:\\dsp)) (il:setq il:\\font (il:dspfont nil il:\\dsp)) (il:|if| (eq il:\\font il:\\ttyin.last.font) il:|then| (il:setq il:\\commentfont il:\\ttyin.last.commentfont) il:|elseif| il:\\reading il:|then| (il:* il:\; "Want a \"comment\" font for ?=") (il:setq il:\\commentfont (il:setq il:\\ttyin.last.commentfont (il:fontcopy il:\\font (quote il:weight) (il:selectq (il:fontprop il:\\font (quote il:weight)) (il:bold (quote il:medium)) (quote il:bold))))) (il:setq il:\\ttyin.last.font il:\\font) il:|else| (il:setq il:\\commentfont il:\\font)) (il:setq il:\\charheight (max (il:fontheight il:\\font) (il:fontheight il:\\commentfont))) (il:setq il:\\descent (il:fontprop il:\\font (quote il:descent))) (il:* il:\; "How many pixels below the baseline this font goes") (il:setq il:\\texture (il:dsptexture nil il:\\dsp)) (il:setq il:\\ttpagelength (il:pageheight nil il:\\dsp)) (il:setq il:\\lmarg (il:dspleftmargin nil il:\\dsp)) (il:* il:\; "bit pos of left margin") (il:setq il:\\rmarg (il:dsprightmargin nil il:\\dsp)) (il:* il:\; "bit pos of right margin, dsp relative") (il:setq il:\\initpos (il:dspxposition nil il:\\dsp)))))) ) ) (IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY (IL:GLOBALVARS IL:LAMBDASPLST IL:\\EM.DISPINTERRUPT IL:\\SCREENBITMAPS IL:\\TTYIN.LAST.FONT IL:\\TTYIN.LAST.COMMENTFONT) ) (EVAL-WHEN (LOAD) (IL:MOVD 'SHAPEW1 'IL:SHAPEW1) (IL:MOVD '\\CLOSEW1 'IL:\\CLOSEW1) (IL:MOVD 'MOVEW 'IL:MOVEW) (IL:MOVD '\\INTERNALTOTOPW 'IL:\\INTERNALTOTOPW) (IL:MOVD 'WFROMMENU 'IL:WFROMMENU) (IL:MOVD 'RESHOWTITLE 'IL:RESHOWTITLE) (IL:MOVD '\\RESHOWBORDER1 'IL:\\RESHOWBORDER1) (IL:MOVD 'TTYIN.SETUP 'IL:TTYIN.SETUP) ) (REINSTALL-ADVICE 'IL:ATTACHWINDOW :AFTER '((:LAST (WHEN (AND (WINDOW-HIDDEN? (IL:INSURE.WINDOW IL:MAINWINDOW)) (NOT (WINDOW-HIDDEN? ( IL:INSURE.WINDOW IL:WINDOWTOATTACH )))) (HIDE-WINDOW-INTERNAL IL:WINDOWTOATTACH) )))) (IL:READVISE IL:ATTACHWINDOW) (IL:PUTPROPS IL:ROOMS-WINDOW-HIDER IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990 2020)) (IL:DECLARE\: IL:DONTCOPY (IL:FILEMAP (NIL (2505 3071 (ALL-WINDOWS 2505 . 3071)) (3073 3538 (LOST-WINDOWS 3073 . 3538)) (3540 3653 (HIDE-ALL-WINDOWS 3540 . 3653)) (3655 4001 (HIDE-WINDOW 3655 . 4001)) (4003 5348 ( HIDE-WINDOW-INTERNAL 4003 . 5348)) (5350 5658 (UN-HIDE-WINDOW 5350 . 5658)) (5660 7422 ( UN-HIDE-WINDOW-INTERNAL 5660 . 7422)) (7424 8040 (DO-TOTOP-FUNCTIONS 7424 . 8040)) (8042 8109 ( WINDOW-HIDDEN? 8042 . 8109)) (8886 29312 (SHAPEW1 8899 . 11521) (\\CLOSEW1 11523 . 12510) (MOVEW 12512 . 19579) (\\INTERNALTOTOPW 19581 . 20375) (WFROMMENU 20377 . 20881) (RESHOWTITLE 20883 . 23878) ( \\RESHOWBORDER1 23880 . 27015) (TTYIN.SETUP 27017 . 29310))))) IL:STOP