(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "19-Feb-2021 14:31:33"  {DSK}kaplan>Local>medley3.5>git-medley>sources>TWODINSPECTOR.;6 113157 changes to%: (FNS TWODINSPECT.ARRANGEWINDOWS RIGHTW.REPAINTFN TWODINSPECT.SCROLLFN GET-RIGHTW ONEDINSPECT.SCROLLFN) previous date%: "11-Aug-2020 11:22:30" {DSK}kaplan>Local>medley3.5>git-medley>sources>TWODINSPECTOR.;2) (* ; " Copyright (c) 1985, 1900, 1987, 1990, 1992, 1993, 2020, 2021 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT TWODINSPECTORCOMS) (RPAQQ TWODINSPECTORCOMS ( (* ;; "Substrate for two-dimensional inspectors. Used in inspecting arrays.") (COMS (* ;; "Added by yabu.fx, for SUNLOADUP without DWIM. They compute load time constants, and must come first in the file.") (FNS \CREATE.TWODINSPECTOR.TITLEMENU \CREATE.TWODINSPECTOR.SETMENU \CREATE.TWODINSPECTOR.INSPECTMENU)) (* ;; "Oned-inspector ") (FNS ONEDINSPECTW.CREATE GET-ONED-DISPLAYW ONEDINSPECT.ARRANGEWINDOWS ONEDINSPECT.REPAINTFN ONEDINSPECT.PRINTELEMENT ONEDINSPECT.RESHAPEFN ONEDINSPECT.MAKEREGIONS ONEDINSPECT.BUTTONEVENTFN ONEDINSPECT.COPYBUTTONFN ONEDINSPECT.SCROLLFN ONEDINSPECT.CLOSEFN ONEDINSPECT.REDISPLAY ONEDINSPECT.REPLACE ONEDINSPECT.SELECTITEM ONEDINSPECT.SELECTPROP ONEDINSPECT.ADJUSTSELECTION ONEDINSPECT.PROPWIDTH ONEDINSPECT.VALUEWIDTH ONEDINSPECT.DEFAULT.TITLECOMMANDFN ONEDINSPECT.DEFAULT.VALUECOMMANDFN ONEDINSPECT.SETELT) (* ;; "Twod-inspector") (FNS TWODINSPECTW.CREATE GET-TWOD-DISPLAYW GET-CORNERW TWODINSPECT.ARRANGEWINDOWS TWODINSPECT.REPAINTFN TWODINSPECT.PRINTELEMENT TWODINSPECT.RESHAPEFN TWODINSPECT.MAKEREGIONS TWODINSPECT.BUTTONEVENTFN TWODINSPECT.COPYBUTTONFN TWODINSPECT.DOWINDOWCOMFN TWODINSPECT.SCROLLFN TWODINSPECT.CLOSEFN TWODINSPECT.REDISPLAY TWODINSPECT.REPLACE TWODINSPECT.SELECTITEM TWODINSPECT.SELECTROWPROP TWODINSPECT.SELECTCOLUMNPROP TWODINSPECT.ADJUSTSELECTION TWODINSPECT.DEFAULT.TITLECOMMANDFN TWODINSPECT.DEFAULT.VALUECOMMANDFN TWODINSPECT.SETELT TWODINSPECT.ROWPROPWIDTH TWODINSPECT.COLUMNWIDTHS TWODINSPECT.COLUMNWIDTH TWODINSPECT.TOTALWIDTH) (* ;; "Right window fns") (FNS GET-RIGHTW RIGHTW.REPAINTFN RIGHTW.RESHAPEFN RIGHTW.BUTTONEVENTFN RIGHTW.ADJUSTSELECTION ) (* ;; "Top window fns") (FNS GET-TOPW TOPW.REPAINTFN TOPW.RESHAPEFN TOPW.ADJUSTSELECTION TOPW.BUTTONEVENTFN) (* ;; "Title window fns") (FNS GET-TITLEW TITLEW.REPAINTFN TITLEW.BUTTONEVENTFN) (* ;; "Utilites ") (FNS ONED.TRACKCURSOR TWOD.TRACKCURSOR INSPECT.INVERTSELECTION INSPECT.INVERTREGION INSPECT.FLIPSELECTION) (INITVARS INSPECTORFONT) (GLOBALVARS INSPECTORFONT) (DECLARE%: DOEVAL@COMPILE DONTCOPY (RECORDS INSPECT.SELECTION ONED.SELECTION TWOD.SELECTION)) (INITRECORDS ONED.SELECTION TWOD.SELECTION) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T)))) (* ;; "Substrate for two-dimensional inspectors. Used in inspecting arrays.") (* ;; "Added by yabu.fx, for SUNLOADUP without DWIM. They compute load time constants, and must come first in the file." ) (DEFINEQ (\CREATE.TWODINSPECTOR.TITLEMENU [LAMBDA NIL (create MENU ITEMS _ '(("Refetch" 'REFETCH "Refetch the datum") ("IT _ Datum" 'IT "Bind IT to the inspected datum"]) (\CREATE.TWODINSPECTOR.SETMENU [LAMBDA NIL (create MENU ITEMS _ '(("IT _ Selection" 'IT "Bind IT to the value of the selected entry") ("Set" 'SET "Set the selected entry"]) (\CREATE.TWODINSPECTOR.INSPECTMENU [LAMBDA NIL (create MENU ITEMS _ '(("Inspect" 'INSPECT "Inspect the value of the selected entry") ("IT _ Selection" 'IT "Bind IT to the value of the selected entry") ("Set" 'SET "Set the selected entry"]) ) (* ;; "Oned-inspector ") (DEFINEQ (ONEDINSPECTW.CREATE [LAMBDA (DATUM PROPS FETCHFN STOREFN VALUECOMMANDFN PROPCOMMANDFN TITLE TITLECOMMANDFN WHERE TOPRIGHT) (* ; "Edited 6-Apr-87 17:03 by jop") (* ;;  "If where is a window, it may be the result of a previous call, so try to reuse all windows") (PROG ((PROFILE (MAKE-INSPECTOR-PROFILE)) [FONT (OR INSPECTORFONT (DEFAULTFONT 'DISPLAY] [TITLEFONT (OR (DSPFONT NIL WindowTitleDisplayStream) '(HELVETICA 8 MRR] DISPLAYWINDOW RIGHTWINDOW TITLEWINDOW GLEFT GBOTTOM GWIDTH GHEIGHT WINDOWGROUP) (WITH-INSPECTOR-ENV PROFILE (if (LITATOM PROPS) then (SETQ PROPS (APPLY* PROPS DATUM))) (* ;  "DISPLAYWINDOW is the central and main window of the group") (SETQ DISPLAYWINDOW (GET-ONED-DISPLAYW WHERE DATUM FETCHFN STOREFN VALUECOMMANDFN PROPCOMMANDFN TITLECOMMANDFN PROPS PROFILE FONT)) (* ;  "RIGHTWINDOW records the ROWPROPS") (SETQ RIGHTWINDOW (GET-RIGHTW DISPLAYWINDOW FONT)) (* ;  "TITLEWINDOW will only hold a title") (SETQ TITLEWINDOW (GET-TITLEW DISPLAYWINDOW TITLE TITLEFONT DATUM)) (* ; "Put up the window group") [if (NOT (POSITIONP TOPRIGHT)) then (LET ((REGION (if (WINDOWP WHERE) then (WINDOWPROP WHERE 'REGION) elseif (REGIONP WHERE) then WHERE))) (if REGION then (SETQ GLEFT (fetch (REGION LEFT) of REGION)) (SETQ GBOTTOM (fetch (REGION BOTTOM) of REGION)) (SETQ GWIDTH (fetch (REGION WIDTH) of REGION)) (SETQ GHEIGHT (fetch (REGION HEIGHT) of REGION)) elseif (POSITIONP WHERE) then (SETQ GLEFT (fetch (POSITION XCOORD) of WHERE)) (SETQ GBOTTOM (fetch (POSITION YCOORD) of WHERE] (SETQ WINDOWGROUP (ONEDINSPECT.ARRANGEWINDOWS DISPLAYWINDOW RIGHTWINDOW TITLEWINDOW GLEFT GBOTTOM GWIDTH GHEIGHT TOPRIGHT)) (* ;; "Display the group") (ONEDINSPECT.RESHAPEFN DISPLAYWINDOW) (RIGHTW.RESHAPEFN RIGHTWINDOW) (TITLEW.REPAINTFN TITLEWINDOW) (* ;; "then establish reshapefns for windows in group") (WINDOWPROP DISPLAYWINDOW 'RESHAPEFN (FUNCTION ONEDINSPECT.RESHAPEFN)) (WINDOWPROP RIGHTWINDOW 'RESHAPEFN (FUNCTION RIGHTW.RESHAPEFN)) (WINDOWPROP TITLEWINDOW 'RESHAPEFN (FUNCTION TITLEW.REPAINTFN))) (* ;; "finally return the group") (RETURN WINDOWGROUP]) (GET-ONED-DISPLAYW [LAMBDA (WHERE DATUM FETCHFN STOREFN VALUECOMMANDFN PROPCOMMANDFN TITLECOMMANDFN PROPS PROFILE FONT) (* ; "Edited 6-Apr-87 14:57 by jop") (LET [(DISPLAYWINDOW (if (WINDOWP WHERE) then WHERE else (CREATEW (CREATEREGION 0 0 100 100) NIL 2 T] (WINDOWPROP DISPLAYWINDOW 'REPAINTFN (FUNCTION ONEDINSPECT.REPAINTFN)) (WINDOWPROP DISPLAYWINDOW 'RESHAPEFN (FUNCTION CLEARW)) (WINDOWPROP DISPLAYWINDOW 'SCROLLFN (FUNCTION ONEDINSPECT.SCROLLFN)) (WINDOWPROP DISPLAYWINDOW 'BUTTONEVENTFN (FUNCTION ONEDINSPECT.BUTTONEVENTFN)) (WINDOWPROP DISPLAYWINDOW 'COPYBUTTONEVENTFN (FUNCTION ONEDINSPECT.COPYBUTTONFN)) (WINDOWPROP DISPLAYWINDOW 'CLOSEFN (FUNCTION ONEDINSPECT.CLOSEFN)) (DSPRIGHTMARGIN MAX.SMALLP DISPLAYWINDOW) (DSPFONT FONT DISPLAYWINDOW) (WINDOWPROP DISPLAYWINDOW 'DATUM DATUM) (WINDOWPROP DISPLAYWINDOW 'FETCHFN FETCHFN) (WINDOWPROP DISPLAYWINDOW 'STOREFN STOREFN) (WINDOWPROP DISPLAYWINDOW 'VALUECOMMANDFN (OR VALUECOMMANDFN (FUNCTION ONEDINSPECT.DEFAULT.VALUECOMMANDFN ))) (WINDOWPROP DISPLAYWINDOW 'ROWPROPCOMMANDFN PROPCOMMANDFN) (WINDOWPROP DISPLAYWINDOW 'TITLECOMMANDFN (OR TITLECOMMANDFN (FUNCTION ONEDINSPECT.DEFAULT.TITLECOMMANDFN ))) (WINDOWPROP DISPLAYWINDOW 'ROWPROPS PROPS) (WINDOWPROP DISPLAYWINDOW 'ROWPROPSPACE " ") (WINDOWPROP DISPLAYWINDOW 'VALUEWIDTH (ONEDINSPECT.VALUEWIDTH DATUM PROPS FETCHFN FONT)) (WINDOWPROP DISPLAYWINDOW 'VALUESPACE " ") (WINDOWPROP DISPLAYWINDOW 'PROFILE PROFILE) DISPLAYWINDOW]) (ONEDINSPECT.ARRANGEWINDOWS [LAMBDA (DISPLAYWINDOW RIGHTWINDOW TITLEWINDOW TOTALLEFT TOTALBOTTOM TOTALWIDTH TOTALHEIGHT TOPRIGHT) (* ; "Edited 11-Aug-2020 11:21 by rmk:") (* ; "Edited 6-Apr-87 15:08 by jop") (* ;; "RMK: Save the ROWPROPWIDTH for future right-adjusting of the right (props) window") (* ;; "REGION should be the total available area") (PROG ((ROWPROPS (WINDOWPROP DISPLAYWINDOW 'ROWPROPS)) (ROWPROPSPACE (WINDOWPROP DISPLAYWINDOW 'ROWPROPSPACE)) (VALUEWIDTH (WINDOWPROP DISPLAYWINDOW 'VALUEWIDTH)) (VALUESPACE (WINDOWPROP DISPLAYWINDOW 'VALUESPACE)) TOTALRIGHT TOTALTOP DWHEIGHT DWWIDTH TITLEHEIGHT RWWIDTH DWLEFT DWBOTTOM ROWPROPWIDTH) [SETQ TITLEHEIGHT (HEIGHTIFWINDOW (FONTPROP TITLEWINDOW 'HEIGHT) NIL (WINDOWPROP TITLEWINDOW 'BORDER] (SETQ ROWPROPWIDTH (ONEDINSPECT.PROPWIDTH (WINDOWPROP DISPLAYWINDOW 'ROWPROPS) DISPLAYWINDOW)) [SETQ RWWIDTH (WIDTHIFWINDOW (IPLUS (STRINGWIDTH ROWPROPSPACE RIGHTWINDOW) ROWPROPWIDTH) (WINDOWPROP RIGHTWINDOW 'BORDER] (if (NULL TOTALHEIGHT) then [SETQ DWHEIGHT (IMIN 500 (HEIGHTIFWINDOW (ITIMES (FONTPROP DISPLAYWINDOW 'HEIGHT) (LENGTH ROWPROPS)) NIL (WINDOWPROP DISPLAYWINDOW 'BORDER] (SETQ TOTALHEIGHT (IPLUS TITLEHEIGHT DWHEIGHT)) else (SETQ DWHEIGHT (IDIFFERENCE TOTALHEIGHT TITLEHEIGHT))) (if (NULL TOTALWIDTH) then [SETQ DWWIDTH (IMIN 200 (WIDTHIFWINDOW (IPLUS VALUEWIDTH (STRINGWIDTH VALUESPACE DISPLAYWINDOW) ) (WINDOWPROP DISPLAYWINDOW 'BORDER] (SETQ TOTALWIDTH (IPLUS RWWIDTH DWWIDTH)) else (SETQ DWWIDTH (IDIFFERENCE TOTALWIDTH RWWIDTH))) [if (POSITIONP TOPRIGHT) then (SETQ TOTALRIGHT (fetch (POSITION XCOORD) of TOPRIGHT)) (SETQ TOTALTOP (fetch (POSITION YCOORD) of TOPRIGHT)) elseif (AND TOTALLEFT TOTALBOTTOM) then (SETQ TOTALRIGHT (IPLUS TOTALLEFT (SUB1 TOTALWIDTH))) (SETQ TOTALTOP (IPLUS TOTALBOTTOM (SUB1 TOTALHEIGHT))) else (LET ((REGION (GETBOXREGION TOTALWIDTH TOTALHEIGHT NIL NIL NIL "Position Inspector window"))) (SETQ TOTALTOP (fetch (REGION TOP) of REGION)) (SETQ TOTALRIGHT (fetch (REGION RIGHT) of REGION] [SETQ DWLEFT (DIFFERENCE TOTALRIGHT (SUB1 (PLUS DWWIDTH RWWIDTH] (if (ILESSP DWLEFT 0) then (SETQ DWLEFT 0) (SETQ DWWIDTH (DIFFERENCE (ADD1 TOTALRIGHT) RWWIDTH))) [SETQ DWBOTTOM (DIFFERENCE TOTALTOP (SUB1 (PLUS DWHEIGHT TITLEHEIGHT] (if (LESSP DWBOTTOM 0) then (SETQ DWBOTTOM 0) (SETQ DWHEIGHT (DIFFERENCE (ADD1 TOTALTOP) TITLEHEIGHT))) (* ;; "put up the window group") (WINDOWPROP DISPLAYWINDOW 'MINSIZE (CONS 0 0)) (SHAPEW DISPLAYWINDOW (CREATEREGION DWLEFT DWBOTTOM DWWIDTH DWHEIGHT)) (* ;  "Need to set the Minsize BEFORE reshaping else we catch the default minsize") (WINDOWPROP RIGHTWINDOW 'MINSIZE (CONS RWWIDTH 0)) (WINDOWPROP RIGHTWINDOW 'MAXSIZE (CONS RWWIDTH MAX.SMALLP)) (WINDOWPROP RIGHTWINDOW 'ROWPROPWIDTH ROWPROPWIDTH) (SHAPEW RIGHTWINDOW (CREATEREGION [ADD1 (fetch (REGION RIGHT) of (WINDOWPROP DISPLAYWINDOW 'REGION] DWBOTTOM RWWIDTH DWHEIGHT)) (ATTACHWINDOW RIGHTWINDOW DISPLAYWINDOW 'RIGHT) (WINDOWPROP TITLEWINDOW 'MINSIZE (CONS 0 TITLEHEIGHT)) (WINDOWPROP TITLEWINDOW 'MAXSIZE (CONS MAX.SMALLP TITLEHEIGHT)) (SHAPEW TITLEWINDOW (CREATEREGION DWLEFT [ADD1 (fetch (REGION TOP) (WINDOWPROP DISPLAYWINDOW 'REGION] TOTALWIDTH TITLEHEIGHT)) (ATTACHWINDOW TITLEWINDOW DISPLAYWINDOW 'TOP) (RETURN DISPLAYWINDOW]) (ONEDINSPECT.REPAINTFN [LAMBDA (WINDOW WINDOWREGION) (* ; "Edited 19-Apr-90 10:41 by mitani") (if (NULL WINDOWREGION) then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW))) (PROG ((TOP (fetch (REGION TOP) of WINDOWREGION)) (BOTTOM (fetch (REGION BOTTOM) of WINDOWREGION)) (FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (DATUM (WINDOWPROP WINDOW 'DATUM)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) STARTPROP LASTPROP STARTVERTMARKS) (for PROP on ROWPROPS as MARK on VERTMARKS until (ILESSP (CAR MARK) TOP) finally (SETQ STARTPROP PROP) (SETQ STARTVERTMARKS MARK)) (for PROP on STARTPROP as MARK in STARTVERTMARKS until (ILESSP MARK BOTTOM) finally (SETQ LASTPROP PROP)) [if STARTPROP then (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (bind [DESCENT _ (SUB1 (FONTPROP WINDOW 'DESCENT] for PROP on STARTPROP as VMARK in STARTVERTMARKS repeatuntil (EQ PROP LASTPROP) do (ONEDINSPECT.PRINTELEMENT (APPLY* FETCHFN DATUM (CAR PROP)) VMARK DESCENT WINDOW] (INSPECT.INVERTSELECTION WINDOW]) (ONEDINSPECT.PRINTELEMENT [LAMBDA (ELT BOTTOM SUB1DESCENT WINDOW) (* ; "Edited 19-Apr-90 10:42 by mitani") (MOVETO 0 (IPLUS BOTTOM SUB1DESCENT) WINDOW) (PRIN2 ELT WINDOW]) (ONEDINSPECT.RESHAPEFN [LAMBDA (WINDOW) (* jop%: " 6-Oct-85 18:34") (CLEARW WINDOW) (PROG [(SELECTION (WINDOWPROP WINDOW 'SELECTION] (ONEDINSPECT.MAKEREGIONS WINDOW) (ONEDINSPECT.ADJUSTSELECTION WINDOW) (ONEDINSPECT.REPAINTFN WINDOW]) (ONEDINSPECT.MAKEREGIONS [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 11:01 by jop") (* ;; "Sets up windowprops and activeregions") (PROG ((ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (VALUEWIDTH (WINDOWPROP WINDOW 'VALUEWIDTH)) (VALUESPACE (WINDOWPROP WINDOW 'VALUESPACE)) (WINDOWHEIGHT (WINDOWPROP WINDOW 'HEIGHT)) (LF (DSPLINEFEED NIL WINDOW)) VERTMARKS) (if (NULL VALUEWIDTH) then (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (SETQ VALUEWIDTH (ONEDINSPECT.VALUEWIDTH (WINDOWPROP WINDOW 'DATUM) ROWPROPS (WINDOWPROP WINDOW 'FETCHFN) WINDOW)) (WINDOWPROP WINDOW 'VALUEWIDTH VALUEWIDTH))) (* ; "VERTMARKS mark endpoints") (SETQ VERTMARKS (for I from 1 to (LENGTH ROWPROPS) as MARK from (IPLUS WINDOWHEIGHT LF) by LF collect MARK)) (WINDOWPROP WINDOW 'VERTMARKS VERTMARKS) [WINDOWPROP WINDOW 'EXTENT (CREATEREGION 0 (CAR (LAST VERTMARKS)) (IPLUS VALUEWIDTH (STRINGWIDTH VALUESPACE WINDOW)) (DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS] (WINDOWPROP (WINDOWPROP WINDOW 'RIGHTWINDOW) 'EXTENT (CREATEREGION 0 (CAR (LAST VERTMARKS)) (WINDOWPROP (WINDOWPROP WINDOW 'RIGHTWINDOW) 'WIDTH) (DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS]) (ONEDINSPECT.BUTTONEVENTFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 18:03 by jop") (TOTOPW WINDOW) (LET [(SELECTION (WINDOWPROP WINDOW 'SELECTION] (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (if (MOUSESTATE LEFT) then (WINDOWPROP WINDOW 'SELECTION (ONED.TRACKCURSOR WINDOW SELECTION (WINDOWPROP WINDOW 'ROWPROPS) (WINDOWPROP WINDOW 'VERTMARKS) 0 NIL (FONTPROP WINDOW 'HEIGHT) [FUNCTION (LAMBDA (P W) (CL:FUNCALL (WINDOWPROP W 'FETCHFN) (WINDOWPROP W 'DATUM) P] (FUNCTION INSPECT.INVERTREGION))) else (* ; "MOUSESTATE MIDDLE") (if SELECTION then (LET [(SELECTEDPROP (CAR (fetch (ONED.SELECTION PROP) of SELECTION))) (DATUM (WINDOWPROP WINDOW 'DATUM] (CL:FUNCALL (WINDOWPROP WINDOW 'VALUECOMMANDFN) (CL:FUNCALL (WINDOWPROP WINDOW 'FETCHFN) DATUM SELECTEDPROP) SELECTEDPROP DATUM WINDOW]) (ONEDINSPECT.COPYBUTTONFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 18:09 by jop") (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (TOTOPW WINDOW) (bind SELECTION while (.COPYKEYDOWNP.) do (BLOCK) (SETQ SELECTION (ONED.TRACKCURSOR WINDOW SELECTION (WINDOWPROP WINDOW 'ROWPROPS) (WINDOWPROP WINDOW 'VERTMARKS) 0 NIL 2 [FUNCTION (LAMBDA (P W) (CL:FUNCALL (WINDOWPROP W 'FETCHFN) (WINDOWPROP W 'DATUM) P] (FUNCTION INSPECT.FLIPSELECTION))) finally (if SELECTION then (INSPECT.FLIPSELECTION (fetch (ONED.SELECTION ELTLEFT) of SELECTION) (fetch (ONED.SELECTION ELTBOTTOM) of SELECTION) (fetch (ONED.SELECTION ELTWIDTH) of SELECTION) 2 WINDOW) (BKSYSBUF.GENERAL (CL:FUNCALL (WINDOWPROP WINDOW 'FETCHFN) (WINDOWPROP WINDOW 'DATUM) (CAR (fetch (ONED.SELECTION PROP) of SELECTION]) (ONEDINSPECT.SCROLLFN [LAMBDA (WINDOW DX DY FLG) (* ; "Edited 19-Feb-2021 12:09 by rmk:") (* jop%: " 1-Oct-85 22:41") (PROG [(RIGHTWINDOW (WINDOWPROP WINDOW 'RIGHTWINDOW] (if (OR (NOT (EQP 0 DY)) (FLOATP DY)) then (APPLY* (OR (WINDOWPROP RIGHTWINDOW 'SCROLLFN) (FUNCTION SCROLLBYREPAINTFN)) RIGHTWINDOW 0 DY FLG)) (SCROLLBYREPAINTFN WINDOW DX DY FLG]) (ONEDINSPECT.CLOSEFN [LAMBDA (WINDOW) (* jop%: " 4-Oct-85 17:52") (DETACHALLWINDOWS WINDOW) (WINDOWPROP WINDOW 'SELECTION NIL) (WINDOWPROP (WINDOWPROP WINDOW 'RIGHTWINDOW) 'SELECTION NIL]) (ONEDINSPECT.REDISPLAY [LAMBDA (WINDOW ELTPROPS) (* ; "Edited 8-Apr-87 17:00 by jop") (* ;; "ELTPROPS may be a single entries, a list, or NIL. If NIL than the whole inspector is refetched and redisplayed") (if (AND ELTPROPS (NLISTP ELTPROPS)) then (SETQ ELTPROPS (LIST ELTPROPS))) (PROG ((FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (DATUM (WINDOWPROP WINDOW 'DATUM)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (VALUEWIDTH (WINDOWPROP WINDOW 'VALUEWIDTH)) (SELECTION (WINDOWPROP WINDOW 'SELECTION)) ELTS ELTBOTTOMS) (SETQ ELTS (for PROP in ELTPROPS collect (APPLY* FETCHFN DATUM PROP))) [SETQ ELTBOTTOMS (for ELTPROP in ELTPROPS collect (for VMARK in VERTMARKS as PROP in ROWPROPS thereis (EQUAL PROP ELTPROP] (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (if (AND ELTS (for ELTWIDTH in (for ELT in ELTS collect (STRINGWIDTH ELT WINDOW T) ) never (IGREATERP ELTWIDTH VALUEWIDTH))) then (INSPECT.INVERTSELECTION WINDOW) (bind (FHEIGHT _ (FONTPROP WINDOW 'HEIGHT)) (FDESCENT _ (FONTPROP WINDOW 'DESCENT)) for ELT in ELTS as BOTTOM in ELTBOTTOMS do (BITBLT NIL NIL NIL WINDOW 0 BOTTOM VALUEWIDTH FHEIGHT 'TEXTURE 'REPLACE WHITESHADE) (ONEDINSPECT.PRINTELEMENT ELT BOTTOM FDESCENT WINDOW)) (ONEDINSPECT.ADJUSTSELECTION WINDOW) (INSPECT.INVERTSELECTION WINDOW) else (* ; "Recompute the whole picture") (WINDOWPROP WINDOW 'VALUEWIDTH NIL) (ONEDINSPECT.MAKEREGIONS WINDOW) (ONEDINSPECT.ADJUSTSELECTION WINDOW) (DSPRESET WINDOW) (ONEDINSPECT.REPAINTFN WINDOW) (DSPRESET (WINDOWPROP WINDOW 'RIGHTWINDOW)) (RIGHTW.REPAINTFN (WINDOWPROP WINDOW 'RIGHTWINDOW]) (ONEDINSPECT.REPLACE [LAMBDA (WINDOW PROP NEWVALUE) (* jop%: " 2-Oct-85 00:06") (PROG [(DATUM (WINDOWPROP WINDOW 'DATUM)) (STOREFN (WINDOWPROP WINDOW 'STOREFN] (APPLY* STOREFN NEWVALUE DATUM PROP) (ONEDINSPECT.REDISPLAY WINDOW PROP]) (ONEDINSPECT.SELECTITEM [LAMBDA (WINDOW PROP) (* ; "Edited 6-Apr-87 11:36 by jop") (if (WINDOWPROP WINDOW 'SELECTION) then (INSPECT.INVERTSELECTION WINDOW)) (if PROP then (PROG ((DATUM (WINDOWPROP WINDOW 'DATUM)) (FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (HORZMARKS (WINDOWPROP WINDOW 'HORZMARKS)) SELECTEDPROP SELECTEDELTBOTTOM SELECTEDELTWIDTH) (SETQ SELECTEDPROP (for PRP on ROWPROPS thereis (EQUAL (CAR PRP) PROP))) (SETQ SELECTEDELTBOTTOM (for VMARK in VERTMARKS as PRP on ROWPROPS thereis (EQ PRP SELECTEDPROP))) (SETQ SELECTEDELTWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (STRINGWIDTH (APPLY* FETCHFN DATUM PROP) WINDOW T))) (INSPECT.INVERTREGION 0 SELECTEDELTBOTTOM SELECTEDELTWIDTH (FONTPROP WINDOW 'HEIGHT) WINDOW) (WINDOWPROP WINDOW 'SELECTION (create ONED.SELECTION ELTWIDTH _ SELECTEDELTWIDTH ELTLEFT _ 0 ELTBOTTOM _ SELECTEDELTBOTTOM PROP _ SELECTEDPROP]) (ONEDINSPECT.SELECTPROP [LAMBDA (WINDOW PROP) (* ; "Edited 6-Apr-87 11:37 by jop") (PROG [(RIGHTWINDOW (WINDOWPROP WINDOW 'RIGHTWINDOW] (if (WINDOWPROP RIGHTWINDOW 'SELECTION) then (INSPECT.INVERTSELECTION RIGHTWINDOW)) (PROG ((ROWPROPSPACE (WINDOWPROP WINDOW 'ROWPROPSPACE)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) SELECTEDPROP SELECTEDELTBOTTOM SELECTEDELTLEFT SELECTEDELTWIDTH) (SETQ SELECTEDPROP (for PRP on ROWPROPS thereis (EQUAL (CAR PRP) PROP))) (SETQ SELECTEDELTBOTTOM (for VMARK in VERTMARKS as PRP on ROWPROPS thereis (EQ PRP SELECTEDPROP))) (SETQ SELECTEDELTWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (STRINGWIDTH (CAR SELECTEDPROP) WINDOW T))) (SETQ SELECTEDELTLEFT (STRINGWIDTH ROWPROPSPACE WINDOW)) (INSPECT.INVERTREGION SELECTEDELTLEFT SELECTEDELTBOTTOM SELECTEDELTWIDTH (FONTPROP WINDOW 'HEIGHT) RIGHTWINDOW) (WINDOWPROP RIGHTWINDOW 'SELECTION (create ONED.SELECTION ELTWIDTH _ SELECTEDELTWIDTH ELTLEFT _ SELECTEDELTLEFT ELTBOTTOM _ SELECTEDELTBOTTOM PROP _ SELECTEDPROP]) (ONEDINSPECT.ADJUSTSELECTION [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 11:34 by jop") (PROG [(SELECTION (WINDOWPROP WINDOW 'SELECTION] (if SELECTION then (PROG ((DATUM (WINDOWPROP WINDOW 'DATUM)) (FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (SELPROP (fetch (ONED.SELECTION PROP) of SELECTION))) (WINDOWPROP WINDOW 'SELECTION (create ONED.SELECTION ELTBOTTOM _ (for VMARK in VERTMARKS as PROP on ROWPROPS thereis (EQ PROP SELPROP)) ELTWIDTH _ (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (STRINGWIDTH (APPLY* FETCHFN DATUM (CAR SELPROP)) WINDOW T)) ELTLEFT _ 0 PROP _ SELPROP]) (ONEDINSPECT.PROPWIDTH [LAMBDA (PROPS FONT) (* ; "Edited 11-Aug-2020 11:04 by rmk:") (* ; "Edited 5-Apr-87 16:18 by jop") (* ;; "Computes the MIN fieldwidth for the COLUMNPROP column of SLICE") (* ;; "RMK: Added more SPACE: wasn't wide enough for large indexes") (for PROP in PROPS largest (STRINGWIDTH PROP FONT T) finally (RETURN (IPLUS (CHARWIDTH (CHARCODE SPACE) T) $$EXTREME]) (ONEDINSPECT.VALUEWIDTH [LAMBDA (DATUM PROPS FETCHFN FONT) (* ; "Edited 5-Apr-87 16:20 by jop") (* ;; "Computes the MIN fieldwidth for the COLUMNPROP column of SLICE") (for PROP in PROPS largest (STRINGWIDTH (APPLY* FETCHFN DATUM PROP) FONT T) finally (RETURN $$EXTREME]) (ONEDINSPECT.DEFAULT.TITLECOMMANDFN [LAMBDA (WINDOW) (* ; "Edited 20-Jul-90 20:47 by yabu") (if (MOUSESTATE MIDDLE) then (PROG [(TITLEMENU (CONSTANT (\CREATE.TWODINSPECTOR.TITLEMENU))) (* ; "Original was (create MENU ITEMS _ '((%"Refetch%" 'REFETCH %"Refetch the datum%") (%"IT _ Datum%" 'IT %"Bind IT to the inspected datum%"))).") (* ;  "Changed by yabu.fx, for SUNLOADUP without DWIM.") (DATUM (WINDOWPROP WINDOW 'DATUM] (SELECTQ (MENU TITLEMENU) (REFETCH (ONEDINSPECT.REDISPLAY WINDOW)) (IT (SETQ IT DATUM) (PROMPTPRINT "IT bound to " DATUM)) NIL]) (ONEDINSPECT.DEFAULT.VALUECOMMANDFN [LAMBDA (VALUE PROP DATUM WINDOW) (* ; "Edited 20-Jul-90 20:51 by yabu") (PROG ((SETMENU (CONSTANT (\CREATE.TWODINSPECTOR.SETMENU))) (* ; "Original was (create MENU ITEMS _ '((%"IT _ Selection%" 'IT %"Bind IT to the value of the selected entry%") (%"Set%" 'SET %"Set the selected entry%"))).") (* ;  "Changed by yabu.fx, for SUNLOADUP without DWIM.") (INSPECTMENU (CONSTANT (\CREATE.TWODINSPECTOR.INSPECTMENU))) (* ; "Original was (create MENU ITEMS _ '((%"Inspect%" 'INSPECT %"Inspect the value of the selected entry%") (%"IT _ Selection%" 'IT %"Bind IT to the value of the selected entry%") (%"Set%" 'SET %"Set the selected entry%"))).") (* ;  "Changed by yabu.fx, for SUNLOADUP without DWIM.") ) (SELECTQ (if (OR (NULL VALUE) (NUMBERP VALUE)) then (MENU SETMENU) else (MENU INSPECTMENU)) (INSPECT (INSPECT VALUE)) (IT (SETQ IT VALUE) (PROMPTPRINT "IT bound to " IT)) (SET (ONEDINSPECT.SETELT PROP WINDOW)) NIL]) (ONEDINSPECT.SETELT [LAMBDA (PROP WINDOW) (* ; "Edited 5-Apr-87 16:29 by jop") (PROG ((PRTWINDOW (GETPROMPTWINDOW WINDOW (if (ILESSP (fetch (REGION WIDTH) of (WINDOWREGION WINDOW)) (IPLUS (ITIMES 5 (STRINGWIDTH 'A WINDOW)) (STRINGWIDTH "? " WINDOW))) then 3 else 1))) (NEWVALUE (APPLY* (WINDOWPROP WINDOW 'FETCHFN) (WINDOWPROP WINDOW 'DATUM) PROP))) (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (RESETLST (RESETSAVE (TTYDISPLAYSTREAM PRTWINDOW)) (RESETSAVE (TTY.PROCESS (THIS.PROCESS))) (CLEARBUF T T) (PRINTOUT T "Eval> ") (SETQ NEWVALUE (CL:FUNCALL XCL:*EVAL-FUNCTION* (LISPXREAD T T))) (* ;  "clear tty buffer because it sometimes has stuff left.") (CLEARBUF T T))) (REMOVEPROMPTWINDOW WINDOW) (ONEDINSPECT.REPLACE WINDOW PROP NEWVALUE]) ) (* ;; "Twod-inspector") (DEFINEQ (TWODINSPECTW.CREATE [LAMBDA (DATUM ROWPROPS COLUMNPROPS FETCHFN STOREFN VALUECOMMANDFN ROWPROPCOMMANDFN COLUMNPROPCOMMANDFN TITLE TITLECOMMANDFN WHERE TOPRIGHT) (* ; "Edited 6-Apr-87 17:03 by jop") (* ;;  "If where is a window, it may be the result of a previous call, so try to reuse all windows") (PROG ((PROFILE (MAKE-INSPECTOR-PROFILE)) [FONT (OR INSPECTORFONT (DEFAULTFONT 'DISPLAY] [TITLEFONT (OR (DSPFONT NIL WindowTitleDisplayStream) '(HELVETICA 8 MRR] DISPLAYWINDOW TOPWINDOW RIGHTWINDOW CORNERWINDOW TITLEWINDOW GLEFT GBOTTOM GWIDTH GHEIGHT WINDOWGROUP) (if (LITATOM ROWPROPS) then (SETQ ROWPROPS (APPLY* ROWPROPS DATUM))) (if (LITATOM COLUMNPROPS) then (SETQ COLUMNPROPS (APPLY* COLUMNPROPS DATUM))) (WITH-INSPECTOR-ENV PROFILE (* ;  "DISPLAYWINDOW is the central and main window of the group") (SETQ DISPLAYWINDOW (GET-TWOD-DISPLAYW WHERE DATUM FETCHFN STOREFN VALUECOMMANDFN ROWPROPCOMMANDFN COLUMNPROPCOMMANDFN TITLECOMMANDFN ROWPROPS COLUMNPROPS PROFILE FONT)) (* ;  "TOPWINDOW simply records the COLUMNPROPS") (SETQ TOPWINDOW (GET-TOPW DISPLAYWINDOW FONT)) (* ;  "RIGHTWINDOW records the ROWPROPS") (SETQ RIGHTWINDOW (GET-RIGHTW DISPLAYWINDOW FONT)) (* ;  "CORNERWINDOW is just a place holder") (SETQ CORNERWINDOW (GET-CORNERW DISPLAYWINDOW FONT)) (* ;  "TITLEWINDOW will only hold a title") (SETQ TITLEWINDOW (GET-TITLEW DISPLAYWINDOW TITLE TITLEFONT DATUM)) (* ; "Put up the window group") [if (NOT (POSITIONP TOPRIGHT)) then (LET ((REGION (if (WINDOWP WHERE) then (WINDOWPROP WHERE 'REGION) elseif (REGIONP WHERE) then WHERE))) (if REGION then (SETQ GLEFT (fetch (REGION LEFT) of REGION)) (SETQ GBOTTOM (fetch (REGION BOTTOM) of REGION)) (SETQ GWIDTH (fetch (REGION WIDTH) of REGION)) (SETQ GHEIGHT (fetch (REGION HEIGHT) of REGION)) elseif (POSITIONP WHERE) then (SETQ GLEFT (fetch (POSITION XCOORD) of WHERE)) (SETQ GBOTTOM (fetch (POSITION YCOORD) of WHERE] (SETQ WINDOWGROUP (TWODINSPECT.ARRANGEWINDOWS DISPLAYWINDOW TOPWINDOW RIGHTWINDOW CORNERWINDOW TITLEWINDOW GLEFT GBOTTOM GWIDTH GHEIGHT TOPRIGHT)) (* ;; " Display the group") (TWODINSPECT.RESHAPEFN DISPLAYWINDOW) (TOPW.RESHAPEFN TOPWINDOW) (RIGHTW.RESHAPEFN RIGHTWINDOW) (TITLEW.REPAINTFN TITLEWINDOW) (* ;; "then establish reshapefns on the windows of the window group") (WINDOWPROP DISPLAYWINDOW 'RESHAPEFN (FUNCTION TWODINSPECT.RESHAPEFN)) (WINDOWPROP TOPWINDOW 'RESHAPEFN (FUNCTION TOPW.RESHAPEFN)) (WINDOWPROP RIGHTWINDOW 'RESHAPEFN (FUNCTION RIGHTW.RESHAPEFN)) (WINDOWPROP TITLEWINDOW 'RESHAPEFN (FUNCTION TITLEW.REPAINTFN))) (* ;; "finally return the group") (RETURN WINDOWGROUP]) (GET-TWOD-DISPLAYW [LAMBDA (WHERE DATUM FETCHFN STOREFN VALUECOMMANDFN ROWPROPCOMMANDFN COLUMNPROPCOMMANDFN TITLECOMMANDFN ROWPROPS COLUMNPROPS PROFILE FONT) (* ; "Edited 6-Apr-87 14:51 by jop") (LET [(DISPLAYWINDOW (if (WINDOWP WHERE) then WHERE else (CREATEW (CREATEREGION 0 0 100 100) NIL 2 T] (WINDOWPROP DISPLAYWINDOW 'REPAINTFN (FUNCTION TWODINSPECT.REPAINTFN)) (* ;  "Smash the reshapefn because we don't want to rely on shapew to repaint the windows") (WINDOWPROP DISPLAYWINDOW 'RESHAPEFN (FUNCTION CLEARW)) (WINDOWPROP DISPLAYWINDOW 'SCROLLFN (FUNCTION TWODINSPECT.SCROLLFN)) (WINDOWPROP DISPLAYWINDOW 'BUTTONEVENTFN (FUNCTION TWODINSPECT.BUTTONEVENTFN)) (WINDOWPROP DISPLAYWINDOW 'COPYBUTTONEVENTFN (FUNCTION TWODINSPECT.COPYBUTTONFN)) (WINDOWPROP DISPLAYWINDOW 'CLOSEFN (FUNCTION TWODINSPECT.CLOSEFN)) (DSPRIGHTMARGIN MAX.SMALLP DISPLAYWINDOW) (DSPFONT FONT DISPLAYWINDOW) (WINDOWPROP DISPLAYWINDOW 'DATUM DATUM) (WINDOWPROP DISPLAYWINDOW 'FETCHFN FETCHFN) (WINDOWPROP DISPLAYWINDOW 'STOREFN STOREFN) (WINDOWPROP DISPLAYWINDOW 'VALUECOMMANDFN (OR VALUECOMMANDFN (FUNCTION TWODINSPECT.DEFAULT.VALUECOMMANDFN ))) (WINDOWPROP DISPLAYWINDOW 'ROWPROPCOMMANDFN ROWPROPCOMMANDFN) (WINDOWPROP DISPLAYWINDOW 'COLUMNPROPCOMMANDFN COLUMNPROPCOMMANDFN) (WINDOWPROP DISPLAYWINDOW 'TITLECOMMANDFN (OR TITLECOMMANDFN (FUNCTION TWODINSPECT.DEFAULT.TITLECOMMANDFN ))) (WINDOWPROP DISPLAYWINDOW 'ROWPROPS ROWPROPS) (WINDOWPROP DISPLAYWINDOW 'ROWPROPWIDTH (TWODINSPECT.ROWPROPWIDTH ROWPROPS FONT)) (WINDOWPROP DISPLAYWINDOW 'ROWPROPSPACE " ") (WINDOWPROP DISPLAYWINDOW 'COLUMNPROPS COLUMNPROPS) (WINDOWPROP DISPLAYWINDOW 'COLUMNWIDTHS (TWODINSPECT.COLUMNWIDTHS DATUM ROWPROPS COLUMNPROPS FETCHFN FONT)) (WINDOWPROP DISPLAYWINDOW 'COLUMNPROPSPACE " ") (WINDOWPROP DISPLAYWINDOW 'PROFILE PROFILE) DISPLAYWINDOW]) (GET-CORNERW [LAMBDA (DISPLAYWINDOW FONT) (* ; "Edited 6-Apr-87 14:52 by jop") (LET [(CORNERWINDOW (OR (WINDOWPROP DISPLAYWINDOW 'CORNERWINDOW) (CREATEW (CREATEREGION 0 0 100 100) NIL (WINDOWPROP DISPLAYWINDOW 'BORDER) T] (DSPFONT FONT CORNERWINDOW) (WINDOWPROP CORNERWINDOW 'REPAINTFN (FUNCTION CLEARW)) (WINDOWPROP CORNERWINDOW 'RESHAPEFN (FUNCTION CLEARW)) (WINDOWPROP CORNERWINDOW 'BUTTONEVENTFN NIL) (WINDOWPROP DISPLAYWINDOW 'CORNERWINDOW CORNERWINDOW) CORNERWINDOW]) (TWODINSPECT.ARRANGEWINDOWS [LAMBDA (DISPLAYWINDOW TOPWINDOW RIGHTWINDOW CORNERWINDOW TITLEWINDOW TOTALLEFT TOTALBOTTOM TOTALWIDTH TOTALHEIGHT TOPRIGHT) (* ; "Edited 19-Feb-2021 14:29 by rmk:") (* ; "Edited 6-Apr-87 15:10 by jop") (* ;; "REGION should be the total available area") (PROG ((ROWPROPS (WINDOWPROP DISPLAYWINDOW 'ROWPROPS)) (COLUMNPROPS (WINDOWPROP DISPLAYWINDOW 'COLUMNPROPS)) (ROWPROPSPACE (WINDOWPROP DISPLAYWINDOW 'ROWPROPSPACE)) (COLUMNWIDTHS (WINDOWPROP DISPLAYWINDOW 'COLUMNWIDTHS)) (COLUMNPROPSPACE (WINDOWPROP DISPLAYWINDOW 'COLUMNPROPSPACE)) TOTALRIGHT TOTALTOP DWHEIGHT DWWIDTH TITLEHEIGHT TWHEIGHT RWWIDTH DWLEFT DWBOTTOM ROWPROPWIDTH) [SETQ TITLEHEIGHT (HEIGHTIFWINDOW (FONTPROP TITLEWINDOW 'HEIGHT) NIL (WINDOWPROP TITLEWINDOW 'BORDER] (SETQ ROWPROPWIDTH (TWODINSPECT.ROWPROPWIDTH ROWPROPS RIGHTWINDOW)) [SETQ TWHEIGHT (HEIGHTIFWINDOW (FONTPROP TOPWINDOW 'HEIGHT) NIL (WINDOWPROP TOPWINDOW 'BORDER] [SETQ RWWIDTH (WIDTHIFWINDOW (IPLUS (STRINGWIDTH ROWPROPSPACE RIGHTWINDOW) ROWPROPWIDTH) (WINDOWPROP RIGHTWINDOW 'BORDER] [if (NULL TOTALHEIGHT) then [SETQ DWHEIGHT (IMIN 500 (HEIGHTIFWINDOW (ITIMES (FONTPROP DISPLAYWINDOW 'HEIGHT) (LENGTH ROWPROPS)) NIL (WINDOWPROP DISPLAYWINDOW 'BORDER] (SETQ TOTALHEIGHT (IPLUS TITLEHEIGHT TWHEIGHT DWHEIGHT)) else (SETQ DWHEIGHT (IDIFFERENCE TOTALHEIGHT (IPLUS TWHEIGHT TITLEHEIGHT] (if (NULL TOTALWIDTH) then [SETQ DWWIDTH (IMIN 400 (WIDTHIFWINDOW (TWODINSPECT.TOTALWIDTH COLUMNWIDTHS COLUMNPROPSPACE (DSPFONT DISPLAYWINDOW)) (WINDOWPROP DISPLAYWINDOW 'BORDER] (SETQ TOTALWIDTH (IPLUS RWWIDTH DWWIDTH)) else (SETQ DWWIDTH (IDIFFERENCE TOTALWIDTH RWWIDTH))) [if (POSITIONP TOPRIGHT) then (SETQ TOTALRIGHT (fetch (POSITION XCOORD) of TOPRIGHT)) (SETQ TOTALTOP (fetch (POSITION YCOORD) of TOPRIGHT)) elseif (AND TOTALLEFT TOTALBOTTOM) then (SETQ TOTALRIGHT (IPLUS TOTALLEFT (SUB1 TOTALWIDTH))) (SETQ TOTALTOP (IPLUS TOTALBOTTOM (SUB1 TOTALHEIGHT))) else (LET ((REGION (GETBOXREGION TOTALWIDTH TOTALHEIGHT NIL NIL NIL "Position Inspector window"))) (SETQ TOTALTOP (fetch (REGION TOP) of REGION)) (SETQ TOTALRIGHT (fetch (REGION RIGHT) of REGION] [SETQ DWLEFT (DIFFERENCE TOTALRIGHT (SUB1 (PLUS DWWIDTH RWWIDTH] (if (ILESSP DWLEFT 0) then (SETQ DWLEFT 0) (SETQ DWWIDTH (DIFFERENCE (ADD1 TOTALRIGHT) RWWIDTH))) [SETQ DWBOTTOM (DIFFERENCE TOTALTOP (SUB1 (PLUS DWHEIGHT TWHEIGHT TITLEHEIGHT] [if (LESSP DWBOTTOM 0) then (SETQ DWBOTTOM 0) (SETQ DWHEIGHT (DIFFERENCE (ADD1 TOTALTOP) (PLUS TWHEIGHT TITLEHEIGHT] (* ;; "put up the window group") (WINDOWPROP DISPLAYWINDOW 'MINSIZE (CONS 0 0)) (SHAPEW DISPLAYWINDOW (CREATEREGION DWLEFT DWBOTTOM DWWIDTH DWHEIGHT)) (* ;  "Need to set the Minsize BEFORE reshaping else we catch the default minsize") (WINDOWPROP TOPWINDOW 'MINSIZE (CONS 0 TWHEIGHT)) (WINDOWPROP TOPWINDOW 'MAXSIZE (CONS MAX.SMALLP TWHEIGHT)) (SHAPEW TOPWINDOW (CREATEREGION DWLEFT [ADD1 (fetch (REGION TOP) of (WINDOWPROP DISPLAYWINDOW 'REGION] DWWIDTH TWHEIGHT)) (ATTACHWINDOW TOPWINDOW DISPLAYWINDOW 'TOP) (WINDOWPROP RIGHTWINDOW 'MINSIZE (CONS RWWIDTH 0)) (WINDOWPROP RIGHTWINDOW 'MAXSIZE (CONS RWWIDTH MAX.SMALLP)) (WINDOWPROP RIGHTWINDOW 'ROWPROPWIDTH ROWPROPWIDTH) (SHAPEW RIGHTWINDOW (CREATEREGION [ADD1 (fetch (REGION RIGHT) of (WINDOWPROP DISPLAYWINDOW 'REGION] DWBOTTOM RWWIDTH DWHEIGHT)) (WINDOWPROP CORNERWINDOW 'MINSIZE (CONS RWWIDTH TWHEIGHT)) (WINDOWPROP CORNERWINDOW 'MAXSIZE (CONS RWWIDTH TWHEIGHT)) (SHAPEW CORNERWINDOW (CREATEREGION [ADD1 (fetch (REGION RIGHT) of (WINDOWPROP DISPLAYWINDOW 'REGION] [ADD1 (fetch (REGION TOP) of (WINDOWPROP DISPLAYWINDOW 'REGION] RWWIDTH TWHEIGHT)) (ATTACHWINDOW CORNERWINDOW RIGHTWINDOW 'TOP) (ATTACHWINDOW RIGHTWINDOW DISPLAYWINDOW 'RIGHT) (WINDOWPROP TITLEWINDOW 'MINSIZE (CONS 0 TITLEHEIGHT)) (WINDOWPROP TITLEWINDOW 'MAXSIZE (CONS MAX.SMALLP TITLEHEIGHT)) (SHAPEW TITLEWINDOW (CREATEREGION DWLEFT [ADD1 (fetch (REGION TOP) (WINDOWPROP TOPWINDOW 'REGION] TOTALWIDTH TITLEHEIGHT)) (ATTACHWINDOW TITLEWINDOW DISPLAYWINDOW 'TOP) (RETURN DISPLAYWINDOW]) (TWODINSPECT.REPAINTFN [LAMBDA (WINDOW WINDOWREGION) (* ; "Edited 6-Apr-87 11:12 by jop") (if (NULL WINDOWREGION) then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW))) (PROG ((TOP (fetch (REGION TOP) of WINDOWREGION)) (BOTTOM (fetch (REGION BOTTOM) of WINDOWREGION)) (LEFT (fetch (REGION LEFT) of WINDOWREGION)) (RIGHT (fetch (REGION RIGHT) of WINDOWREGION)) (FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (DATUM (WINDOWPROP WINDOW 'DATUM)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (HORZMARKS (WINDOWPROP WINDOW 'HORZMARKS)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (COLUMNPROPS (WINDOWPROP WINDOW 'COLUMNPROPS)) STARTROWPROPS LASTROWPROP STARTCOLUMNPROPS LASTCOLUMNPROP STARTVERTMARKS STARTHORZMARKS) (for ROWPROP on ROWPROPS as MARK on VERTMARKS until (ILESSP (CAR MARK) TOP) finally (SETQ STARTROWPROPS ROWPROP) (SETQ STARTVERTMARKS MARK)) (for ROWPROP on STARTROWPROPS as MARK in STARTVERTMARKS until (ILESSP MARK BOTTOM) finally (SETQ LASTROWPROP ROWPROP)) (for COLUMNPROP on COLUMNPROPS as MARK on HORZMARKS until (IGREATERP (CAR MARK) LEFT) finally (SETQ STARTCOLUMNPROPS COLUMNPROP) (SETQ STARTHORZMARKS MARK)) (for COLUMNPROP on STARTCOLUMNPROPS as MARK in STARTHORZMARKS until (IGREATERP MARK RIGHT) finally (SETQ LASTCOLUMNPROP COLUMNPROP)) [WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (if (AND STARTROWPROPS STARTCOLUMNPROPS) then (for ROWPROP on STARTROWPROPS as VMARK in STARTVERTMARKS repeatuntil (EQ ROWPROP LASTROWPROP) do (bind (FDESCENT _ (FONTPROP WINDOW 'DESCENT)) for COLUMNPROP on STARTCOLUMNPROPS as HMARK in STARTHORZMARKS repeatuntil (EQ COLUMNPROP LASTCOLUMNPROP) do (TWODINSPECT.PRINTELEMENT (APPLY* FETCHFN DATUM (CAR ROWPROP) (CAR COLUMNPROP )) HMARK VMARK FDESCENT WINDOW] (INSPECT.INVERTSELECTION WINDOW]) (TWODINSPECT.PRINTELEMENT [LAMBDA (ELT RIGHT BOTTOM FDESCENT WINDOW) (* ; "Edited 5-Apr-87 15:17 by jop") (MOVETO (ADD1 (DIFFERENCE RIGHT (STRINGWIDTH ELT WINDOW T))) (IPLUS BOTTOM FDESCENT) WINDOW) (PRIN2 ELT WINDOW]) (TWODINSPECT.RESHAPEFN [LAMBDA (WINDOW) (* jop%: " 6-Oct-85 18:33") (CLEARW WINDOW) (PROG [(SELECTION (WINDOWPROP WINDOW 'SELECTION] (TWODINSPECT.MAKEREGIONS WINDOW) (TWODINSPECT.ADJUSTSELECTION WINDOW) (TWODINSPECT.REPAINTFN WINDOW]) (TWODINSPECT.MAKEREGIONS [LAMBDA (WINDOW) (* ; "Edited 5-Apr-87 16:31 by jop") (* ;; "Sets up windowprops and activeregions") (PROG ((ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (COLUMNPROPS (WINDOWPROP WINDOW 'COLUMNPROPS)) (COLUMNWIDTHS (WINDOWPROP WINDOW 'COLUMNWIDTHS)) (SPACE (STRINGWIDTH (WINDOWPROP WINDOW 'COLUMNPROPSPACE) WINDOW)) (WINDOWHEIGHT (WINDOWPROP WINDOW 'HEIGHT)) (LF (DSPLINEFEED NIL WINDOW)) VERTMARKS HORZMARKS) (if (NULL COLUMNWIDTHS) then (SETQ COLUMNWIDTHS (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (TWODINSPECT.COLUMNWIDTHS (WINDOWPROP WINDOW 'DATUM) ROWPROPS COLUMNPROPS (WINDOWPROP WINDOW 'FETCHFN) WINDOW))) (WINDOWPROP WINDOW 'COLUMNWIDTHS COLUMNWIDTHS)) (* ;  "VERTMARKS and HORZMARKS mark endpoints") (SETQ VERTMARKS (for I from 1 to (LENGTH ROWPROPS) as MARK from (IPLUS WINDOWHEIGHT LF) by LF collect MARK)) [SETQ HORZMARKS (bind (MARK _ -1) for I from 1 to (LENGTH COLUMNPROPS) as COLUMNWIDTH in COLUMNWIDTHS collect (SETQ MARK (IPLUS MARK SPACE COLUMNWIDTH] (WINDOWPROP WINDOW 'VERTMARKS VERTMARKS) (WINDOWPROP WINDOW 'HORZMARKS HORZMARKS) [WINDOWPROP WINDOW 'EXTENT (CREATEREGION 0 (CAR (LAST VERTMARKS)) (CAR (LAST HORZMARKS)) (DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS] [WINDOWPROP (WINDOWPROP WINDOW 'TOPWINDOW) 'EXTENT (CREATEREGION 0 0 (CAR (LAST HORZMARKS)) (WINDOWPROP (WINDOWPROP WINDOW 'TOPWINDOW) 'HEIGHT] (WINDOWPROP (WINDOWPROP WINDOW 'RIGHTWINDOW) 'EXTENT (CREATEREGION 0 (CAR (LAST VERTMARKS)) (WINDOWPROP (WINDOWPROP WINDOW 'RIGHTWINDOW) 'WIDTH) (DIFFERENCE WINDOWHEIGHT (CAR (LAST VERTMARKS]) (TWODINSPECT.BUTTONEVENTFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 18:28 by jop") (TOTOPW WINDOW) (PROG [(SELECTION (WINDOWPROP WINDOW 'SELECTION] (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (if (MOUSESTATE LEFT) then (WINDOWPROP WINDOW 'SELECTION (TWOD.TRACKCURSOR WINDOW SELECTION (WINDOWPROP WINDOW 'ROWPROPS) (WINDOWPROP WINDOW 'VERTMARKS) (WINDOWPROP WINDOW 'COLUMNPROPS) (WINDOWPROP WINDOW 'HORZMARKS) (FONTPROP WINDOW 'HEIGHT) [FUNCTION (LAMBDA (RP CP W) (CL:FUNCALL (WINDOWPROP W 'FETCHFN) (WINDOWPROP W 'DATUM) RP CP] (FUNCTION INSPECT.INVERTREGION))) else (* ; "MOUSESTATE MIDDLE") (if SELECTION then (LET [(DATUM (WINDOWPROP WINDOW 'DATUM)) (SELECTEDROWPROP (CAR (fetch (TWOD.SELECTION ROWPROP) of SELECTION))) (SELECTEDCOLUMNPROP (CAR (fetch (TWOD.SELECTION COLUMNPROP) of SELECTION] (CL:FUNCALL (WINDOWPROP WINDOW 'VALUECOMMANDFN) (CL:FUNCALL (WINDOWPROP WINDOW 'FETCHFN) DATUM SELECTEDROWPROP SELECTEDCOLUMNPROP) SELECTEDROWPROP SELECTEDCOLUMNPROP DATUM WINDOW]) (TWODINSPECT.COPYBUTTONFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 18:32 by jop") (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (TOTOPW WINDOW) (bind SELECTION while (.COPYKEYDOWNP.) do (BLOCK) (SETQ SELECTION (TWOD.TRACKCURSOR WINDOW SELECTION (WINDOWPROP WINDOW 'ROWPROPS) (WINDOWPROP WINDOW 'VERTMARKS) (WINDOWPROP WINDOW 'COLUMNPROPS) (WINDOWPROP WINDOW 'HORZMARKS) 2 [FUNCTION (LAMBDA (RP CP W) (CL:FUNCALL (WINDOWPROP W 'FETCHFN) (WINDOWPROP W 'DATUM) RP CP] (FUNCTION INSPECT.FLIPSELECTION))) finally (if SELECTION then (INSPECT.FLIPSELECTION (fetch (TWOD.SELECTION ELTLEFT) of SELECTION) (fetch (TWOD.SELECTION ELTBOTTOM) of SELECTION) (fetch (TWOD.SELECTION ELTWIDTH) of SELECTION) 2 WINDOW) (BKSYSBUF.GENERAL (CL:FUNCALL (WINDOWPROP WINDOW 'FETCHFN) (WINDOWPROP WINDOW 'DATUM) (CAR (fetch (TWOD.SELECTION ROWPROP) of SELECTION)) (CAR (fetch (TWOD.SELECTION COLUMNPROP) of SELECTION]) (TWODINSPECT.DOWINDOWCOMFN [LAMBDA (TWODWINDOW) (* ; "Edited 6-Apr-87 12:05 by jop") (* ;; "Pass on the usual comms, except for SHAPEW") (PROG (COM) (SETQ COM (MENU WindowMenu)) (SELECTQ COM (NIL NIL) (SHAPEW [SHAPEW TWODWINDOW (GETREGION NIL NIL NIL (FUNCTION ICMLARRAY.GETREGIONFN) (CONS TWODWINDOW 'CLOSED]) ((MOVEW CLOSEW SHRINKW BURYW) (APPLY* COM (MAINWINDOW TWODWINDOW))) (APPLY* COM TWODWINDOW]) (TWODINSPECT.SCROLLFN [LAMBDA (WINDOW DX DY FLG) (* ; "Edited 19-Feb-2021 13:38 by rmk:") (* jop%: "18-Jul-85 13:50") (PROG [(TOPWINDOW (WINDOWPROP WINDOW 'TOPWINDOW)) (RIGHTWINDOW (WINDOWPROP WINDOW 'RIGHTWINDOW] (if (OR (NOT (EQP 0 DX)) (FLOATP DX)) then (APPLY* (WINDOWPROP TOPWINDOW 'SCROLLFN) TOPWINDOW DX 0 FLG)) (if (OR (NOT (EQP 0 DY)) (FLOATP DY)) then (APPLY* (OR (WINDOWPROP RIGHTWINDOW 'SCROLLFN) (FUNCTION SCROLLBYREPAINTFN)) RIGHTWINDOW 0 DY FLG)) (SCROLLBYREPAINTFN WINDOW DX DY FLG]) (TWODINSPECT.CLOSEFN [LAMBDA (WINDOW) (* jop%: " 4-Oct-85 17:51") (DETACHALLWINDOWS (WINDOWPROP WINDOW 'RIGHTWINDOW)) (DETACHALLWINDOWS WINDOW) (WINDOWPROP WINDOW 'SELECTION NIL) (WINDOWPROP (WINDOWPROP WINDOW 'RIGHTWINDOW) 'SELECTION NIL) (WINDOWPROP (WINDOWPROP WINDOW 'TOPWINDOW) 'SELECTION NIL]) (TWODINSPECT.REDISPLAY [LAMBDA (WINDOW ELTROWPROPS ELTCOLUMNPROPS) (* ; "Edited 8-Apr-87 17:00 by jop") (* ;; "ELTROWPROPS and ELTCOLUMNPROPS may be single entries, lists, or NIL. If NIL than the whole inspector is refetched and redisplayed") (if (AND ELTROWPROPS (NLISTP ELTROWPROPS)) then (SETQ ELTROWPROPS (LIST ELTROWPROPS))) (if (AND ELTCOLUMNPROPS (NLISTP ELTCOLUMNPROPS)) then (SETQ ELTCOLUMNPROPS (LIST ELTCOLUMNPROPS))) (PROG ((FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (DATUM (WINDOWPROP WINDOW 'DATUM)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (HORZMARKS (WINDOWPROP WINDOW 'HORZMARKS)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (COLUMNPROPS (WINDOWPROP WINDOW 'COLUMNPROPS)) (COLUMNWIDTHS (WINDOWPROP WINDOW 'COLUMNWIDTHS)) (SELECTION (WINDOWPROP WINDOW 'SELECTION)) ELTCOLUMNWIDTHS ELTS ELTRIGHTS ELTBOTTOMS) [SETQ ELTS (for RPROP in ELTROWPROPS join (for CPROP in ELTCOLUMNPROPS collect (APPLY* FETCHFN DATUM RPROP CPROP] [SETQ ELTCOLUMNWIDTHS (for RPROP in ELTROWPROPS join (for CPROP in ELTCOLUMNPROPS collect (for COLWIDTH in COLUMNWIDTHS as COLPROP in COLUMNPROPS thereis (EQUAL COLPROP CPROP] [SETQ ELTRIGHTS (for RPROP in ELTROWPROPS join (for CPROP in ELTCOLUMNPROPS collect (for HMARK in HORZMARKS as COLPROP in COLUMNPROPS thereis (EQUAL COLPROP CPROP] [SETQ ELTBOTTOMS (for RPROP in ELTROWPROPS join (for CPROP in ELTCOLUMNPROPS collect (for VMARK in VERTMARKS as ROWPROP in ROWPROPS thereis (EQUAL ROWPROP RPROP] (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (if (AND ELTS (for ELT in ELTS as COLUMNWIDTH in ELTCOLUMNWIDTHS never (IGREATERP (STRINGWIDTH ELT WINDOW T) COLUMNWIDTH))) then (INSPECT.INVERTSELECTION WINDOW) (bind (FHEIGHT _ (FONTPROP WINDOW 'HEIGHT)) (FDESCENT _ (FONTPROP WINDOW 'DESCENT)) for ELT in ELTS as RIGHT in ELTRIGHTS as BOTTOM in ELTBOTTOMS as COLUMNWIDTH in ELTCOLUMNWIDTHS do (BITBLT NIL NIL NIL WINDOW (IDIFFERENCE (ADD1 RIGHT) COLUMNWIDTH) BOTTOM COLUMNWIDTH FHEIGHT 'TEXTURE 'REPLACE WHITESHADE) (TWODINSPECT.PRINTELEMENT ELT RIGHT BOTTOM FDESCENT WINDOW)) (TWODINSPECT.ADJUSTSELECTION WINDOW) (INSPECT.INVERTSELECTION WINDOW) else (* ; "Recompute the whole picture") (WINDOWPROP WINDOW 'COLUMNWIDTHS NIL) (TWODINSPECT.MAKEREGIONS WINDOW) (TWODINSPECT.ADJUSTSELECTION WINDOW) (DSPRESET WINDOW) (TWODINSPECT.REPAINTFN WINDOW) (DSPRESET (WINDOWPROP WINDOW 'TOPWINDOW)) (TOPW.REPAINTFN (WINDOWPROP WINDOW 'TOPWINDOW)) (DSPRESET (WINDOWPROP WINDOW 'RIGHTWINDOW)) (RIGHTW.REPAINTFN (WINDOWPROP WINDOW 'RIGHTWINDOW]) (TWODINSPECT.REPLACE [LAMBDA (WINDOW ROWPROP COLUMNPROP NEWVALUE) (* jop%: "30-Sep-85 20:44") (PROG [(DATUM (WINDOWPROP WINDOW 'DATUM)) (STOREFN (WINDOWPROP WINDOW 'STOREFN] (APPLY* STOREFN NEWVALUE DATUM ROWPROP COLUMNPROP) (TWODINSPECT.REDISPLAY WINDOW ROWPROP COLUMNPROP]) (TWODINSPECT.SELECTITEM [LAMBDA (WINDOW ROWPROP COLUMNPROP) (* ; "Edited 6-Apr-87 12:05 by jop") (if (WINDOWPROP WINDOW 'SELECTION) then (INSPECT.INVERTSELECTION WINDOW)) (if (AND ROWPROP COLUMNPROP) then (PROG ((DATUM (WINDOWPROP WINDOW 'DATUM)) (FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (COLUMNPROPS (WINDOWPROP WINDOW 'COLUMNPROPS)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (HORZMARKS (WINDOWPROP WINDOW 'HORZMARKS)) SELECTEDROWPROP SELECTEDCOLUMNPROP SELECTEDELTBOTTOM SELECTEDELTLEFT SELECTEDELTWIDTH) (SETQ SELECTEDROWPROP (for RPROP on ROWPROPS thereis (EQUAL (CAR RPROP) ROWPROP))) (SETQ SELECTEDCOLUMNPROP (for CPROP on COLUMNPROPS thereis (EQUAL (CAR CPROP) COLUMNPROP))) (SETQ SELECTEDELTBOTTOM (for VMARK in VERTMARKS as RPROP on ROWPROPS thereis (EQ RPROP SELECTEDROWPROP))) (SETQ SELECTEDELTWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (STRINGWIDTH (APPLY* FETCHFN DATUM ROWPROP COLUMNPROP) WINDOW T))) (SETQ SELECTEDELTLEFT (IDIFFERENCE (ADD1 (for HMARK in HORZMARKS as CPROP on COLUMNPROPS thereis (EQ CPROP SELECTEDCOLUMNPROP))) SELECTEDELTWIDTH)) (INSPECT.INVERTREGION SELECTEDELTLEFT SELECTEDELTBOTTOM SELECTEDELTWIDTH (FONTPROP WINDOW 'HEIGHT) WINDOW) (WINDOWPROP WINDOW 'SELECTION (create TWOD.SELECTION ELTWIDTH _ SELECTEDELTWIDTH ELTLEFT _ SELECTEDELTLEFT ELTBOTTOM _ SELECTEDELTBOTTOM ROWPROP _ SELECTEDROWPROP COLUMNPROP _ SELECTEDCOLUMNPROP]) (TWODINSPECT.SELECTROWPROP [LAMBDA (WINDOW ROWPROP) (* ; "Edited 6-Apr-87 12:07 by jop") (PROG [(RIGHTWINDOW (WINDOWPROP WINDOW 'RIGHTWINDOW] (if (WINDOWPROP RIGHTWINDOW 'SELECTION) then (INSPECT.INVERTSELECTION RIGHTWINDOW)) (PROG ((ROWPROPSPACE (WINDOWPROP WINDOW 'ROWPROPSPACE)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) SELECTEDROWPROP SELECTEDELTBOTTOM SELECTEDELTLEFT SELECTEDELTWIDTH) (SETQ SELECTEDROWPROP (for RPROP on ROWPROPS thereis (EQUAL (CAR RPROP) ROWPROP))) (SETQ SELECTEDELTBOTTOM (for VMARK in VERTMARKS as RPROP on ROWPROPS thereis (EQ RPROP SELECTEDROWPROP))) (SETQ SELECTEDELTWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (STRINGWIDTH (CAR SELECTEDROWPROP) WINDOW T))) (SETQ SELECTEDELTLEFT (STRINGWIDTH ROWPROPSPACE WINDOW)) (INSPECT.INVERTREGION SELECTEDELTLEFT SELECTEDELTBOTTOM SELECTEDELTWIDTH (FONTPROP WINDOW 'HEIGHT) RIGHTWINDOW) (WINDOWPROP RIGHTWINDOW 'SELECTION (create ONED.SELECTION ELTWIDTH _ SELECTEDELTWIDTH ELTLEFT _ SELECTEDELTLEFT ELTBOTTOM _ SELECTEDELTBOTTOM PROP _ SELECTEDROWPROP]) (TWODINSPECT.SELECTCOLUMNPROP [LAMBDA (WINDOW COLUMNPROP) (* ; "Edited 6-Apr-87 12:08 by jop") (PROG [(TOPWINDOW (WINDOWPROP WINDOW 'TOPWINDOW] (if (WINDOWPROP TOPWINDOW 'SELECTION) then (INSPECT.INVERTSELECTION TOPWINDOW)) (PROG ((COLUMNPROPS (WINDOWPROP WINDOW 'COLUMNPROPS)) (HORZMARKS (WINDOWPROP WINDOW 'HORZMARKS)) SELECTEDCOLUMNPROP SELECTEDELTBOTTOM SELECTEDELTLEFT SELECTEDELTWIDTH) (SETQ SELECTEDCOLUMNPROP (for CPROP on COLUMNPROPS thereis (EQUAL (CAR CPROP) COLUMNPROP))) (SETQ SELECTEDELTBOTTOM 0) (SETQ SELECTEDELTWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (STRINGWIDTH (CAR SELECTEDCOLUMNPROP) WINDOW T))) (SETQ SELECTEDELTLEFT (IDIFFERENCE (ADD1 (for HMARK in HORZMARKS as CPROP on COLUMNPROPS thereis (EQ CPROP SELECTEDCOLUMNPROP) )) SELECTEDELTWIDTH)) (INSPECT.INVERTREGION SELECTEDELTLEFT SELECTEDELTBOTTOM SELECTEDELTWIDTH (FONTPROP WINDOW 'HEIGHT) TOPWINDOW) (WINDOWPROP TOPWINDOW 'SELECTION (create ONED.SELECTION ELTWIDTH _ SELECTEDELTWIDTH ELTLEFT _ SELECTEDELTLEFT ELTBOTTOM _ SELECTEDELTBOTTOM PROP _ SELECTEDCOLUMNPROP]) (TWODINSPECT.ADJUSTSELECTION [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 12:06 by jop") (PROG [(SELECTION (WINDOWPROP WINDOW 'SELECTION] (if SELECTION then (PROG ((DATUM (WINDOWPROP WINDOW 'DATUM)) (FETCHFN (WINDOWPROP WINDOW 'FETCHFN)) (ROWPROPS (WINDOWPROP WINDOW 'ROWPROPS)) (COLUMNPROPS (WINDOWPROP WINDOW 'COLUMNPROPS)) (VERTMARKS (WINDOWPROP WINDOW 'VERTMARKS)) (HORZMARKS (WINDOWPROP WINDOW 'HORZMARKS)) (SELROWPROP (fetch (TWOD.SELECTION ROWPROP) of SELECTION)) (SELCOLPROP (fetch (TWOD.SELECTION COLUMNPROP) of SELECTION)) SELBOTTOM SELWIDTH SELLEFT) (SETQ SELBOTTOM (for VMARK in VERTMARKS as ROWPROP on ROWPROPS thereis (EQ ROWPROP SELROWPROP))) (SETQ SELWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (STRINGWIDTH (APPLY* FETCHFN DATUM (CAR SELROWPROP ) (CAR SELCOLPROP)) WINDOW T))) (SETQ SELLEFT (IDIFFERENCE (ADD1 (for HMARK in HORZMARKS as COLPROP on COLUMNPROPS thereis (EQ COLPROP SELCOLPROP))) SELWIDTH)) (WINDOWPROP WINDOW 'SELECTION (create TWOD.SELECTION ELTBOTTOM _ SELBOTTOM ELTWIDTH _ SELWIDTH ELTLEFT _ SELLEFT ROWPROP _ SELROWPROP COLUMNPROP _ SELCOLPROP]) (TWODINSPECT.DEFAULT.TITLECOMMANDFN [LAMBDA (WINDOW) (* ; "Edited 20-Jul-90 20:54 by yabu") (if (MOUSESTATE MIDDLE) then (PROG [(TITLEMENU (CONSTANT (\CREATE.TWODINSPECTOR.TITLEMENU))) (* ; "Original was (create MENU ITEMS _ '((%"Refetch%" 'REFETCH %"Refetch the datum%") (%"IT _ Datum%" 'IT %"Bind IT to the inspected datum%"))).") (* ;  "Changed by yabu.fx, for SUNLOADUP without DWIM.") (DATUM (WINDOWPROP WINDOW 'DATUM] (SELECTQ (MENU TITLEMENU) (REFETCH (TWODINSPECT.REDISPLAY WINDOW)) (IT (SETQ IT DATUM) (PROMPTPRINT "IT bound to " DATUM)) NIL]) (TWODINSPECT.DEFAULT.VALUECOMMANDFN [LAMBDA (VALUE ROWPROP COLUMNPROP DATUM WINDOW) (* ; "Edited 20-Jul-90 21:03 by yabu") (PROG ((SETMENU (CONSTANT (\CREATE.TWODINSPECTOR.SETMENU))) (* ; "Original was (create MENU ITEMS _ '((%"IT _ Selection%" 'IT %"Bind IT to the value of the selected entry%") (%"Set%" 'SET %"Set the selected entry%"))).") (* ;  "Changed by yabu.fx, for SUNLOADUP without DWIM.") (INSPECTMENU (CONSTANT (\CREATE.TWODINSPECTOR.INSPECTMENU))) (* ; "Original was (create MENU ITEMS _ '((%"Inspect%" 'INSPECT %"Inspect the value of the selected entry%") (%"IT _ Selection%" 'IT %"Bind IT to the value of the selected entry%") (%"Set%" 'SET %"Set the selected entry%"))).") (* ;  " Changed by yabu.fx, for SUNLOADUP without DWIM.") ) (SELECTQ (if (OR (NULL VALUE) (NUMBERP VALUE)) then (MENU SETMENU) else (MENU INSPECTMENU)) (INSPECT (INSPECT VALUE)) (IT (SETQ IT VALUE) (PROMPTPRINT "IT bound to " IT)) (SET (TWODINSPECT.SETELT ROWPROP COLUMNPROP WINDOW)) NIL]) (TWODINSPECT.SETELT [LAMBDA (ROWPROP COLUMNPROP WINDOW) (* ; "Edited 5-Apr-87 16:41 by jop") (PROG ((PRTWINDOW (GETPROMPTWINDOW WINDOW)) (NEWVALUE (APPLY* (WINDOWPROP WINDOW 'FETCHFN) (WINDOWPROP WINDOW 'DATUM) ROWPROP COLUMNPROP))) (WITH-INSPECTOR-ENV (WINDOWPROP WINDOW 'PROFILE) (RESETLST (RESETSAVE (TTYDISPLAYSTREAM PRTWINDOW)) (RESETSAVE (TTY.PROCESS (THIS.PROCESS))) (CLEARBUF T T) (printout T "Eval> ") (SETQ NEWVALUE (CL:FUNCALL XCL:*EVAL-FUNCTION* (LISPXREAD T T))) (* ;  "clear tty buffer because it sometimes has stuff left.") (CLEARBUF T T))) (REMOVEPROMPTWINDOW WINDOW) (TWODINSPECT.REPLACE WINDOW ROWPROP COLUMNPROP NEWVALUE]) (TWODINSPECT.ROWPROPWIDTH [LAMBDA (ROWPROPS FONT) (* ; "Edited 5-Apr-87 16:33 by jop") (for ROWPROP in ROWPROPS largest (STRINGWIDTH ROWPROP FONT T) finally (RETURN $$EXTREME]) (TWODINSPECT.COLUMNWIDTHS [LAMBDA (DATUM ROWPROPS COLUMNPROPS FETCHFN FONT) (* ; "Edited 5-Apr-87 15:38 by jop") (* ;; "Computes the MIN fieldwidth for the jth column of SLICE") (for COLUMNPROP in COLUMNPROPS collect (TWODINSPECT.COLUMNWIDTH DATUM ROWPROPS COLUMNPROP FETCHFN FONT]) (TWODINSPECT.COLUMNWIDTH [LAMBDA (DATUM ROWPROPS COLUMNPROP FETCHFN FONT) (* ; "Edited 5-Apr-87 16:29 by jop") (* ;; "Computes the MIN fieldwidth for the COLUMNPROP column of SLICE") (IMAX (STRINGWIDTH COLUMNPROP FONT T) (for ROWPROP in ROWPROPS largest (STRINGWIDTH (APPLY* FETCHFN DATUM ROWPROP COLUMNPROP) FONT T) finally (RETURN $$EXTREME]) (TWODINSPECT.TOTALWIDTH [LAMBDA (COLUMNWIDTHS SPACE FONT) (* jop%: "25-Sep-85 13:21") (IPLUS (ITIMES (LENGTH COLUMNWIDTHS) (STRINGWIDTH SPACE FONT)) (for COLUMN in COLUMNWIDTHS sum COLUMN]) ) (* ;; "Right window fns") (DEFINEQ (GET-RIGHTW [LAMBDA (DISPLAYWINDOW FONT) (* ; "Edited 19-Feb-2021 12:16 by rmk:") (* ; "Edited 6-Apr-87 12:14 by jop") (LET [(RIGHTWINDOW (OR (WINDOWPROP DISPLAYWINDOW 'RIGHTWINDOW) (CREATEW (CREATEREGION 0 0 100 100) NIL (WINDOWPROP DISPLAYWINDOW 'BORDER) T] (WINDOWPROP RIGHTWINDOW 'REPAINTFN (FUNCTION RIGHTW.REPAINTFN)) (WINDOWPROP RIGHTWINDOW 'RESHAPEFN (FUNCTION CLEARW)) (WINDOWPROP RIGHTWINDOW 'BUTTONEVENTFN (FUNCTION RIGHTW.BUTTONEVENTFN)) (* ;; "RMK: The rightwindow should only scroll as a consequence of left-window scrolling. If it were to scroll on its own, the parallelism would be lost. The left-window scroller knows to do the SCROLLBYREPAINTFN on the right window") (* (WINDOWPROP RIGHTWINDOW  (QUOTE SCROLLFN) (FUNCTION  SCROLLBYREPAINTFN))) (WINDOWPROP RIGHTWINDOW 'NOSCROLLBARS T) (DSPFONT FONT RIGHTWINDOW) (WINDOWPROP DISPLAYWINDOW 'RIGHTWINDOW RIGHTWINDOW) RIGHTWINDOW]) (RIGHTW.REPAINTFN [LAMBDA (WINDOW WINDOWREGION) (* ; "Edited 19-Feb-2021 13:37 by rmk:") (* ; "Edited 22-May-92 17:37 by jds") (* ;; "RMK: Right justify the PROP in its window (assuming its a numeric index)") (* ;;  "REPAINT the right-hand window of a two-d inspector. This window contains the element indices.") [COND ((NULL WINDOWREGION) (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW] (LET [(DISPLAYW (MAINWINDOW WINDOW)) (TOP (fetch (REGION TOP) of WINDOWREGION)) (BOTTOM (fetch (REGION BOTTOM) of WINDOWREGION)) (ROWPROPWIDTH (WINDOWPROP WINDOW 'ROWPROPWIDTH] (LET ((VERTMARKS (WINDOWPROP DISPLAYW 'VERTMARKS)) (ROWPROPS (WINDOWPROP DISPLAYW 'ROWPROPS)) (SPACE (STRINGWIDTH (WINDOWPROP DISPLAYW 'ROWPROPSPACE) WINDOW)) STARTROWPROPS LASTROWPROP STARTVERTMARKS) (for ROWPROP on ROWPROPS as MARK on VERTMARKS until (ILESSP (CAR MARK) TOP) finally (SETQ STARTROWPROPS ROWPROP) (SETQ STARTVERTMARKS MARK)) (for ROWPROP on STARTROWPROPS as MARK in STARTVERTMARKS until (ILESSP MARK BOTTOM) finally (SETQ LASTROWPROP ROWPROP)) [COND (STARTROWPROPS (WITH-INSPECTOR-ENV (WINDOWPROP DISPLAYW 'PROFILE) (bind [FDESCENT _ (SUB1 (FONTPROP WINDOW 'DESCENT] for ROWPROP on STARTROWPROPS as VERTMARK in STARTVERTMARKS repeatuntil (EQ ROWPROP LASTROWPROP) do (MOVETO (- ROWPROPWIDTH (STRINGWIDTH (CAR ROWPROP) WINDOW)) (IPLUS VERTMARK FDESCENT) WINDOW) (PRIN2 (CAR ROWPROP) WINDOW] (INSPECT.INVERTSELECTION WINDOW]) (RIGHTW.RESHAPEFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 10:37 by jop") (CLEARW WINDOW) (RIGHTW.ADJUSTSELECTION WINDOW) (RIGHTW.REPAINTFN WINDOW]) (RIGHTW.BUTTONEVENTFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 18:48 by jop") (TOTOPW WINDOW) (LET* [(SELECTION (WINDOWPROP WINDOW 'SELECTION)) (MAINWINDOW (MAINWINDOW WINDOW)) (ROWPROPCOMMANDFN (WINDOWPROP MAINWINDOW 'ROWPROPCOMMANDFN] (if ROWPROPCOMMANDFN then (WITH-INSPECTOR-ENV (WINDOWPROP MAINWINDOW 'PROFILE) (if (MOUSESTATE LEFT) then (WINDOWPROP WINDOW 'SELECTION (ONED.TRACKCURSOR WINDOW SELECTION (WINDOWPROP MAINWINDOW 'ROWPROPS) (WINDOWPROP MAINWINDOW 'VERTMARKS) (STRINGWIDTH (WINDOWPROP MAINWINDOW 'ROWPROPSPACE) WINDOW) NIL (FONTPROP WINDOW 'HEIGHT) [FUNCTION (LAMBDA (P W) P] (FUNCTION INSPECT.INVERTREGION))) else (* ; "MOUSESTATE MIDDLE") (if SELECTION then (CL:FUNCALL ROWPROPCOMMANDFN (CAR (fetch (ONED.SELECTION PROP) of SELECTION )) (WINDOWPROP MAINWINDOW 'DATUM) MAINWINDOW]) (RIGHTW.ADJUSTSELECTION [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 10:31 by jop") (PROG ((SELECTION (WINDOWPROP WINDOW 'SELECTION)) (MAINWINDOW (MAINWINDOW WINDOW))) (if SELECTION then (PROG ((ROWPROPSPACE (WINDOWPROP MAINWINDOW 'ROWPROPSPACE)) (ROWPROPS (WINDOWPROP MAINWINDOW 'ROWPROPS)) (VERTMARKS (WINDOWPROP MAINWINDOW 'VERTMARKS)) (SELROWPROP (fetch (ONED.SELECTION PROP) of SELECTION)) SELBOTTOM SELWIDTH SELLEFT) (SETQ SELBOTTOM (for VMARK in VERTMARKS as ROWPROP on ROWPROPS thereis (EQ ROWPROP SELROWPROP))) (SETQ SELWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP MAINWINDOW 'PROFILE) (STRINGWIDTH (CAR SELROWPROP) WINDOW T))) (SETQ SELLEFT (STRINGWIDTH ROWPROPSPACE WINDOW)) (WINDOWPROP WINDOW 'SELECTION (create ONED.SELECTION ELTBOTTOM _ SELBOTTOM ELTWIDTH _ SELWIDTH ELTLEFT _ SELLEFT PROP _ SELROWPROP smashing SELECTION]) ) (* ;; "Top window fns") (DEFINEQ (GET-TOPW [LAMBDA (DISPLAYWINDOW FONT) (* ; "Edited 6-Apr-87 14:43 by jop") (LET [(TOPWINDOW (OR (WINDOWPROP DISPLAYWINDOW 'TOPWINDOW) (CREATEW (CREATEREGION 0 0 100 100) NIL (WINDOWPROP DISPLAYWINDOW 'BORDER) T] (WINDOWPROP TOPWINDOW 'REPAINTFN (FUNCTION TOPW.REPAINTFN)) (WINDOWPROP TOPWINDOW 'RESHAPEFN (FUNCTION CLEARW)) (WINDOWPROP TOPWINDOW 'BUTTONEVENTFN (FUNCTION TOPW.BUTTONEVENTFN)) (WINDOWPROP TOPWINDOW 'SCROLLFN (FUNCTION SCROLLBYREPAINTFN)) (DSPRIGHTMARGIN MAX.SMALLP TOPWINDOW) (* ;  "TOPWINDOW will scroll under program control") (WINDOWPROP TOPWINDOW 'NOSCROLLBARS T) (DSPFONT FONT TOPWINDOW) (WINDOWPROP DISPLAYWINDOW 'TOPWINDOW TOPWINDOW) TOPWINDOW]) (TOPW.REPAINTFN [LAMBDA (WINDOW WINDOWREGION) (* ; "Edited 6-Apr-87 11:12 by jop") (if (NULL WINDOWREGION) then (SETQ WINDOWREGION (DSPCLIPPINGREGION NIL WINDOW))) (PROG ((DISPLAYW (MAINWINDOW WINDOW)) (LEFT (fetch (REGION LEFT) of WINDOWREGION)) (RIGHT (fetch (REGION RIGHT) of WINDOWREGION)) HORZMARKS COLUMNPROPS STARTCOLUMNPROPS LASTCOLUMNPROP STARTHORZMARKS) (SETQ HORZMARKS (WINDOWPROP DISPLAYW 'HORZMARKS)) (SETQ COLUMNPROPS (WINDOWPROP DISPLAYW 'COLUMNPROPS)) (for COLUMNPROP on COLUMNPROPS as MARK on HORZMARKS until (IGREATERP (CAR MARK) LEFT) finally (SETQ STARTCOLUMNPROPS COLUMNPROP) (SETQ STARTHORZMARKS MARK)) (for COLUMNPROP on STARTCOLUMNPROPS as MARK in STARTHORZMARKS until (IGREATERP MARK RIGHT) finally (SETQ LASTCOLUMNPROP COLUMNPROP)) [if STARTCOLUMNPROPS then (WITH-INSPECTOR-ENV (WINDOWPROP DISPLAYW 'PROFILE) (bind [BOTTOM _ (SUB1 (FONTPROP WINDOW 'DESCENT] for COLUMNPROP on STARTCOLUMNPROPS as HMARK in STARTHORZMARKS repeatuntil (EQ COLUMNPROP LASTCOLUMNPROP) do (MOVETO (ADD1 (DIFFERENCE HMARK (STRINGWIDTH (CAR COLUMNPROP) WINDOW T))) BOTTOM WINDOW) (PRIN2 (CAR COLUMNPROP) WINDOW] (INSPECT.INVERTSELECTION WINDOW]) (TOPW.RESHAPEFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 11:55 by jop") (CLEARW WINDOW) (TOPW.ADJUSTSELECTION WINDOW) (TOPW.REPAINTFN WINDOW (DSPCLIPPINGREGION NIL WINDOW]) (TOPW.ADJUSTSELECTION [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 11:54 by jop") (PROG ((SELECTION (WINDOWPROP WINDOW 'SELECTION)) (MAINWINDOW (MAINWINDOW WINDOW))) (if SELECTION then (PROG ((COLUMNPROPS (WINDOWPROP MAINWINDOW 'COLUMNPROPS)) (HORZMARKS (WINDOWPROP MAINWINDOW 'HORZMARKS)) (SELCOLPROP (fetch (ONED.SELECTION PROP) of SELECTION)) SELBOTTOM SELWIDTH SELLEFT) (SETQ SELBOTTOM 0) (SETQ SELWIDTH (WITH-INSPECTOR-ENV (WINDOWPROP MAINWINDOW 'PROFILE) (STRINGWIDTH (CAR SELCOLPROP) WINDOW T))) (SETQ SELLEFT (IDIFFERENCE (ADD1 (for HMARK in HORZMARKS as COLPROP on COLUMNPROPS thereis (EQ COLPROP SELCOLPROP))) SELWIDTH)) (WINDOWPROP WINDOW 'SELECTION (create ONED.SELECTION ELTBOTTOM _ SELBOTTOM ELTWIDTH _ SELWIDTH ELTLEFT _ SELLEFT PROP _ SELCOLPROP]) (TOPW.BUTTONEVENTFN [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 18:43 by jop") (TOTOPW WINDOW) (LET* [(SELECTION (WINDOWPROP WINDOW 'SELECTION)) (MAINWINDOW (MAINWINDOW WINDOW)) (COLUMNPROPCOMMANDFN (WINDOWPROP MAINWINDOW 'COLUMNPROPCOMMANDFN] (if COLUMNPROPCOMMANDFN then (WITH-INSPECTOR-ENV (WINDOWPROP MAINWINDOW 'PROFILE) (if (MOUSESTATE LEFT) then (WINDOWPROP WINDOW 'SELECTION (ONED.TRACKCURSOR WINDOW SELECTION (WINDOWPROP MAINWINDOW 'COLUMNPROPS) (WINDOWPROP MAINWINDOW 'HORZMARKS) NIL 0 (FONTPROP WINDOW 'HEIGHT) [FUNCTION (LAMBDA (P W) P] (FUNCTION INSPECT.INVERTREGION) T)) else (* ; "MOUSESTATE MIDDLE") (if SELECTION then (CL:FUNCALL COLUMNPROPCOMMANDFN (CAR (fetch (ONED.SELECTION PROP) of SELECTION)) (WINDOWPROP MAINWINDOW 'DATUM) MAINWINDOW]) ) (* ;; "Title window fns") (DEFINEQ (GET-TITLEW [LAMBDA (DISPLAYWINDOW TITLE TITLEFONT DATUM) (* ; "Edited 6-Apr-87 17:02 by jop") (LET [(TITLEWINDOW (OR (WINDOWPROP DISPLAYWINDOW 'TITLEWINDOW) (CREATEW (CREATEREGION 0 0 100 100) NIL 1 T] (WINDOWPROP TITLEWINDOW 'REPAINTFN (FUNCTION TITLEW.REPAINTFN)) (WINDOWPROP TITLEWINDOW 'RESHAPEFN (FUNCTION CLEARW)) (WINDOWPROP TITLEWINDOW 'BUTTONEVENTFN (FUNCTION TITLEW.BUTTONEVENTFN)) (DSPFONT TITLEFONT TITLEWINDOW) (DSPOPERATION 'INVERT TITLEWINDOW) (WINDOWPROP TITLEWINDOW 'INSPECTTITLE (OR TITLE (CONCAT DATUM " Inspector"))) (WINDOWPROP DISPLAYWINDOW 'TITLEWINDOW TITLEWINDOW) TITLEWINDOW]) (TITLEW.REPAINTFN [LAMBDA (WINDOW) (* ; "Edited 5-Apr-87 14:50 by jop") (BITBLT NIL NIL NIL WINDOW NIL NIL NIL NIL 'TEXTURE 'REPLACE BLACKSHADE) (MOVETOUPPERLEFT WINDOW) (PRINTOUT WINDOW (WINDOWPROP WINDOW 'INSPECTTITLE]) (TITLEW.BUTTONEVENTFN [LAMBDA (TITLEWINDOW) (* ; "Edited 5-Apr-87 16:41 by jop") (PROG ((MAINWINDOW (MAINWINDOW TITLEWINDOW)) TITLECOMMANDFN) (SETQ TITLECOMMANDFN (WINDOWPROP MAINWINDOW 'TITLECOMMANDFN)) (if TITLECOMMANDFN then (WITH-INSPECTOR-ENV (WINDOWPROP MAINWINDOW 'PROFILE) (APPLY* TITLECOMMANDFN MAINWINDOW]) ) (* ;; "Utilites ") (DEFINEQ (ONED.TRACKCURSOR [LAMBDA (WINDOW SELECTION PROPS MARKS LEFT BOTTOM HEIGHT NEW-ITEM-FN HIGHLIGHT-FN HORIZONTAL-P) (* ; "Edited 6-Apr-87 17:41 by jop") (LET (SELECTEDELTBOTTOM SELECTEDELTLEFT SELECTEDELTWIDTH SELECTEDPROP) (if SELECTION then (SETQ SELECTEDELTBOTTOM (fetch (ONED.SELECTION ELTBOTTOM) of SELECTION)) (SETQ SELECTEDELTLEFT (fetch (ONED.SELECTION ELTLEFT) of SELECTION)) (SETQ SELECTEDELTWIDTH (fetch (ONED.SELECTION ELTWIDTH) of SELECTION)) (SETQ SELECTEDPROP (fetch (ONED.SELECTION PROP) of SELECTION))) (bind X Y NEWPROP WIDTH while (MOUSESTATE LEFT) do (SETQ X (LASTMOUSEX WINDOW)) (SETQ Y (LASTMOUSEY WINDOW)) [if (NOT HORIZONTAL-P) then [for PROP on PROPS as MARK in MARKS until (ILESSP MARK Y) finally (if PROP then (SETQ WIDTH (STRINGWIDTH (CL:FUNCALL NEW-ITEM-FN (CAR PROP) WINDOW) WINDOW T)) (SETQ BOTTOM MARK) (* ;  "Select the new region only if the cursor is inside the element box") (SETQ NEWPROP (AND [NOT (OR (ILESSP X LEFT) (IGREATERP X (IPLUS LEFT WIDTH] PROP] else (for PROP on PROPS as MARK in MARKS until (IGREATERP MARK X) finally (if PROP then (SETQ WIDTH (STRINGWIDTH (CL:FUNCALL NEW-ITEM-FN (CAR PROP) WINDOW) WINDOW T)) (SETQ LEFT (ADD1 (IDIFFERENCE MARK WIDTH))) (SETQ NEWPROP (AND (NOT (ILESSP X LEFT)) PROP] (if (NEQ NEWPROP SELECTEDPROP) then (* ;  "We need to consider highlighting a new region") (if SELECTEDPROP then (* ; "Lowlight the old region") (CL:FUNCALL HIGHLIGHT-FN SELECTEDELTLEFT SELECTEDELTBOTTOM SELECTEDELTWIDTH HEIGHT WINDOW) (SETQ SELECTEDPROP NIL)) (if NEWPROP then (* ;  "cursor inside element box, highlight that box") (CL:FUNCALL HIGHLIGHT-FN LEFT BOTTOM WIDTH HEIGHT WINDOW) (SETQ SELECTEDPROP NEWPROP) (SETQ SELECTEDELTWIDTH WIDTH) (SETQ SELECTEDELTLEFT LEFT) (SETQ SELECTEDELTBOTTOM BOTTOM))) finally (if SELECTEDPROP then (if (NULL SELECTION) then (SETQ SELECTION (create ONED.SELECTION))) (RETURN (create ONED.SELECTION ELTWIDTH _ SELECTEDELTWIDTH ELTLEFT _ SELECTEDELTLEFT ELTBOTTOM _ SELECTEDELTBOTTOM PROP _ SELECTEDPROP smashing SELECTION]) (TWOD.TRACKCURSOR [LAMBDA (WINDOW SELECTION ROWPROPS VERTMARKS COLUMNPROPS HORZMARKS HEIGHT NEW-ITEM-FN HIGHLIGHT-FN) (* ; "Edited 6-Apr-87 18:36 by jop") (TOTOPW WINDOW) (LET (SELECTEDROWPROP SELECTEDCOLUMNPROP SELECTEDELTBOTTOM SELECTEDELTLEFT SELECTEDELTWIDTH) (if SELECTION then (SETQ SELECTEDROWPROP (fetch (TWOD.SELECTION ROWPROP) of SELECTION)) (SETQ SELECTEDCOLUMNPROP (fetch (TWOD.SELECTION COLUMNPROP) of SELECTION)) (SETQ SELECTEDELTBOTTOM (fetch (TWOD.SELECTION ELTBOTTOM) of SELECTION)) (SETQ SELECTEDELTLEFT (fetch (TWOD.SELECTION ELTLEFT) of SELECTION)) (SETQ SELECTEDELTWIDTH (fetch (TWOD.SELECTION ELTWIDTH) of SELECTION))) (bind NEWROWPROP NEWCOLUMNPROP NEWHORZMARK LEFT BOTTOM WIDTH X Y while (MOUSESTATE LEFT) do (SETQ X (LASTMOUSEX WINDOW)) (SETQ Y (LASTMOUSEY WINDOW)) (for ROWPROP on ROWPROPS as VERTMARK in VERTMARKS until (ILESSP VERTMARK Y) finally (SETQ NEWROWPROP ROWPROP) (SETQ BOTTOM VERTMARK)) (for COLUMNPROP on COLUMNPROPS as HORZMARK in HORZMARKS until (IGREATERP HORZMARK X) finally (SETQ NEWCOLUMNPROP COLUMNPROP) (SETQ NEWHORZMARK HORZMARK)) (if (AND NEWROWPROP NEWCOLUMNPROP) then (SETQ WIDTH (STRINGWIDTH (CL:FUNCALL NEW-ITEM-FN (CAR NEWROWPROP) (CAR NEWCOLUMNPROP) WINDOW) WINDOW T)) (SETQ LEFT (ADD1 (IDIFFERENCE NEWHORZMARK WIDTH))) (* ;  "Select the new region only if the cursor is inside the element box") (if (ILESSP X LEFT) then (SETQ NEWROWPROP NIL) (SETQ NEWCOLUMNPROP NIL))) (if (OR (NEQ NEWROWPROP SELECTEDROWPROP) (NEQ NEWCOLUMNPROP SELECTEDCOLUMNPROP)) then (* ;  "We need to consider highlighting a new region") (if (AND SELECTEDROWPROP SELECTEDCOLUMNPROP) then (* ; "Lowlight the old region") (CL:FUNCALL HIGHLIGHT-FN SELECTEDELTLEFT SELECTEDELTBOTTOM SELECTEDELTWIDTH HEIGHT WINDOW) (SETQ SELECTEDROWPROP NIL) (SETQ SELECTEDCOLUMNPROP NIL)) (if (AND NEWROWPROP NEWCOLUMNPROP) then (* ;  "cursor inside element box, highlight that box") (CL:FUNCALL HIGHLIGHT-FN LEFT BOTTOM WIDTH HEIGHT WINDOW) (SETQ SELECTEDROWPROP NEWROWPROP) (SETQ SELECTEDCOLUMNPROP NEWCOLUMNPROP) (SETQ SELECTEDELTWIDTH WIDTH) (SETQ SELECTEDELTLEFT LEFT) (SETQ SELECTEDELTBOTTOM BOTTOM))) finally (if (AND SELECTEDROWPROP SELECTEDCOLUMNPROP) then (if (NULL SELECTION) then (SETQ SELECTION (create TWOD.SELECTION))) (RETURN (create TWOD.SELECTION ELTWIDTH _ SELECTEDELTWIDTH ELTLEFT _ SELECTEDELTLEFT ELTBOTTOM _ SELECTEDELTBOTTOM ROWPROP _ SELECTEDROWPROP COLUMNPROP _ SELECTEDCOLUMNPROP smashing SELECTION]) (INSPECT.INVERTSELECTION [LAMBDA (WINDOW) (* ; "Edited 6-Apr-87 11:11 by jop") (* ;; "Inverts SELECTION if non-NIL") (PROG [(SELECTION (WINDOWPROP WINDOW 'SELECTION] (if SELECTION then (INSPECT.INVERTREGION (fetch (INSPECT.SELECTION ELTLEFT) of SELECTION ) (fetch (INSPECT.SELECTION ELTBOTTOM) of SELECTION) (fetch (INSPECT.SELECTION ELTWIDTH) of SELECTION) (FONTPROP WINDOW 'HEIGHT) WINDOW]) (INSPECT.INVERTREGION [LAMBDA (LEFT BOTTOM WIDTH HEIGHT WINDOW) (* ; "Edited 6-Apr-87 16:38 by jop") (BLTSHADE BLACKSHADE WINDOW LEFT BOTTOM WIDTH HEIGHT 'INVERT]) (INSPECT.FLIPSELECTION [LAMBDA (LEFT BOTTOM WIDTH HEIGHT WINDOW) (* ; "Edited 6-Apr-87 16:45 by jop") (BLTSHADE GRAYSHADE WINDOW LEFT BOTTOM WIDTH HEIGHT 'INVERT]) ) (RPAQ? INSPECTORFONT NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS INSPECTORFONT) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (BLOCKRECORD INSPECT.SELECTION (ELTBOTTOM ELTLEFT ELTWIDTH)) (DATATYPE ONED.SELECTION (ELTBOTTOM ELTLEFT ELTWIDTH PROP)) (DATATYPE TWOD.SELECTION (ELTBOTTOM ELTLEFT ELTWIDTH ROWPROP COLUMNPROP)) ) (/DECLAREDATATYPE 'ONED.SELECTION '(POINTER POINTER POINTER POINTER) '((ONED.SELECTION 0 POINTER) (ONED.SELECTION 2 POINTER) (ONED.SELECTION 4 POINTER) (ONED.SELECTION 6 POINTER)) '8) (/DECLAREDATATYPE 'TWOD.SELECTION '(POINTER POINTER POINTER POINTER POINTER) '((TWOD.SELECTION 0 POINTER) (TWOD.SELECTION 2 POINTER) (TWOD.SELECTION 4 POINTER) (TWOD.SELECTION 6 POINTER) (TWOD.SELECTION 8 POINTER)) '10) ) (/DECLAREDATATYPE 'ONED.SELECTION '(POINTER POINTER POINTER POINTER) '((ONED.SELECTION 0 POINTER) (ONED.SELECTION 2 POINTER) (ONED.SELECTION 4 POINTER) (ONED.SELECTION 6 POINTER)) '8) (/DECLAREDATATYPE 'TWOD.SELECTION '(POINTER POINTER POINTER POINTER POINTER) '((TWOD.SELECTION 0 POINTER) (TWOD.SELECTION 2 POINTER) (TWOD.SELECTION 4 POINTER) (TWOD.SELECTION 6 POINTER) (TWOD.SELECTION 8 POINTER)) '10) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) ) (PUTPROPS TWODINSPECTOR COPYRIGHT ("Venue & Xerox Corporation" 1985 1900 1987 1990 1992 1993 2020 2021 )) (DECLARE%: DONTCOPY (FILEMAP (NIL (3566 4313 (\CREATE.TWODINSPECTOR.TITLEMENU 3576 . 3783) (\CREATE.TWODINSPECTOR.SETMENU 3785 . 4003) (\CREATE.TWODINSPECTOR.INSPECTMENU 4005 . 4311)) (4347 37661 (ONEDINSPECTW.CREATE 4357 . 8084) (GET-ONED-DISPLAYW 8086 . 10173) (ONEDINSPECT.ARRANGEWINDOWS 10175 . 15449) ( ONEDINSPECT.REPAINTFN 15451 . 17145) (ONEDINSPECT.PRINTELEMENT 17147 . 17365) (ONEDINSPECT.RESHAPEFN 17367 . 17703) (ONEDINSPECT.MAKEREGIONS 17705 . 19653) (ONEDINSPECT.BUTTONEVENTFN 19655 . 21668) ( ONEDINSPECT.COPYBUTTONFN 21670 . 23509) (ONEDINSPECT.SCROLLFN 23511 . 24101) (ONEDINSPECT.CLOSEFN 24103 . 24366) (ONEDINSPECT.REDISPLAY 24368 . 27124) (ONEDINSPECT.REPLACE 27126 . 27436) ( ONEDINSPECT.SELECTITEM 27438 . 29277) (ONEDINSPECT.SELECTPROP 29279 . 31023) ( ONEDINSPECT.ADJUSTSELECTION 31025 . 32565) (ONEDINSPECT.PROPWIDTH 32567 . 33184) ( ONEDINSPECT.VALUEWIDTH 33186 . 33572) (ONEDINSPECT.DEFAULT.TITLECOMMANDFN 33574 . 34549) ( ONEDINSPECT.DEFAULT.VALUECOMMANDFN 34551 . 36113) (ONEDINSPECT.SETELT 36115 . 37659)) (37694 84172 ( TWODINSPECTW.CREATE 37704 . 42337) (GET-TWOD-DISPLAYW 42339 . 44989) (GET-CORNERW 44991 . 45696) ( TWODINSPECT.ARRANGEWINDOWS 45698 . 52054) (TWODINSPECT.REPAINTFN 52056 . 55241) ( TWODINSPECT.PRINTELEMENT 55243 . 55518) (TWODINSPECT.RESHAPEFN 55520 . 55856) (TWODINSPECT.MAKEREGIONS 55858 . 58659) (TWODINSPECT.BUTTONEVENTFN 58661 . 61290) (TWODINSPECT.COPYBUTTONFN 61292 . 63583) ( TWODINSPECT.DOWINDOWCOMFN 63585 . 64195) (TWODINSPECT.SCROLLFN 64197 . 65030) (TWODINSPECT.CLOSEFN 65032 . 65425) (TWODINSPECT.REDISPLAY 65427 . 69664) (TWODINSPECT.REPLACE 69666 . 70004) ( TWODINSPECT.SELECTITEM 70006 . 72927) (TWODINSPECT.SELECTROWPROP 72929 . 74707) ( TWODINSPECT.SELECTCOLUMNPROP 74709 . 76743) (TWODINSPECT.ADJUSTSELECTION 76745 . 79113) ( TWODINSPECT.DEFAULT.TITLECOMMANDFN 79115 . 80090) (TWODINSPECT.DEFAULT.VALUECOMMANDFN 80092 . 81668) ( TWODINSPECT.SETELT 81670 . 82706) (TWODINSPECT.ROWPROPWIDTH 82708 . 82957) (TWODINSPECT.COLUMNWIDTHS 82959 . 83354) (TWODINSPECT.COLUMNWIDTH 83356 . 83899) (TWODINSPECT.TOTALWIDTH 83901 . 84170)) (84207 92503 (GET-RIGHTW 84217 . 85619) (RIGHTW.REPAINTFN 85621 . 88120) (RIGHTW.RESHAPEFN 88122 . 88341) ( RIGHTW.BUTTONEVENTFN 88343 . 90938) (RIGHTW.ADJUSTSELECTION 90940 . 92501)) (92536 99373 (GET-TOPW 92546 . 93538) (TOPW.REPAINTFN 93540 . 95399) (TOPW.RESHAPEFN 95401 . 95644) (TOPW.ADJUSTSELECTION 95646 . 97265) (TOPW.BUTTONEVENTFN 97267 . 99371)) (99408 100925 (GET-TITLEW 99418 . 100182) ( TITLEW.REPAINTFN 100184 . 100470) (TITLEW.BUTTONEVENTFN 100472 . 100923)) (100953 111558 ( ONED.TRACKCURSOR 100963 . 105664) (TWOD.TRACKCURSOR 105666 . 110372) (INSPECT.INVERTSELECTION 110374 . 111162) (INSPECT.INVERTREGION 111164 . 111359) (INSPECT.FLIPSELECTION 111361 . 111556))))) STOP