(FILECREATED "14-Aug-84 10:46:55" {ERIS}<SPEECH>LEXICON>LFGWINDOWS.;1 27477
changes to: (FNS CLEARLFGWINDOWS SHOWCSTRUCTURES SHOWALLTREES)
previous date: " 9-Aug-84 14:09:53" {PHYLUM}<LFG>PARSER>LFGWINDOWS.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LFGWINDOWSCOMS)
(RPAQQ LFGWINDOWSCOMS ((* This file contains D-dependent window managing facilities)
(FNS CLEARTREEWINDOW DISPLAYFDESC DISPLAYFDESC1 DISPLAYFSTRUCTURES DISPLAYFSTRUCTURES1
FINDFSWDATUM FLIPFSDATUM FSTRUCBUTTONFN GRNODEFROMCONST HASFSINFOP LAYOUTCONTINUATIONS
REPAINTFSTRUCTURES SETUP.FDWINDOW SETUP.FSWINDOW SHOWALLTREES SHOWCHART SHOWCSTRUCTURES
UNFINDFSWDATUM)
(FNS CHANGELFGFONTS CLEARLFGWINDOWS KILLLFGWINDOWS SETUPLFGWINDOWS)
(FNS DOWNARROW LFGLOGOW LFGSUBSCRIPT)
(FNS SHOWFDESC SHOWFSTRUC)
(ALISTS (LFGWINDOWLST TREEFILE FSTRUCTUREFILE FDESCWINDOW ROOTCATWINDOW 1 2 3))
(RECORDS FSWDATUM FSWINFO)
(FNS DEBUGPANEL DEBUGBUTTONFN)
(VARS CSDEBUGBUTTONS FSDEBUGBUTTONS)
(FNS ROOTCATWINDOW)
(INITVARS (CSTRUCTUREMOTHERD 2)
(CSTRUCTUREPERSONALD .4)
(CLOSESEMANTICWINDOWFLAG T))
(IGNOREDECL . T)))
(* This file contains D-dependent window managing facilities)
(DEFINEQ
(CLEARTREEWINDOW
[LAMBDA (TITLE) (* rmk: "21-Feb-84 18:40")
(WINDOWPROP TREEFILE (QUOTE CONSTITUENTS)
NIL)
(WINDOWPROP TREEFILE (QUOTE GRAPH)
NIL)
(CLEARW TREEFILE)
(AND TITLE (WINDOWPROP TREEFILE (QUOTE TITLE)
TITLE])
(DISPLAYFDESC
[LAMBDA (FD TITLE HIGHLIGHTS) (* rmk: "11-AUG-82 11:03")
(DECLARE (GLOBALVARS FDESCWINDOW))
(PROG (STARTX STARTY)
(OR (WINDOWP FDESCWINDOW)
(SETQ FDESCWINDOW (SETUP.FDWINDOW)))
(CLEARW FDESCWINDOW)
(WINDOWPROP FDESCWINDOW (QUOTE HIGHLIGHTS)
HIGHLIGHTS)
(SETQ STARTX (DSPXPOSITION NIL FDESCWINDOW))
(SETQ STARTY (DSPYPOSITION NIL FDESCWINDOW))
(WINDOWPROP FDESCWINDOW (QUOTE FDESC)
(CONS (create POSITION
XCOORD ← STARTX
YCOORD ← STARTY)
FD))
(WINDOWPROP FDESCWINDOW (QUOTE TITLE)
TITLE)
[RESETFORM (OUTPUT FDESCWINDOW)
(if HIGHLIGHTS
then (DISPLAYFDESC1 (CDR (WINDOWPROP FDESCWINDOW (QUOTE FDESC)))
(WINDOWPROP FDESCWINDOW (QUOTE HIGHLIGHTS)))
else (PPSCHEMATA (CDR (WINDOWPROP FDESCWINDOW (QUOTE FDESC]
(WINDOWPROP FDESCWINDOW (QUOTE EXTENT)
(create REGION
LEFT ← STARTX
BOTTOM ←(IDIFFERENCE (DSPYPOSITION NIL FDESCWINDOW)
(FONTPROP FDESCWINDOW (QUOTE DESCENT)))
HEIGHT ←(IPLUS (IDIFFERENCE STARTY (DSPYPOSITION NIL FDESCWINDOW))
(FONTPROP FDESCWINDOW (QUOTE HEIGHT)))
WIDTH ← -1])
(DISPLAYFDESC1
[LAMBDA (SCHEMATA HIGHLIGHTS) (* rmk: "11-AUG-82 11:04" posted: " 5-AUG-81 14:59")
(* Displays a simple conjunction of schematas,
hightlighting the HIGHLIGHTS)
(for SCHEMA TOP BOTTOM (W ←(OUTPUT))
(POS ←(POSITION)) in SCHEMATA
do (TAB POS 0)
(if (MEMB SCHEMA HIGHLIGHTS)
then (SETQ TOP (IPLUS (FONTPROP W (QUOTE ASCENT))
(DSPYPOSITION NIL W)))
(PPSCHEMA SCHEMA)
[SETQ BOTTOM (IDIFFERENCE (DSPYPOSITION NIL W)
(FONTPROP W (QUOTE DESCENT]
(BITBLT NIL NIL NIL W (fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL W))
BOTTOM NIL (IDIFFERENCE TOP BOTTOM)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
else (PPSCHEMA SCHEMA])
(DISPLAYFSTRUCTURES
[LAMBDA (C ALLFLAG) (* rmk: "15-Feb-84 16:51")
(* ALLFLAG always T in D)
(* Displays fstructures in the D-implementation)
(PROG (STARTX STARTY SOLVERESULTS FSWDATA)
[COND
((NOT (WINDOWP FSTRUCTUREFILE))
(SETQ FSTRUCTUREFILE (SETUP.FSWINDOW]
(SETQ SOLVERESULTS (SOLVEALL C))
(CLEARW FSTRUCTUREFILE)
(WINDOWPROP FSTRUCTUREFILE (QUOTE SELECTEDDATUM)
NIL)
(perform FSTRUCTURE.CLEAR)
[WINDOWPROP FSTRUCTUREFILE (QUOTE TITLE)
(CONCAT "F-structures for " (fetch NETWORKNAME of (fetch RULENETWORK
of C))
" "
(fetch (CONSTITUENT C#) of C)
": "
(LENGTH SOLVERESULTS)
" f-description"
(PLURALSUFF (LENGTH SOLVERESULTS]
(SETQ STARTX (DSPXPOSITION NIL FSTRUCTUREFILE))
(SETQ STARTY (DSPYPOSITION NIL FSTRUCTUREFILE))
[WINDOWPROP FSTRUCTUREFILE (QUOTE FSWINFO)
(create FSWINFO
STARTPOS ←(create POSITION
XCOORD ← STARTX
YCOORD ← STARTY)
ALLFLAG ← T
CONSTITUENT ← C
FSWDATA ←(SETQ FSWDATA (DISPLAYFSTRUCTURES1 SOLVERESULTS C
FSTRUCTUREFILE T]
(WINDOWPROP FSTRUCTUREFILE (QUOTE EXTENT)
(create REGION
LEFT ← STARTX
BOTTOM ←(IDIFFERENCE (DSPYPOSITION NIL FSTRUCTUREFILE)
(FONTPROP FSTRUCTUREFILE (QUOTE DESCENT)))
HEIGHT ←(IPLUS (IDIFFERENCE STARTY (DSPYPOSITION NIL FSTRUCTUREFILE))
(FONTPROP FSTRUCTUREFILE (QUOTE HEIGHT)))
WIDTH ← -1))
(RETURN (CDR FSWDATA])
(DISPLAYFSTRUCTURES1
[LAMBDA (SOLVERESULTS C FILE ALLFLAG) (* kh: "22-APR-83 16:50")
(RESETFORM (OUTPUT FILE)
(for SR PRINTED STARTY (COUNTS ←(create SOLVECOUNTS)) in SOLVERESULTS as FD#
from 1
eachtime (SOLVECOUNTS SR COUNTS)
[SETQ STARTY (IPLUS (DSPYPOSITION)
(FONTPROP NIL (QUOTE ASCENT]
when (PPFSTRUCTURE1 SR C ALLFLAG FD#)
collect (PROG1 (create FSWDATUM
SOLVERESULT ← SR
REGIONTOP ← STARTY
REGIONBOTTOM ←(IDIFFERENCE (DSPYPOSITION)
(FONTPROP NIL (QUOTE DESCENT)))
FD# ← FD#)
(TERPRI)
(TERPRI))
finally [replace COUNTTOP of COUNTS with (IPLUS (DSPYPOSITION)
(FONTPROP NIL (QUOTE ASCENT]
(SUMMARYLINE (CAR (push $$VAL COUNTS])
(FINDFSWDATUM
[LAMBDA (WINDOW) (* rmk: "22-May-84 11:36")
(* Returns the FSWDATUM that the mouse is pointing to
with left or middle down)
(for DATUM LASTDATUM (MOUSEX ←(LASTMOUSEX WINDOW))
(MOUSEY ←(LASTMOUSEY WINDOW)) in [CDR (fetch FSWDATA of (WINDOWPROP WINDOW (QUOTE FSWINFO]
first (COND
((NOT (INSIDEP (DSPCLIPPINGREGION NIL WINDOW)
MOUSEX MOUSEY))
(UNFINDFSWDATUM WINDOW) (* Moved outside the window)
(RETURN)))
when (AND (IGREATERP (fetch REGIONTOP of DATUM)
MOUSEY)
(IGREATERP MOUSEY (fetch REGIONBOTTOM of DATUM)))
do [COND
([NEQ DATUM (SETQ LASTDATUM (WINDOWPROP WINDOW (QUOTE SELECTEDDATUM]
(UNFINDFSWDATUM WINDOW)
(UNINTERRUPTABLY
(WINDOWPROP WINDOW (QUOTE SELECTEDDATUM)
DATUM)
(FLIPFSDATUM DATUM WINDOW)
(replace SELECTEDFLAG of DATUM with T))]
(RETURN DATUM)
finally (UNFINDFSWDATUM WINDOW])
(FLIPFSDATUM
[LAMBDA (DATUM WINDOW REGION) (* rmk: "27-JUL-82 22:25")
(* REGION is passed when repainting, in which case don't
want to flip the selected flag)
(if DATUM
then (BITBLT NIL NIL NIL WINDOW (fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL WINDOW))
(fetch REGIONBOTTOM of DATUM)
NIL
(IDIFFERENCE (fetch REGIONTOP of DATUM)
(fetch REGIONBOTTOM of DATUM))
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE REGION])
(FSTRUCBUTTONFN
[LAMBDA (WINDOW) (* rmk: "17-May-84 23:06")
(TOTOPW WINDOW)
(bind DATUM (LEFT ←(LASTMOUSESTATE LEFT))
do (SETQ DATUM (FINDFSWDATUM WINDOW))
(GETMOUSESTATE)
(COND
((NOT (LASTMOUSESTATE (OR LEFT MIDDLE)))
[COND
(DATUM (COND
[LEFT (DISPLAYFDESC (fetch FD of (fetch SOLVERESULT of DATUM))
(CONCAT "F-description " (fetch FD# of DATUM))
(APPEND (for I in (fetch INCONSISTENCIES
of (fetch SOLVERESULT of DATUM))
collect (fetch EQN of I))
(fetch BADCONSTRAINTS
of (fetch SOLVERESULT of DATUM]
(T (DOSEMANTICS (fetch SOLVERESULT of DATUM)
(fetch FD# of DATUM)
(fetch CONSTITUENT of (WINDOWPROP WINDOW (QUOTE FSWINFO]
(RETURN])
(GRNODEFROMCONST
[DLAMBDA ((C CONSTITUENT)
TREE)
(* rmk: "12-AUG-82 13:07")
(* Finds the graph node in TREE corresponding to the
constituent C.)
(find R in (fetch GRAPHNODES of TREE) suchthat (EQ (CAR (fetch NODEID of R))
C))])
(HASFSINFOP
[LAMBDA (C) (* rmk: "24-Jan-84 17:58")
(* T if some fs info would be displayed for C)
(for SR in (SOLVEALL C) when [OR (AND (NOT (fetch INCONSISTENCIES of SR))
(NOT (fetch BADCONSTRAINTS of SR))
(NOT (fetch INCOHERENTP of SR))
(NOT (fetch INDETERMINATEP of SR)))
(AND (fetch INCONSISTENCIES of SR)
SHOWINCONSISTENCIES)
(AND (fetch BADCONSTRAINTS of SR)
(OR SHOWBADCONSTRAINTS SHOWINCONSISTENCIES))
(AND (fetch INCOHERENTP of SR)
SHOWINCOHERENT)
(AND (fetch INDETERMINATEP of SR)
(OR SHOWINCOMPLETE
(NOT (MEMB (fetch NETWORKNAME
of (fetch RULENETWORK of C))
CLOSEDCATEGORIES]
do (RETURN T])
(LAYOUTCONTINUATIONS
[DLAMBDA ((TREE)
(C CONSTITUENT (SATISFIES ~(COMPLETEP C))))
(* rmk: " 8-NOV-83 22:42")
[PROG (XPOS YPOS FINALINDICATOR CNODES (REG (GRAPHREGION TREE))
(LF (DSPLINEFEED NIL TREEFILE)))
(SETQ XPOS (IPLUS (fetch (REGION RIGHT) of REG)
(STRINGWIDTH " " CSTRUCTUREFONT)))
[SETQ YPOS (fetch YCOORD of (fetch NODEPOSITION
of (GRNODEFROMCONST [CAR (CAR (fetch TONODES
of (GRNODEFROMCONST C TREE]
TREE]
[COND
((fetch FINALP of (fetch STATE of C))
(SETQ FINALINDICATOR (LIST (create GRAPHNODE
NODEID ←(CONCAT "*")
NODELABEL ← "*"
NODEPOSITION ←(create POSITION
XCOORD ←(IPLUS
XPOS
(LRSH (STRINGWIDTH "*"
CSTRUCTUREFONT)
1))
YCOORD ←(PROG1 YPOS
(add YPOS LF)))
NODEFONT ← CSTRUCTUREFONT]
(SETQ CNODES (for ARC in (fetch ARCSET of (fetch STATE of C))
collect (create GRAPHNODE
NODEID ← ARC
NODELABEL ←(fetch (NETWORK NETWORKNAME)
of (fetch LABEL of ARC))
NODEPOSITION ←(create
POSITION
XCOORD ←(IPLUS XPOS
(LRSH (STRINGWIDTH (fetch (NETWORK
NETWORKNAME)
of (fetch LABEL
of ARC))
CSTRUCTUREFONT)
1))
YCOORD ←(PROG1 YPOS (add YPOS LF)))
NODEFONT ← CSTRUCTUREFONT)))
(replace GRAPHNODES of TREE with (NCONC FINALINDICATOR CNODES (fetch GRAPHNODES
of TREE]])
(REPAINTFSTRUCTURES
[LAMBDA (FSWDATA C FILE ALLFLAG REGION) (* rmk: "27-JUL-82 23:02")
(RESETFORM (OUTPUT FILE)
(PROG ((COUNTS (CAR FSWDATA)))
(for FSD in (CDR FSWDATA) as FD# from 1
unless (OR (IGREATERP (fetch (REGION BOTTOM) of REGION)
(fetch REGIONTOP of FSD))
(ILESSP (fetch (REGION TOP) of REGION)
(fetch REGIONBOTTOM of FSD)))
do (DSPYPOSITION (IDIFFERENCE (fetch REGIONTOP of FSD)
(FONTPROP (OUTPUT)
(QUOTE ASCENT)))
(OUTPUT))
(COND
((PPFSTRUCTURE1 (fetch SOLVERESULT of FSD)
C ALLFLAG FD#)
(TERPRI)
(TERPRI)))
(COND
((fetch SELECTEDFLAG of FSD)
(FLIPFSDATUM FSD FILE REGION)))
finally (* Now print out the summary line)
(DSPYPOSITION (IDIFFERENCE (fetch COUNTTOP of COUNTS)
(FONTPROP (OUTPUT)
(QUOTE ASCENT)))
(OUTPUT))
(SUMMARYLINE COUNTS])
(SETUP.FDWINDOW
[LAMBDA (REGION) (* rmk: " 7-Jun-84 22:38")
(CREATEIMAGEW REGION "F-Description Window" NIL T [FUNCTION (LAMBDA (WINDOW REGION)
(SETQ REGION (WINDOWPROP WINDOW (QUOTE FDESC)))
(MOVETO (fetch XCOORD of (CAR REGION))
(fetch YCOORD of (CAR REGION))
WINDOW)
(RESETFORM (OUTPUT WINDOW)
(COND
[(WINDOWPROP WINDOW (QUOTE HIGHLIGHTS))
(DISPLAYFDESC1 (CDR REGION)
(WINDOWPROP WINDOW (QUOTE HIGHLIGHTS]
(T (PPSCHEMATA (CDR REGION]
(FUNCTION TOTOPW])
(SETUP.FSWINDOW
[LAMBDA (REGION) (* rmk: "10-Jan-84 11:29")
(DEBUGPANEL FSDEBUGBUTTONS (CREATEIMAGEW REGION "F-Structure Window" NIL NIL
[FUNCTION (LAMBDA (WINDOW REGION)
(PROG [(FSWINFO (WINDOWPROP WINDOW (QUOTE FSWINFO]
(COND
(FSWINFO
(* NIL in the initial state of the world)
(MOVETO (fetch XCOORD
of (fetch STARTPOS
of FSWINFO))
(fetch YCOORD
of (fetch STARTPOS
of FSWINFO))
WINDOW)
(perform FSTRUCTURE.CLEARPRINTED)
(REPAINTFSTRUCTURES (fetch FSWDATA
of FSWINFO)
(fetch
CONSTITUENT
of FSWINFO)
WINDOW
(fetch ALLFLAG
of FSWINFO)
REGION]
(FUNCTION FSTRUCBUTTONFN])
(SHOWALLTREES
[LAMBDA NIL (* rmk: "29-Nov-83 21:39")
(COND
((WINDOWPROP TREEFILE (QUOTE CONSTITUENTS)) (* Don't do anything if no consituents are being
displayed)
(WINDOWPROP TREEFILE (QUOTE CONSTITUENTS)
NIL)
(DSHOWPARSES T])
(SHOWCHART
[LAMBDA NIL (* rmk: " 9-Mar-84 18:09")
(COND
[SHOWCHART (LAT-CHART (FUNCTION [LAMBDA (C)
(SELTYPEQ C
(TERMNODE (EDITLEX (NODELABEL C)))
(CONSTITUENT (WINDOWPROP TREEFILE (QUOTE CONSTITUENTS)
NIL)
(TREEPRINT C NIL TREEFILE))
NIL])
(FUNCTION (LAMBDA (C)
(COND
((type? TERMNODE C)
(EDITLEX (NODELABEL C)
T))
(T (INSPECT C]
(T (COND
((WINDOWP CHARTWINDOW)
(CLOSEW CHARTWINDOW])
(SHOWCSTRUCTURES
[LAMBDA NIL (* rmk: " 9-AUG-82 15:07")
(SHOWCHART)
(CLEARW TREEFILE)
(WINDOWPROP TREEFILE (QUOTE GRAPH)
NIL)
(for C in (WINDOWPROP TREEFILE (QUOTE CONSTITUENTS)
NIL)
as CS# from 1 do (TREEPRINT C CS# TREEFILE])
(UNFINDFSWDATUM
[LAMBDA (WINDOW) (* rmk: "27-JUL-82 22:28")
(PROG [(DATUM (WINDOWPROP WINDOW (QUOTE SELECTEDDATUM]
(AND DATUM (UNINTERRUPTABLY
(FLIPFSDATUM DATUM WINDOW)
(replace SELECTEDFLAG of DATUM with NIL)
(WINDOWPROP WINDOW (QUOTE SELECTEDDATUM)
NIL))])
)
(DEFINEQ
(CHANGELFGFONTS
[LAMBDA (FONT) (* rmk: "17-May-84 22:24")
(DECLARE (GLOBALVARS LFGFONT LFGDIAFONT LFGGREEKFONT LFGVARFONT LFGSYMBOLFONT LFGSMALLFONT
LFGSUBOFFSET CSTRUCTUREFONT TERMINALFONT MENUFONT LFGWINDOWLST))
(SELECTQ FONT
[(LARGE NIL)
(SETQ FONT (QUOTE (GACHA 12 BOLD]
[SMALL (SETQ FONT (QUOTE (GACHA 10]
NIL)
(SETQ LFGFONT (FONTCREATE FONT))
(SETQ LFGSMALLFONT (FONTCOPY LFGFONT (QUOTE SIZE)
(IDIFFERENCE (FONTPROP LFGFONT (QUOTE SIZE))
2)))
(SETQ LFGGREEKFONT (FONTCOPY LFGFONT (QUOTE FAMILY)
(QUOTE HIPPO)))
(SETQ LFGDIAFONT (FONTCOPY LFGFONT (QUOTE FAMILY)
(QUOTE TIMESROMAN)))
(SETQ LFGSYMBOLFONT (FONTCOPY LFGFONT (QUOTE FAMILY)
(QUOTE SYMBOL)
(QUOTE SIZE)
10))
(SETQ LFGVARFONT (FONTCOPY LFGFONT (QUOTE SLOPE)
(QUOTE ITALIC)))
(SETQ LFGSUBOFFSET (IQUOTIENT (FONTPROP LFGSMALLFONT (QUOTE SIZE))
2))
(SETQ CSTRUCTUREFONT LFGFONT)
(SETQ TERMINALFONT LFGFONT)
(SETQ MENUFONT LFGFONT)
(DSPFONT LFGFONT (TTYDISPLAYSTREAM))
(DOWNARROW LFGFONT)
(DEFAULTFONT (QUOTE DISPLAY)
LFGFONT)
(SETUPLFGWINDOWS])
(CLEARLFGWINDOWS
[LAMBDA (INITIALFLAG SMASHFLAG) (* edited: "13-Aug-84 23:07")
(COND
(SMASHFLAG (perform CONSTITUENT.CLEAR) (* If SMASHFLAG, tries to release all storage from
previous sentence)
(perform FSTRUCTURE.CLEAR)
(perform ENTITY.CLEAR)
(create CHART smashing CHART)))
[COND
((WINDOWP CHARTWINDOW)
(WINDOWPROP CHARTWINDOW (QUOTE GRAPH)
NIL)
(COND
((OPENWP CHARTWINDOW)
(CLEARW CHARTWINDOW]
(CLEARTREEWINDOW (if (EQ CURRENTVERSION (QUOTE FOOT))
then "Foot Structure Window"
else "C-Structure Window"))
[COND
((WINDOWP FSTRUCTUREFILE)
(WINDOWPROP FSTRUCTUREFILE (QUOTE FSWINFO)
NIL)
(WINDOWPROP FSTRUCTUREFILE (QUOTE SELECTEDDATUM)
NIL)
(COND
((OPENWP FSTRUCTUREFILE)
(WINDOWPROP FSTRUCTUREFILE (QUOTE TITLE)
"F-Structure Window")
(CLEARW FSTRUCTUREFILE]
[COND
((WINDOWP FSTRUCTUREFILE)
(WINDOWPROP FSTRUCTUREFILE (QUOTE FSWINFO)
NIL)
(WINDOWPROP FSTRUCTUREFILE (QUOTE SELECTEDDATUM)
NIL)
(COND
((OPENWP FSTRUCTUREFILE)
(WINDOWPROP FSTRUCTUREFILE (QUOTE TITLE)
"F-Structure Window")
(CLEARW FSTRUCTUREFILE]
[COND
((WINDOWP FDESCWINDOW)
(WINDOWPROP FDESCWINDOW (QUOTE FDESC)
NIL)
(COND
((OPENWP FDESCWINDOW)
(WINDOWPROP FDESCWINDOW (QUOTE TITLE)
"F-Description Window")
(CLEARW FDESCWINDOW)
(COND
(INITIALFLAG (CLOSEW FDESCWINDOW]
(COND
((WINDOWP SEMSTRUCTUREFILE)
[COND
((OPENWP SEMSTRUCTUREFILE)
(CLEARW SEMSTRUCTUREFILE)
(AND CLOSESEMANTICWINDOWFLAG (CLOSEW SEMSTRUCTUREFILE]
(WINDOWPROP SEMSTRUCTUREFILE (QUOTE FSWDATUM)
NIL)
(WINDOWPROP SEMSTRUCTUREFILE (QUOTE SELECTEDDATUM)
NIL)
(WINDOWPROP SEMSTRUCTUREFILE (QUOTE CONSTITUENT)
NIL)))
(COND
(INITIALFLAG (CLEARRULEEDITORS T)
(CLEARLEXEDITORS T)
(CLEARMORPHEDITORS T])
(KILLLFGWINDOWS
[LAMBDA NIL (* rmk: "22-May-84 11:13")
[for X TEMP in LFGWINDOWLST do (COND
([AND (LITATOM (CAR X))
(SETQ TEMP (WINDOWP (EVALV (CAR X]
(SET (CAR X)
NIL)
(CLOSEW TEMP]
(CLEARRULEEDITORS)
(CLEARLEXEDITORS)
(CLEARMORPHEDITORS)
(SHAPEW T (CREATEREGION 5 370 530 369])
(SETUPLFGWINDOWS
[LAMBDA NIL (* rmk: "19-May-84 22:18")
(DECLARE (GLOBALVARS LFGWINDOWLST))
(DOWNARROW (DSPFONT NIL (TTYDISPLAYSTREAM)))
(KILLLFGWINDOWS)
(SETQ WINDOWTITLESHADE BLACKSHADE)
(for X VAR in LFGWINDOWLST do (COND
[(AND (SETQ VAR (CAR X))
(LITATOM VAR))
(SETTOPVAL VAR (EVAL (CADR X]
(T (EVAL (CADR X])
)
(DEFINEQ
(DOWNARROW
[LAMBDA (FONT) (* edited: " 3-MAR-83 16:51")
(PROG (MAX MIN NEWBM (OLDBM (GETCHARBITMAP '↑ FONT)))
(SETQ NEWBM (BITMAPCREATE (fetch BITMAPWIDTH of OLDBM)
(fetch BITMAPHEIGHT of OLDBM)))
[for Y from 0 to (fetch BITMAPHEIGHT of OLDBM)
do [COND
((NULL MIN)
(for X from 0 to (fetch BITMAPWIDTH of OLDBM)
unless (ZEROP (BITMAPBIT OLDBM X Y))
do (SETQ MIN Y)
(RETURN)))
(MAX (for X from 0 to (fetch BITMAPWIDTH of OLDBM)
unless (ZEROP (BITMAPBIT OLDBM X Y))
do (SETQ MAX NIL)
(RETURN)))
((for X from 0 to (fetch BITMAPWIDTH of OLDBM) always (ZEROP (BITMAPBIT OLDBM X Y)))
(SETQ MAX (SUB1 Y]
finally (COND
((NULL MAX)
(SETQ MAX (fetch BITMAPHEIGHT of OLDBM]
(for I from MIN to MAX as J from MAX by -1
do (BITBLT OLDBM 0 I NEWBM 0 J NIL 1))
(PUTCHARBITMAP (QUOTE !)
FONT NEWBM])
(LFGLOGOW
[LAMBDA NIL (* rmk: "10-Jan-84 11:15")
(DECLARE (GLOBALVARS LOGOW LFGLOGOW))
(COND
((WINDOWP LOGOW)
(CLOSEW LOGOW))) (* Close the Interlisp-D logo)
(COND
((WINDOWP (EVALV (QUOTE LFGLOGOW)))
(CLOSEW LFGLOGOW)))
[SETQ LFGLOGOW (CREATEW (QUOTE (840 707 175 92]
[WINDOWPROP LFGLOGOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(DECLARE (GLOBALVARS LFGLOGOW))
(SETQ LFGLOGOW NIL]
(PROG ((WIDTH 2))
(DSPFONT (QUOTE (TIMESROMAND 36))
LFGLOGOW)
(MOVETO 10 5 LFGLOGOW)
(PRIN1 "L F G" LFGLOGOW)
(DRAWLINE 18 36 75 77 WIDTH NIL LFGLOGOW) (* Line from L)
(DRAWTO 135 36 WIDTH NIL LFGLOGOW) (* Line to G, then line to F)
(DRAWLINE 75 36 48 57 WIDTH NIL LFGLOGOW])
(LFGSUBSCRIPT
[LAMBDA (X) (* rmk: "10-Jan-84 11:15")
(* Prints X as a subscript in the LFGSMALLFONT)
(DECLARE (GLOBALVARS LFGSMALLFONT LFGSUBOFFSET))
(RELMOVETO 0 (IMINUS LFGSUBOFFSET))
(RESETFORM (DSPFONT LFGSMALLFONT)
(PRIN1 X))
(RELMOVETO 0 LFGSUBOFFSET])
)
(DEFINEQ
(SHOWFDESC
[LAMBDA (GRAPHNODE WINDOW) (* rmk: "31-May-84 19:58")
(PROG ((ID (fetch NODEID of GRAPHNODE)))
(SELTYPEQ ID
[ARC (UNFINDFSWDATUM FSTRUCTUREFILE)
(DISPLAYFDESC (fetch ARCSCHEMATA of ID)
(CONCAT "F-Description for . . . "
(fetch NETWORKNAME of (fetch LABEL of ID]
[(LISTP OF CONSTITUENT)
(COND
[(type? TERMNODE (CAR ID))
(EDITLEX (NODELABEL (CAR ID]
(T (SETQ ID (CAR ID))
(UNFINDFSWDATUM FSTRUCTUREFILE)
(DISPLAYFDESC (INSTANTIATE ID)
(CONCAT "F-description for " (fetch NETWORKNAME
of (fetch RULENETWORK
of ID))
" "
(fetch (CONSTITUENT C#)
ID]
NIL])
(SHOWFSTRUC
[LAMBDA (GRAPHNODE WINDOW) (* rmk: " 9-Mar-84 18:07")
(PROG ((C (fetch NODEID of GRAPHNODE)))
(SELTYPEQ C
[(LISTP OF CONSTITUENT)
(COND
((type? TERMNODE (CAR C))
(EDITLEX (NODELABEL (CAR C))
T))
(T (DISPLAYFSTRUCTURES (CAR C)
T]
(ARC NIL)
NIL])
)
(ADDTOVAR LFGWINDOWLST (TREEFILE (DEBUGPANEL CSDEBUGBUTTONS (CREATEW (CREATEREGION 585 405 430 300)
"C-Structure Window")
(QUOTE CSDEBUGBUTTONSWINDOW)))
[FSTRUCTUREFILE (SETUP.FSWINDOW (QUOTE (585 15 430 365]
(FDESCWINDOW (SETUP.FDWINDOW (CREATEREGION 330 15 250 384)))
(ROOTCATWINDOW NIL)
(1 (PROGN (WINDOWPROP PROMPTWINDOW (QUOTE TITLE)
NIL)
(MOVEW PROMPTWINDOW (QUOTE (25 . 744)))
(CLOSEW PROMPTWINDOW)))
(2 (LFGLOGOW))
(3 (SHAPEW (TTYDISPLAYSTREAM)
(CREATEREGION 15 707 565 92))))
[DECLARE: EVAL@COMPILE
(RECORD FSWDATUM (SOLVERESULT REGIONTOP REGIONBOTTOM FD# SELECTEDFLAG))
(RECORD FSWINFO (STARTPOS ALLFLAG CONSTITUENT FSWDATA))
]
(DEFINEQ
(DEBUGPANEL
[LAMBDA (BUTTONLST WINDOW) (* rmk: "19-May-84 21:33")
(ATTACHMENU (BUTTONPANEL BUTTONLST 1 NIL 1)
WINDOW
(QUOTE TOP)
(QUOTE LEFT))
WINDOW])
(DEBUGBUTTONFN
[LAMBDA (LABEL SWITCH VAR) (* rmk: "29-JUL-82 01:53")
(DECLARE (GLOBALVARS FSTRUCTUREFILE))
(PROG (C)
(COND
([AND (WINDOWP FSTRUCTUREFILE)
(type? CONSTITUENT (SETQ C (fetch CONSTITUENT of (WINDOWPROP FSTRUCTUREFILE
(QUOTE FSWINFO]
(DISPLAYFSTRUCTURES C T])
)
(RPAQQ CSDEBUGBUTTONS ((CHART SHOWCHART SHOWCHART)
(ALL SHOWALLTREES SHOWALLTREES)
(VARIABLES DISPLAYNODEVARIABLES SHOWCSTRUCTURES)))
(RPAQQ FSDEBUGBUTTONS ((INCONSISTENT SHOWINCONSISTENCIES DEBUGBUTTONFN)
(INCOMPLETE SHOWINCOMPLETE DEBUGBUTTONFN)
(INCOHERENT SHOWINCOHERENT DEBUGBUTTONFN)))
(DEFINEQ
(ROOTCATWINDOW
[LAMBDA (CAT) (* rmk: "19-May-84 22:11")
(DECLARE (GLOBALVARS ROOTCATWINDOW EDITCATMENU))
(AND (OPENWP ROOTCATWINDOW)
(CLOSEW ROOTCATWINDOW))
[COND
(INCATLIST (PROG [(EDITCATREGION (WINDOWPROP EDITCATMENU (QUOTE REGION]
(SETQ ROOTCATWINDOW
(ADDMENU [create MENU
MENUROWS ← 1
MENUOUTLINESIZE ← 2
ITEMS ←(LIST (LIST (CONCAT (COND
(INCATLIST "")
(T " "))
"Root: " CAT " ")
NIL
"Move mouse to right to change root category"
(CONS (QUOTE SUBITEMS)
INCATLIST)))
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION (LAMBDA (ITEM MENU BUTTON)
(AND (type? CATEGORY ITEM)
(ROOTCAT ITEM]
NIL
(create POSITION
XCOORD ←(fetch (REGION LEFT) of EDITCATREGION)
YCOORD ←(PLUS 2 (fetch (REGION TOP) of EDITCATREGION]
ROOTCATWINDOW])
)
(RPAQ? CSTRUCTUREMOTHERD 2)
(RPAQ? CSTRUCTUREPERSONALD .4)
(RPAQ? CLOSESEMANTICWINDOWFLAG T)
(DECLARE: DOEVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(RESETSAVE COMPILEIGNOREDECL (QUOTE T))
)
(PUTPROPS LFGWINDOWS COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1243 16667 (CLEARTREEWINDOW 1253 . 1550) (DISPLAYFDESC 1552 . 2864) (DISPLAYFDESC1 2866
. 3731) (DISPLAYFSTRUCTURES 3733 . 5564) (DISPLAYFSTRUCTURES1 5566 . 6395) (FINDFSWDATUM 6397 . 7561)
(FLIPFSDATUM 7563 . 8188) (FSTRUCBUTTONFN 8190 . 9109) (GRNODEFROMCONST 9111 . 9548) (HASFSINFOP 9550
. 10495) (LAYOUTCONTINUATIONS 10497 . 12291) (REPAINTFSTRUCTURES 12293 . 13391) (SETUP.FDWINDOW 13393
. 14008) (SETUP.FSWINDOW 14010 . 15038) (SHOWALLTREES 15040 . 15373) (SHOWCHART 15375 . 15940) (
SHOWCSTRUCTURES 15942 . 16280) (UNFINDFSWDATUM 16282 . 16665)) (16668 20777 (CHANGELFGFONTS 16678 .
17913) (CLEARLFGWINDOWS 17915 . 19908) (KILLLFGWINDOWS 19910 . 20326) (SETUPLFGWINDOWS 20328 . 20775))
(20778 23258 (DOWNARROW 20788 . 21935) (LFGLOGOW 21937 . 22846) (LFGSUBSCRIPT 22848 . 23256)) (23259
24473 (SHOWFDESC 23269 . 24085) (SHOWFSTRUC 24087 . 24471)) (25231 25835 (DEBUGPANEL 25241 . 25448) (
DEBUGBUTTONFN 25450 . 25833)) (26174 27197 (ROOTCATWINDOW 26184 . 27195)))))
STOP