reduce-historical/psl-1983/3-1/glisp/gevt.sl

(fluid '(p))

(DE SUBSTRING (STRING FIRST LAST) (COND ((NOT (STRINGP STRING)) (SETQ STRING (
GEVSTRINGIFY STRING)))) (COND ((MINUSP FIRST) (SETQ FIRST (ADD1 (PLUS (ADD1 (
SIZE STRING)) FIRST))))) (COND ((MINUSP LAST) (SETQ LAST (ADD1 (PLUS (ADD1 (
SIZE STRING)) LAST))))) (SUBSEQ STRING (SUB1 FIRST) LAST))

(DE GEVSTRINGIFY (X) (COND ((STRINGP X) X) (T (BLDMSG "%p" X))))

(DE CONCATN (L) (COND ((NULL L) "") ((NULL (CDR L)) (GEVSTRINGIFY (CAR L))) (
T (CONCAT (GEVSTRINGIFY (CAR L)) (CONCATN (CDR L))))))

(DE CONCATLN (L) (COND ((NULL L) "") ((NULL (CDR L)) (GEVSTRINGIFY (EVAL (
CAR L)))) (T (CONCAT (GEVSTRINGIFY (EVAL (CAR L))) (CONCATLN (CDR L))))))

(DF CONCATL (CONCATLARG) (CONCATLN CONCATLARG))

(DE GEVCONCAT (L) (CONCATN L))

(DE DREVERSE (L) (REVERSIP L))

(DE MKATOM (S) (INTERN S))

(DE GEVPUTD (FN FORM) (PUT FN (QUOTE GLORIGINALEXPR) (CONS (QUOTE LAMBDA) (
CDR FORM))) (PUT FN (QUOTE GLCOMPILED) NIL) (REMD FN) (PUTD FN (QUOTE MACRO) (
QUOTE (LAMBDA (GLDGFORM) (GLHOOK GLDGFORM)))))

(DE GEVAPPLY (FN ARGS) (COND ((AND (ATOM FN) (OR (NULL (GET FN (QUOTE 
GLCOMPILED))) (NOT (EQ (GETDDD FN) (GET FN (QUOTE GLCOMPILED)))))) (GLCC FN) (
APPLY FN ARGS)) (T (APPLY FN ARGS))))

(GLOBAL (QUOTE (TERMINAL)))

(GLISPOBJECTS (TERMINAL ATOM MSG ((MOVETOXY TERMINAL-MOVETOXY) (PRINTCHAR 
TERMINAL-PRINTCHAR OPEN T) (PRINTSTRING TERMINAL-PRINTSTRING) (INVERTVIDEO (
NIL)) (NORMALVIDEO (NIL)) (GRAPHICSMODE (NIL)) (NORMALMODE (NIL)) (ERASEEOL ((
PBOUT (CHAR ESC)) (PBOUT (CHAR K)))))))

(GLISPGLOBALS (TERMINAL TERMINAL))

(GLISPCONSTANTS (BLANKCHAR 32 INTEGER) (HORIZONTALLINECHAR 45 INTEGER) (
HORIZONTALBARCHAR 95 INTEGER) (LVERTICALBARCHAR 124 INTEGER) (
RVERTICALBARCHAR 124 INTEGER) (ESCAPECHAR 27 INTEGER))

(DE TERMINAL-MOVETOXY (TERM X Y) (COND ((LESSP X 0) (SETQ X 0)) ((GREATERP X 
79) (SETQ X 79))) (COND ((LESSP Y 0) (SETQ Y 0)) ((GREATERP Y 23) (SETQ Y 
23))) (PROG (S) (SETQ S (CHAR ESC)) (PBOUT S)) (PROG (S) (SETQ S (CHAR Y)) (
PBOUT S)) (PROG (S) (SETQ S (DIFFERENCE 55 Y)) (PBOUT S)) (PROG (S) (SETQ S (
PLUS 32 X)) (RETURN (PBOUT S))))

(DE TERMINAL-PRINTCHAR (TERM S) (PBOUT S))

(DE TERMINAL-PRINTSTRING (TERM S) (PROG (I N) (COND ((NOT (STRINGP S)) (SETQ 
S (GEVSTRINGIFY S)))) (SETQ N (ADD1 (SIZE S))) (SETQ I 0) (PROG NIL GLLABEL1 (
COND ((LESSP I N) (PBOUT (INDX S I)) (SETQ I (ADD1 I)) (GO GLLABEL1))))))

(SETQ TERMINAL (QUOTE VT52))

(GLOBAL (QUOTE (MENUSTART)))

(GLISPOBJECTS (MENU (LISTOBJECT (ITEMS (LISTOF ATOM)) (WINDOW WINDOW)) MSG ((
SELECT MENU-SELECT RESULT ATOM))) (MOUSE ANYTHING) (WINDOW (LISTOBJECT (
START VECTOR) (SIZE VECTOR) (TITLE STRING) (LASTFILLEDLINE INTEGER)) PROP ((
YPOSITION (LASTFILLEDLINE)) (LEFTMARGIN (1)) (RIGHTMARGIN (WIDTH !- 2))) MSG ((
CLEAR WINDOW-CLEAR) (OPEN WINDOW-OPEN) (CLOSE WINDOW-CLOSE) (INVERTAREA 
WINDOW-INVERTAREA OPEN T) (MOVETOXY WINDOW-MOVETOXY OPEN T) (MOVETO 
WINDOW-MOVETO OPEN T) (PRINTAT WINDOW-PRINTAT OPEN T) (PRETTYPRINTAT 
WINDOW-PRETTYPRINTAT OPEN T) (UNPRINTAT WINDOW-UNPRINTAT OPEN T) (DRAWLINE 
WINDOW-DRAWLINE OPEN T) (UNDRAWLINE WINDOW-UNDRAWLINE OPEN T) (CENTEROFFSET 
WINDOW-CENTEROFFSET OPEN T)) SUPERS (REGION)))

(GLISPGLOBALS (MOUSE MOUSE))

(GLISPCONSTANTS (WINDOWCHARWIDTH 1 INTEGER) (WINDOWLINEYSPACING 1 INTEGER))

(SETQ MOUSE (QUOTE MOUSE))

(SETQ GEVMENUWINDOW NIL)

(SETQ MENUSTART (A VECTOR WITH X = 50 Y = 3))

(DE MENU-SELECT (M) (PROG (MAXW I N SAVEESC SAVEGLQ SAVEGCG RESULT) (COND ((
NOT GEVACTIVEFLG) (GEVENTER))) (SETQ SAVEGLQ GLQUIETFLG) (SETQ GLQUIETFLG T) (
SETQ MAXW 0) (MAPC (CADR M) (FUNCTION (LAMBDA (X) (SETQ MAXW (MAX MAXW (PROG (
SELF) (SETQ SELF (ID2STRING X)) (RETURN (ADD1 (SIZE SELF))))))))) (COND ((
GREATERP MAXW 20) (SETQ MAXW 20))) (RPLACA (CDDR M) (LIST (QUOTE WINDOW) 
MENUSTART (LIST (TIMES (PLUS MAXW 5) 1) (TIMES (MIN (ADD1 (LENGTH (CADR M))) 
19) 1)) "Menu" 0)) (WINDOW-OPEN (CADDR M)) (SETQ I 0) (MAPC (CADR M) (
FUNCTION (LAMBDA (X) (SETQ I (ADD1 I)) (PROG (W S POS) (SETQ W (CADDR M)) (
SETQ S (CONCAT (GEVSTRINGIFY I) (CONCAT (COND ((LESSP I 10) "  ") (T " ")) (
GEVSTRINGIFY X)))) (SETQ POS (LIST 1 (DIFFERENCE (PROG (SELF) (SETQ SELF (
CADDR M)) (RETURN (CADR (CADDR SELF)))) I))) (COND ((GREATERP (CADR POS) 
0) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY 
TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (TERMINAL-PRINTSTRING 
TERMINAL S) (TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH W 5))) (RPLACA (
PNTH W 5) (CADR POS)))))))))) (PROG (W) (SETQ W (CADDR M)) (
TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))) (PBOUT (
CHAR ESC)) (PBOUT (CHAR K)) LP (PROG (W) (SETQ W (CADDR M)) (
TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))) (
TERMINAL-PRINTSTRING TERMINAL "Menu: ") (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (
ECHOON) (SETQ N (READ)) (ECHOOFF) (COND ((AND (FIXP N) (GREATERP N 0) (NOT (
GREATERP N (LENGTH (CADR M))))) (SETQ RESULT (CAR (PNTH (CADR M) N))) (GO 
OUT)) ((EQ N (QUOTE Q)) (SETQ RESULT NIL) (GO OUT)) (T (PRIN1 N) (SPACES 
1) (TERMINAL-PRINTSTRING TERMINAL "?") (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (
GO LP))) OUT (WINDOW-CLOSE (CADDR M)) (PROG (W) (SETQ W (CADDR M)) (
TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))) (TERPRI) (
PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (SETQ GLQUIETFLG SAVEGLQ) (COND ((NOT 
GEVACTIVEFLG) (GEVEXIT))) (RETURN RESULT)))

(DE PRINTNC (N C) (PROG NIL GLLABEL1 (COND ((GREATERP N 0) (SETQ N (SUB1 N)) (
PBOUT C) (GO GLLABEL1)))))

(DE WINDOW-CLEAR (W) (PROG (TTL NBL Y NLINES) (SETQ NLINES 0) NIL (SETQ Y (
SUB1 (CADR (CADDR W)))) (PROG NIL GLLABEL1 (COND ((NOT (LESSP Y (CAR (PNTH W 
5)))) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS Y (CADADR W))) (
PBOUT 124) (COND ((LESSP Y (PLUS (CADADR W) (CADR (CADDR W)))) (PBOUT (CHAR 
ESC)) (PBOUT (CHAR K)))) (PROG (X) (SETQ X (SUB1 (CAADDR W))) (
TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PBOUT 
124) (COND ((GREATERP (SETQ NLINES (ADD1 NLINES)) 3) (TERPRI) (SETQ NLINES 
0))) (SETQ Y (SUB1 Y)) (GO GLLABEL1)))) NIL (TERMINAL-MOVETOXY TERMINAL (
PLUS 0 (CAADR W)) (PLUS -1 (CADADR W))) (TERPRI) (RPLACA (PNTH W 5) (CADR (
CADDR W))) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W))))
)

(DE WINDOW-CLOSE (W) (PROG (Y NLINES) (SETQ Y (CADR (CADDR W))) (SETQ NLINES 
0) (PROG NIL GLLABEL1 (COND ((NOT (LESSP Y 0)) (TERMINAL-MOVETOXY TERMINAL (
PLUS 0 (CAADR W)) (PLUS Y (CADADR W))) (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (
COND ((GREATERP (SETQ NLINES (ADD1 NLINES)) 8) (TERPRI) (SETQ NLINES 0))) (
SETQ Y (SUB1 Y)) (GO GLLABEL1)))) (TERPRI)))

(DE WINDOW-DRAWLINE (W FROM TO) (COND ((EQN (CADR FROM) (CADR TO)) (PROG (X 
Y) (SETQ X (CAR FROM)) (SETQ Y (CADR FROM)) (TERMINAL-MOVETOXY TERMINAL (
PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (ADD1 (DIFFERENCE (CAR TO) (
CAR FROM))) 45) (COND ((LESSP (CADR FROM) (CAR (PNTH W 5))) (CAR (RPLACA (
PNTH W 5) (CADR FROM))))))))

(DE WINDOW-INVERTAREA (W AREA) NIL)

(DE WINDOW-MOVETO (W POS) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (
RETURN (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W))))))

(DE WINDOW-MOVETOXY (W X Y) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (
PLUS Y (CADADR W))))

(DE WINDOW-OPEN (W) (PROG (TTL NBL L) (PROG (Y) (SETQ Y (CADR (CADDR W))) (
TERMINAL-MOVETOXY TERMINAL (PLUS 1 (CAADR W)) (PLUS Y (CADADR W)))) (SETQ 
TTL (OR (CADDDR W) " ")) (SETQ L (ADD1 (SIZE TTL))) NIL (COND ((GREATERP (
ADD1 (SIZE TTL)) (DIFFERENCE (CAADDR W) 2)) (SETQ TTL (SUBSTRING TTL 1 (
DIFFERENCE (CAADDR W) 2))))) (SETQ NBL (SUB1 (QUOTIENT (DIFFERENCE (CAADDR W) (
ADD1 (SIZE TTL))) 2))) (PRINTNC NBL 32) (TERMINAL-PRINTSTRING TERMINAL TTL) (
PRINTNC (DIFFERENCE (DIFFERENCE (DIFFERENCE (CAADDR W) (ADD1 (SIZE TTL))) 
NBL) 2) 32) NIL (TERPRI) NIL (RPLACA (PNTH W 5) 1) (PROG (Y) (SETQ Y (CADR (
CADDR W))) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS Y (CADADR W))))
(PBOUT 124) (PROG (X Y) (SETQ X (SUB1 (CAADDR W))) (SETQ Y (CADR (CADDR W))) (
TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PBOUT 
124) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS 0 (CADADR W))) (
PBOUT 124) (PRINTNC (DIFFERENCE (CAADDR W) 2) 95) (PBOUT 124) (PBOUT (CHAR 
ESC)) (PBOUT (CHAR K)) NIL (TERPRI) (WINDOW-CLEAR W) (TERMINAL-MOVETOXY 
TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))))

(DE WINDOW-PRETTYPRINTAT (W VALUE POSITION) (PROG (X Y) (SETQ X (CAR 
POSITION)) (SETQ Y (CADR POSITION)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
CAADR W)) (PLUS Y (CADADR W)))) (RESETLST (RESETSAVE SYSPRETTYFLG T) (
RESETSAVE TTYLINELENGTH (SUB1 (DIFFERENCE (CAADDR W) (CAR POSITION)))) (
SHOWPRINT VALUE) (CAR (RPLACA (PNTH W 5) 1))))

(DE WINDOW-PRINTAT (W S POS) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (
SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
CAADR W)) (PLUS Y (CADADR W)))) (TERMINAL-PRINTSTRING TERMINAL S) (TERPRI) (
COND ((LESSP (CADR POS) (CAR (PNTH W 5))) (CAR (RPLACA (PNTH W 5) (CADR POS)))))
)))

(DE WINDOW-UNDRAWLINE (W FROM TO) (COND ((EQN (CADR FROM) (CADR TO)) (PROG (
X Y) (SETQ X (CAR FROM)) (SETQ Y (CADR FROM)) (TERMINAL-MOVETOXY TERMINAL (
PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (ADD1 (DIFFERENCE (CAR TO) (
CAR FROM))) 32))))

(DE WINDOW-UNPRINTAT (W S POS) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (
SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (ADD1 (SIZE S)) 32))))

(FLUID (QUOTE (N)))

(GLOBAL (QUOTE (GEVMENUWINDOW GEVSAVEESC GEVSAVEGLQUIET GEVSAVEGCGAG 
GEVMOUSEAREA GLQUIETFLG GLLISPDIALECT GEVTYPENAMES GLUSERSTRNAMES MOUSE 
TERMINAL)))

(DE GEVENTER NIL (SETQ GEVSAVEGCGAG *GC) (SETQ *GC NIL) (SETQ GEVSAVEGLQUIET 
GLQUIETFLG) (SETQ GLQUIETFLG T) (ECHOOFF))

(DE GEVEXIT NIL (SETQ *GC GEVSAVEGCGAG) (SETQ GLQUIETFLG GEVSAVEGLQUIET) (
ECHOON))

(DE GEVINITEDITWINDOW NIL (PROG NIL (SETQ GEVWINDOW (LIST (QUOTE WINDOW) (
APPEND (QUOTE (0 3)) NIL) (APPEND (QUOTE (46 20)) NIL) 
"GEV Structure Inspector" 0)) (RETURN GEVWINDOW)))

(DE GEVMOUSELOOP NIL (PROG (INP N TMP) LP (TERMINAL-MOVETOXY TERMINAL (PLUS 
0 (CAADR GEVWINDOW)) (PLUS -1 (CADADR GEVWINDOW))) (PBOUT (CHAR ESC)) (PBOUT (
CHAR K)) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR GEVWINDOW)) (PLUS -1 (
CADADR GEVWINDOW))) (TERMINAL-PRINTSTRING TERMINAL "GEV: ") (ECHOON) (SETQ 
INP (READ)) (ECHOOFF) (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (COND ((AND (EQUAL 
INP T) (NUMBERP (SETQ N (READ)))) (GEVNSELECT N NIL) (GO LP)) ((NUMBERP INP) (
GEVNSELECT INP T) (GO LP)) ((SETQ TMP (ASSOC INP (QUOTE ((Q QUIT) (POP POP) (
E EDIT) (PR PROGRAM) (P PROP) (A ADJ) (I ISA) (M MSG))))) (GEVCOMMANDFN (
CADR TMP)) (COND ((OR (EQ (CADR TMP) (QUOTE QUIT)) (NOT GEVACTIVEFLG)) (
TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR GEVWINDOW)) (PLUS -1 (CADADR 
GEVWINDOW))) (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (RETURN NIL)) (T (GO LP)))) ((
EQ INP (QUOTE R)) (WINDOW-OPEN GEVWINDOW) (GEVFILLWINDOW) (GO LP)) (T (PRIN1 
"? Quit POP Edit PRogram Prop Adj Isa Msg Redraw") (TERPRI) (GO LP)))))

(DE GEVNSELECT (N FLAG) (PROG (L TOP SUBLIST GROUP ITEM) (SETQ GROUP 0) (
SETQ TOP (CAR GEVEDITCHAIN)) LP (COND ((NOT TOP) (RETURN NIL))) (SETQ 
SUBLIST (CAR TOP)) (SETQ TOP (CDR TOP)) (SETQ GROUP (ADD1 GROUP)) (COND ((
AND (EQN GROUP 1) (NOT (LESSP (SETQ L (LENGTH SUBLIST)) N))) (SETQ ITEM (CAR (
PNTH SUBLIST (DIFFERENCE (ADD1 L) N))))) ((NOT (SETQ ITEM (GEVNTHITEM 
SUBLIST))) (GO LP))) (COND ((MEMQ (CAR (PNTH ITEM 5)) (QUOTE (STRUCTURE 
SUBTREE LISTOF))) (RETURN NIL)) (T (RETURN (GEVITEMEVENTFN ITEM GROUP FLAG))))))

(DE GEVNTHITEM (L) (PROG (TMP RES) (COND ((NOT (GREATERP N 0)) (ERROR 0 NIL)) ((
NOT L) (RETURN NIL)) ((EQN N 1) (RETURN (CAR L))) (T (SETQ N (SUB1 N)) (SETQ 
TMP (CAR L)) (SETQ L (CDR L)) (COND ((AND (MEMQ (CAR (PNTH TMP 5)) (QUOTE (
STRUCTURE SUBTREE LISTOF))) (SETQ RES (GEVNTHITEM (CAR (PNTH TMP 6))))) (
RETURN RES)) (T (RETURN (GEVNTHITEM L))))))))

(GLISPCONSTANTS (GEVNUMBERCHARS 2 INTEGER) (GEVNUMBERPOS 1 INTEGER))

(SETQ GEVMENUWINDOW NIL)

(SETQ GEVMOUSEAREA NIL)

(FLUID (QUOTE (GLNATOM RESULT Y)))

(GLOBAL (QUOTE (GEVACTIVEFLG GEVEDITCHAIN GEVEDITFLG GEVLASTITEMNUMBER 
GEVMENUWINDOW GEVMENUWINDOWHEIGHT GEVMOUSEAREA GEVSHORTCHARS GEVWINDOW 
GEVWINDOWY)))

(GLISPGLOBALS (GEVACTIVEFLG BOOLEAN) (GEVEDITCHAIN EDITCHAIN) (GEVEDITFLG 
BOOLEAN) (GEVLASTITEMNUMBER INTEGER) (GEVMENUWINDOW WINDOW) (
GEVMENUWINDOWHEIGHT INTEGER) (GEVMOUSEAREA MOUSESTATE) (GEVSHORTCHARS 
INTEGER) (GEVWINDOW WINDOW) (GEVWINDOWY INTEGER))

(GLISPCONSTANTS (GEVMOUSEBUTTON 4 INTEGER) (GEVNAMECHARS 11 INTEGER) (
GEVVALUECHARS 27 INTEGER) (GEVNAMEPOS (GEVNUMBERPOS !+ (IF GEVNUMBERCHARS > 
0 THEN (GEVNUMBERCHARS !+ 1) *WINDOWCHARWIDTH ELSE 0)) INTEGER) (GEVTILDEPOS (
GEVNAMEPOS !+ (GEVNAMECHARS+1) *WINDOWCHARWIDTH) INTEGER) (GEVVALUEPOS (
GEVTILDEPOS !+ !2*WINDOWCHARWIDTH) INTEGER))

(GLISPOBJECTS (EDITCHAIN (LISTOF EDITFRAME) PROP ((TOPFRAME ((CAR SELF))) (
TOPITEM ((CAR TOPFRAME:PREVS))))) (EDITFRAME (LIST (PREVS (LISTOF GSEITEM)) (
SUBITEMS (LISTOF GSEITEM)) (PROPS (LISTOF GSEITEM)))) (GSEITEM (LIST (NAME 
ATOM) (VALUE ANYTHING) (TYPE ANYTHING) (SHORTVALUE ATOM) (NODETYPE ATOM) (
SUBVALUES (LISTOF GSEITEM)) (NAMEPOS VECTOR) (VALUEPOS VECTOR)) PROP ((
NAMEAREA ((VIRTUAL REGION WITH START = NAMEPOS WIDTH = WINDOWCHARWIDTH* (
NCHARS NAME) HEIGHT = WINDOWLINEYSPACING))) (VALUEAREA ((VIRTUAL REGION WITH 
START = VALUEPOS WIDTH = WINDOWCHARWIDTH* (NCHARS NAME) HEIGHT = 
WINDOWLINEYSPACING))))) (MOUSESTATE (LIST (AREA REGION) (ITEM GSEITEM) (FLAG 
BOOLEAN) (GROUP INTEGER))))

(DF GEV (ARGS) (GEVA (CAR ARGS) (EVAL (CAR ARGS)) (AND (CDR ARGS) (COND ((OR (
NOT (ATOM (CADR ARGS))) (NOT (UNBOUNDP (CADR ARGS)))) (EVAL (CADR ARGS))) (T (
CADR ARGS))))))

(DE GEVA (VAR VAL STR) (PROG (GLNATOM TMP HEADER) (GEVENTER) (COND ((OR (NOT (
NOT (UNBOUNDP (QUOTE GEVWINDOW)))) (NULL GEVWINDOW)) (GEVINITEDITWINDOW))) (
COND (GEVMENUWINDOW (WINDOW-OPEN GEVMENUWINDOW))) (WINDOW-OPEN GEVWINDOW) (
SETQ GEVACTIVEFLG T) (SETQ GEVEDITFLG NIL) (SETQ GLNATOM 0) (SETQ 
GEVSHORTCHARS 27) (COND ((AND (PAIRP VAR) (EQ (CAR VAR) (QUOTE QUOTE))) (
SETQ VAR (CONCAT "'" (GEVSTRINGIFY (CADR VAR)))))) (COND ((NOT STR) (COND ((
AND (ATOM VAL) (GET VAL (QUOTE GLSTRUCTURE))) (SETQ STR (QUOTE GLTYPE))) ((
GEVGLISPP) (SETQ STR (GLCLASS VAL)))))) (SETQ HEADER (LIST VAR VAL STR NIL 
NIL NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL))) (SETQ 
GEVEDITCHAIN (LIST (LIST (LIST HEADER) NIL NIL))) (GEVREFILLWINDOW) (
GEVMOUSELOOP) (GEVEXIT)))

(DE GEVCOMMANDFN (COMMANDWORD) (PROG (PL SUBPL PROPNAME VAL PROPNAMES 
TOPITEM) (CASEQ COMMANDWORD (EDIT (GEVEDIT)) (QUIT (COND (GEVMOUSEAREA (PROG (
AREA) (SETQ AREA (CAR GEVMOUSEAREA))) (SETQ GEVMOUSEAREA NIL)) (T (GEVQUIT)))) (
POP (GEVPOP T 1)) (PROGRAM (GEVPROGRAM)) ((PROP ADJ ISA MSG) (SETQ TOPITEM (
CAAAR GEVEDITCHAIN)) (GEVCOMMANDPROP TOPITEM COMMANDWORD NIL)) (T (ERROR 
0 NIL)))))

(DE GEVCOMMANDPROP (ITEM COMMANDWORD PROPNAME) (PROG (VAL PROPNAMES FLG) (
COND (PROPNAME (SETQ FLG T))) (COND ((ATOM (CADDR ITEM)) (SETQ PROPNAMES (
GEVCOMMANDPROPNAMES (CADDR ITEM) COMMANDWORD (CAR GEVEDITCHAIN))))) (COND ((
OR (ATOM (CADDR ITEM)) (EQ COMMANDWORD (QUOTE PROP))) (COND ((EQ COMMANDWORD (
QUOTE PROP)) (COND ((CDR PROPNAMES) (SETQ PROPNAMES (CONS (QUOTE ALL) 
PROPNAMES)))) (SETQ PROPNAMES (CONS (QUOTE SELF) PROPNAMES)))) (COND ((NOT 
PROPNAMES) (RETURN NIL))) (COND ((NOT PROPNAME) (SETQ PROPNAME (MENU-SELECT (
LIST (QUOTE MENU) PROPNAMES (COPY (QUOTE (WINDOW (0 0) (0 0) NIL 0)))))))) (
COND ((NOT PROPNAME) (RETURN NIL)) ((EQ PROPNAME (QUOTE SELF)) (PRIN1 
PROPNAME) (PRINC " = ") (PRINT (CADR ITEM))) ((AND (EQ COMMANDWORD (QUOTE 
PROP)) (EQ PROPNAME (QUOTE ALL))) (MAPC (OR (CDDR PROPNAMES) (CDR PROPNAMES)) (
FUNCTION (LAMBDA (X) (GEVDOPROP ITEM X COMMANDWORD FLG))))) (T (GEVDOPROP 
ITEM PROPNAME COMMANDWORD FLG))) (COND ((EQ COMMANDWORD (QUOTE MSG)) (
GEVREFILLWINDOW) (SETQ GEVEDITFLG T)))))))

(DE GEVCOMMANDPROPNAMES (OBJ PROPTYPE TOPFRAME) (PROG (RESULT TYPE) (SETQ 
RESULT (MAPCAN (CASEQ PROPTYPE (PROP (LISTGET (CDR (GET OBJ (QUOTE 
GLSTRUCTURE))) (QUOTE PROP))) (ADJ (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE)))
(QUOTE ADJ))) (ISA (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE ISA))) (
MSG (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE MSG)))) (FUNCTION (
LAMBDA (P) (AND (NOT (AND (NE PROPTYPE (QUOTE MSG)) (CAR (SOME (CADDR 
TOPFRAME) (FUNCTION (LAMBDA (GLVAR1) (EQ (CAR GLVAR1) (CAR P)))))))) (NOT (
AND (EQ PROPTYPE (QUOTE PROP)) (MEMQ (CAR P) (QUOTE (SHORTVALUE DISPLAYPROPS))))
) (NOT (AND (EQ PROPTYPE (QUOTE MSG)) (ATOM (CADR P)) (OR (NOT (GETDDD (CADR 
P))) (GREATERP (LENGTH (CADR (GETDDD (CADR P)))) 1)))) (CONS (CAR P) NIL)))))) (
MAPC (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE SUPERS)) (FUNCTION (
LAMBDA (S) (SETQ RESULT (NCONC RESULT (GEVCOMMANDPROPNAMES S PROPTYPE 
TOPFRAME)))))) (RETURN RESULT)))

(DE GEVCOMPPROP (STR PROPNAME PROPTYPE) (PROG (PROPENT) (COND ((NOT (MEMQ 
PROPTYPE (QUOTE (ADJ ISA PROP MSG)))) (RETURN (QUOTE GEVERROR)))) (COND ((
AND (SETQ PROPENT (GEVGETPROP STR PROPNAME PROPTYPE)) (ATOM (CADR PROPENT))) (
RETURN (CADR PROPENT)))) (RETURN (COND ((GEVGLISPP) (OR (GLCOMPPROP STR 
PROPNAME PROPTYPE) (QUOTE GEVERROR))) (T (ERROR 0 (LIST 
"GLISP compiler must be loaded for PROPs which" 
"are not specified with function name equivalents." STR PROPTYPE PROPNAME)))))))

(DE GEVDATANAMES (OBJ FILTER) (PROG (RESULT) (GEVDATANAMESB (CAR (GET OBJ (
QUOTE GLSTRUCTURE))) FILTER) (RETURN (REVERSIP RESULT))))

(DE GEVDATANAMESB (STR FILTER) (PROG (TMP) (COND ((ATOM STR) (RETURN NIL)) (
T (CASEQ (CAR STR) (CONS (GEVDATANAMESB (CADR STR) FILTER) (GEVDATANAMESB (
CADDR STR) FILTER)) ((ALIST PROPLIST LIST) (MAPC (CDR STR) (FUNCTION (LAMBDA (
X) (GEVDATANAMESB X FILTER))))) (RECORD (MAPC (CDDR STR) (FUNCTION (LAMBDA (
X) (GEVDATANAMESB X FILTER))))) (ATOM (GEVDATANAMESB (CADR STR) FILTER) (
GEVDATANAMESB (CADDR STR) FILTER)) (BINDING (GEVDATANAMESB (CADR STR) FILTER)) (
LISTOF (RETURN NIL)) (T (COND ((GEVFILTER (CADR STR) FILTER) (SETQ RESULT (
CONS (LIST (CAR STR) (CADR STR)) RESULT)))) (GEVDATANAMESB (CADR STR) FILTER))))
)))

(DE GEVDISPLAYNEWPROP NIL (PROG (Y NEWONE) (SETQ Y GEVWINDOWY) (SETQ NEWONE (
CAR (LASTPAIR (CADDAR GEVEDITCHAIN)))) (GEVPPS NEWONE 0 GEVWINDOW) (SETQ 
GEVWINDOWY Y)))

(DE GEVDOPROP (ITEM PROPNAME COMMANDWORD FLG) (PROG (VAL) (SETQ VAL (
GEVEXPROP (CADR ITEM) (CADDR ITEM) PROPNAME COMMANDWORD NIL)) (RPLACA (CDDAR 
GEVEDITCHAIN) (ACONC (CADDAR GEVEDITCHAIN) (LIST PROPNAME VAL (GEVPROPTYPE (
CADDR ITEM) PROPNAME COMMANDWORD) NIL COMMANDWORD NIL (APPEND (QUOTE (0 
0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) (COND ((NOT FLG) (GEVDISPLAYNEWPROP)))))

(DE GEVEDIT NIL (PROG (CHANGEDFLG GEVTOPITEM) (SETQ GEVTOPITEM (CAAAR 
GEVEDITCHAIN)) (COND ((AND (ATOM (CADDR GEVTOPITEM)) (NE (GEVEXPROP (CADR 
GEVTOPITEM) (CADDR GEVTOPITEM) (QUOTE EDIT) (QUOTE MSG) NIL) (QUOTE GEVERROR)))
(SETQ CHANGEDFLG T)) ((PAIRP (CADR GEVTOPITEM)) (EDITV (CADR GEVTOPITEM)) (
SETQ CHANGEDFLG T)) (T (RETURN NIL))) (COND (CHANGEDFLG (WINDOW-OPEN 
GEVWINDOW) (GEVREFILLWINDOW))) (SETQ GEVEDITFLG CHANGEDFLG)))

(DE GEVEXPROP (OBJ STR PROPNAME PROPTYPE ARGS) (PROG (FN) (COND ((OR (NOT (
MEMQ PROPTYPE (QUOTE (ADJ ISA PROP MSG)))) (AND ARGS (NE PROPTYPE (QUOTE MSG))))
(RETURN (QUOTE GEVERROR)))) (COND ((EQ (SETQ FN (GEVCOMPPROP STR PROPNAME 
PROPTYPE)) (QUOTE GEVERROR)) (RETURN FN)) (T (RETURN (GEVAPPLY FN (CONS OBJ 
ARGS)))))))

(DE GEVFILLWINDOW NIL (PROG (Y TOP) (WINDOW-CLEAR GEVWINDOW) (SETQ Y (SUB1 (
CADR (CADDR GEVWINDOW)))) (SETQ GEVLASTITEMNUMBER 0) (SETQ TOP (CAR 
GEVEDITCHAIN)) (MAPC (REVERSE (CAR TOP)) (FUNCTION (LAMBDA (X) (GEVPPS X 
0 GEVWINDOW)))) (GEVHORIZLINE GEVWINDOW) (MAPC (CADR TOP) (FUNCTION (LAMBDA (
X) (GEVPPS X 0 GEVWINDOW)))) (GEVHORIZLINE GEVWINDOW) (MAPC (CADDR TOP) (
FUNCTION (LAMBDA (X) (GEVPPS X 0 GEVWINDOW)))) (SETQ GEVWINDOWY Y)))

(DE GEVFILTER (TYPE FILTER) (SETQ TYPE (GEVXTRTYPE TYPE)) (CASEQ FILTER (
NUMBER (AND (NOT (MEMQ TYPE (QUOTE (ATOM STRING BOOLEAN ANYTHING)))) (NOT (
AND (PAIRP TYPE) (EQ (CAR TYPE) (QUOTE LISTOF)))))) (LIST (AND (PAIRP TYPE) (
EQ (CAR TYPE) (QUOTE LISTOF)))) (T T)))

(DE GEVFINDITEMPOS (POS ITEM N) (OR (GEVPOSTEST POS (CAR (PNTH ITEM 7)) (CAR 
ITEM) ITEM NIL N) (GEVPOSTEST POS (CAR (PNTH ITEM 8)) (CADDDR ITEM) ITEM T N) (
AND (OR (EQ (CAR (PNTH ITEM 5)) (QUOTE STRUCTURE)) (EQ (CAR (PNTH ITEM 
5)) (QUOTE SUBTREE)) (EQ (CAR (PNTH ITEM 5)) (QUOTE LISTOF))) (
GEVFINDLISTPOS POS (CAR (PNTH ITEM 6)) N))))

(DE GEVFINDLISTPOS (POS ITEMS N) (COND (ITEMS (OR (GEVFINDITEMPOS POS (CAR 
ITEMS) N) (GEVFINDLISTPOS POS (CDR ITEMS) N)))))

(DE GEVFINDPOS (POS FRAME) (PROG (TMP N ITEMS) (SETQ N 0) (PROG NIL GLLABEL1 (
COND ((AND FRAME (NOT TMP)) (SETQ N (ADD1 N)) (SETQ ITEMS (CAR FRAME)) (SETQ 
FRAME (CDR FRAME)) (SETQ TMP (GEVFINDLISTPOS POS ITEMS N)) (GO GLLABEL1)))) (
RETURN TMP)))

(DE GEVGETNAMES (OBJ FILTER) (PROG (DATANAMES PROPNAMES) (SETQ DATANAMES (
GEVDATANAMES OBJ FILTER)) (SETQ PROPNAMES (GEVPROPNAMES OBJ (QUOTE PROP) 
FILTER)) (RETURN (NCONC DATANAMES PROPNAMES))))

(DE GEVGETPROP (STR PROPNAME PROPTYPE) (PROG (PL SUBPL PROPENT) (COND ((NOT (
MEMQ PROPTYPE (QUOTE (ADJ ISA PROP MSG)))) (ERROR 0 NIL))) (RETURN (AND (
SETQ PL (GET STR (QUOTE GLSTRUCTURE))) (SETQ SUBPL (LISTGET (CDR PL) 
PROPTYPE)) (SETQ PROPENT (ASSOC PROPNAME SUBPL))))))

(DE GEVGLISPP NIL (NOT (UNBOUNDP (QUOTE GLBASICTYPES))))

(DE GEVHORIZLINE (W) (PROG (FROM TO) (SETQ FROM (LIST 1 (PLUS Y 0))) (SETQ 
TO (LIST (DIFFERENCE (CAADDR W) 2) (PLUS Y 0))) (COND ((EQN (CADR FROM) (
CADR TO)) (PROG (X Y) (SETQ X (CAR FROM)) (SETQ Y (CADR FROM)) (
TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (
ADD1 (DIFFERENCE (CAR TO) (CAR FROM))) 45) (COND ((LESSP (CADR FROM) (CAR (
PNTH W 5))) (RPLACA (PNTH W 5) (CADR FROM))))))) (SETQ Y (SUB1 Y)))

(DE GEVINIT NIL (SETQ GLNATOM 0) (COND ((NOT (NOT (UNBOUNDP (QUOTE 
GLLISPDIALECT)))) (SETQ GLLISPDIALECT (QUOTE INTERLISP)))) (SETQ GEVWINDOW 
NIL))

(DE GEVITEMEVENTFN (ITEM GROUP FLAG) (PROG (TMP TOP N) (COND (FLAG (COND ((
EQN GROUP 1) (SETQ TMP (CAAR GEVEDITCHAIN)) (SETQ N 0) (PROG NIL GLLABEL1 (
COND ((AND TMP (NOT (EQUAL (PROG1 (SETQ TOP (CAR TMP)) (SETQ TMP (CDR TMP))) 
ITEM))) (SETQ N (ADD1 N)) (GO GLLABEL1)))) (GEVPOP NIL N)) (T (GEVPUSH ITEM))))
(T (PRIN1 (CAR ITEM)) (PRINC " is ") (PRIN1 (CADDR ITEM)) (TERPRI)))))

(DE GEVLENGTHBOUND (VAL NCHARS) (COND ((GREATERP (FLATSIZE2 VAL) NCHARS) (
CONCAT (SUBSTRING VAL 1 (SUB1 NCHARS)) "-")) (T VAL)))

(DE GEVMAKENEWFN (OPERATION INPUTTYPE SET PATH) (PROG (LASTPATH VIEWSPEC) (
SETQ LASTPATH (CAR (LASTPAIR PATH))) (RETURN (LIST (LIST (QUOTE GLAMBDA) (
LIST (MKATOM (CONCAT "GEVNEWFNTOP:" (ID2STRING INPUTTYPE)))) (LIST (QUOTE 
PROG) (CONS (QUOTE GEVNEWFNVALUE) (CASEQ OPERATION (COLLECT (QUOTE (
GEVNEWFNRESULT))) ((MAXIMUM MINIMUM) (QUOTE (GEVNEWFNTESTVAL 
GEVNEWFNINSTANCE))) (TOTAL (QUOTE ((GEVNEWFNSUM 0)))) (AVERAGE (QUOTE ((
GEVNEWFNSUM 0.0) (GEVNEWFNCOUNT 0)))) (T (ERROR 0 NIL)))) (NCONC (LIST (
QUOTE FOR) (QUOTE GEVNEWFNLOOPVAR) (QUOTE IN) (MKATOM (CONCAT "GEVNEWFNTOP:" (
ID2STRING (CAR SET)))) (QUOTE DO) (LIST (QUOTE GEVNEWFNVALUE) (QUOTE _) (
PROGN (SETQ VIEWSPEC (LIST (QUOTE GEVNEWFNLOOPVAR))) (MAPC PATH (FUNCTION (
LAMBDA (X) (SETQ VIEWSPEC (CONS (QUOTE OF) VIEWSPEC)) (SETQ VIEWSPEC (CONS (
CAR X) VIEWSPEC)) (SETQ VIEWSPEC (CONS (QUOTE THE) VIEWSPEC))))) VIEWSPEC))) (
COPY (CASEQ OPERATION (COLLECT (QUOTE ((GEVNEWFNRESULT !+_ GEVNEWFNVALUE)))) (
MAXIMUM (QUOTE ((IF ~ GEVNEWFNINSTANCE OR GEVNEWFNVALUE > GEVNEWFNTESTVAL 
THEN (GEVNEWFNTESTVAL _ GEVNEWFNVALUE) (GEVNEWFNINSTANCE _ GEVNEWFNLOOPVAR)))))
(MINIMUM (QUOTE ((IF ~ GEVNEWFNINSTANCE OR GEVNEWFNVALUE < GEVNEWFNTESTVAL 
THEN (GEVNEWFNTESTVAL _ GEVNEWFNVALUE) (GEVNEWFNINSTANCE _ GEVNEWFNLOOPVAR)))))
(AVERAGE (QUOTE ((GEVNEWFNSUM _+ GEVNEWFNVALUE) (GEVNEWFNCOUNT _+ 1)))) (
TOTAL (QUOTE ((GEVNEWFNSUM _+ GEVNEWFNVALUE))))))) (LIST (QUOTE RETURN) (
CASEQ OPERATION (COLLECT (QUOTE (DREVERSE GEVNEWFNRESULT))) ((MAXIMUM 
MINIMUM) (QUOTE (LIST GEVNEWFNTESTVAL GEVNEWFNINSTANCE))) (AVERAGE (QUOTE (
QUOTIENT GEVNEWFNSUM (FLOAT GEVNEWFNCOUNT)))) (TOTAL (QUOTE GEVNEWFNSUM)))))) (
CASEQ OPERATION (COLLECT (LIST (QUOTE LISTOF) (CADR LASTPATH))) ((MAXIMUM 
MINIMUM) (LIST (QUOTE LIST) (COPY LASTPATH) (LIST (QUOTE WINNER) (CADADR SET))))
(AVERAGE (QUOTE REAL)) (TOTAL (CADR LASTPATH)))))))

(DE GEVMATCH (STR VAL FLG) (PROG (RESULT) (GEVMATCHB STR VAL NIL FLG) (
RETURN (REVERSIP RESULT))))

(DE GEVMATCHA (STR VAL FLG) (PROG (RES) (SETQ RES (GEVMATCH STR VAL FLG)) (
COND ((NOT (CDR RES)) (RETURN (CAR RES))) (T (RETURN (LIST NIL VAL STR NIL (
QUOTE SUBTREE) RES (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))))))

(DE GEVMATCHATOM (STR VAL NAME) (PROG (L STRB TMP) (COND ((OR (NOT (ATOM VAL)) (
NULL VAL)) (RETURN NIL))) (SETQ STRB (CADR STR)) (COND ((NE (CAR STRB) (
QUOTE PROPLIST)) (RETURN NIL))) (SETQ L (CDR STRB)) (MAPC L (FUNCTION (
LAMBDA (X) (COND ((SETQ TMP (GET VAL (CAR X))) (GEVMATCHB X TMP NIL NIL))))))))

(DE GEVMATCHALIST (STR VAL NAME) (PROG (L TMP) (SETQ L (CDR STR)) (MAPC L (
FUNCTION (LAMBDA (X) (COND ((SETQ TMP (ASSOC (CAR X) VAL)) (GEVMATCHB X (CDR 
TMP) NIL NIL))))))))

(DE GEVMATCHB (STR VAL NAME FLG) (PROG (X Y STRB XSTR TOP TMP) (SETQ XSTR (
GEVXTRTYPE STR)) (COND ((ATOM STR) (COND ((AND FLG (SETQ STRB (CAR (GET STR (
QUOTE GLSTRUCTURE))))) (SETQ RESULT (CONS (LIST NAME VAL STR NIL (QUOTE 
STRUCTURE) (GEVMATCH STRB VAL NIL) (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (
0 0)) NIL)) RESULT))) (T (SETQ RESULT (CONS (LIST NAME VAL STR NIL NIL NIL (
APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) RESULT)))) (RETURN NIL)) (
T (CASEQ (CAR STR) (CONS (GEVMATCHB (CADR STR) (CAR VAL) NIL NIL) (GEVMATCHB (
CADDR STR) (CDR VAL) NIL NIL)) (LIST (MAPC (CDR STR) (FUNCTION (LAMBDA (X) (
COND (VAL (GEVMATCHB X (CAR VAL) NIL NIL) (SETQ VAL (CDR VAL)))))))) (ATOM (
GEVMATCHATOM STR VAL NAME)) (ALIST (GEVMATCHALIST STR VAL NAME)) (PROPLIST (
GEVMATCHPROPLIST STR VAL NAME)) (LISTOF (GEVMATCHLISTOF STR VAL NAME)) (
RECORD (GEVMATCHRECORD STR VAL NAME)) ((OBJECT ATOMOBJECT LISTOBJECT) (
GEVMATCHOBJECT STR VAL NAME)) (T (COND (NAME (SETQ TMP (GEVMATCH STR VAL NIL)) (
SETQ TOP (CAR TMP)) (SETQ RESULT (CONS (COND ((AND (NOT (CDR TMP)) (NOT (CAR 
TOP))) (RPLACA TOP NAME) TOP) (T (LIST NAME VAL XSTR NIL (QUOTE SUBTREE) TMP (
APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) RESULT))) ((ATOM (
SETQ STRB (GEVXTRTYPE (CADR STR)))) (GEVMATCHB STRB VAL (CAR STR) NIL)) ((
SETQ TMP (GEVMATCH (CADR STR) VAL NIL)) (SETQ TOP (CAR TMP)) (SETQ RESULT (
CONS (COND ((AND (NOT (CDR TMP)) (NOT (CAR TOP))) (RPLACA TOP (CAR STR)) TOP) (
T (LIST (CAR STR) VAL (CADR STR) NIL (QUOTE SUBTREE) TMP (APPEND (QUOTE (
0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) RESULT))) (T (PRINT "GEVMATCHB Failed")
))))))))

(DE GEVMATCHLISTOF (STR VAL NAME) (SETQ RESULT (CONS (LIST NAME VAL STR NIL 
NIL NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) RESULT)))

(DE GEVMATCHOBJECT (STR VAL NAME) (PROG (OBJECTTYPE TMP) (SETQ OBJECTTYPE (
CAR STR)) (SETQ RESULT (ACONC RESULT (LIST (QUOTE CLASS) (CASEQ OBJECTTYPE ((
OBJECT LISTOBJECT) (PROG1 (SETQ TMP (CAR VAL)) (SETQ VAL (CDR VAL)))) (
ATOMOBJECT (GET VAL (QUOTE CLASS)))) (QUOTE GLTYPE) NIL NIL NIL (APPEND (
QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) (MAPC (CDR STR) (FUNCTION (
LAMBDA (X) (CASEQ OBJECTTYPE ((OBJECT LISTOBJECT) (COND (VAL (GEVMATCHB X (
PROG1 (SETQ TMP (CAR VAL)) (SETQ VAL (CDR VAL))) NIL NIL)))) (ATOMOBJECT (
COND ((SETQ TMP (GET VAL (CAR X))) (GEVMATCHB X TMP NIL NIL))))))))))

(DE GEVMATCHPROPLIST (STR VAL NAME) (PROG (L TMP) (SETQ L (CDR STR)) (MAPC L (
FUNCTION (LAMBDA (X) (COND ((SETQ TMP (LISTGET VAL (CAR X))) (GEVMATCHB X 
TMP NIL NIL))))))))

(DE GEVMATCHRECORD (STR VAL NAME) (PROG (STRNAME FIELDS N) (COND ((ATOM (
CADR STR)) (SETQ STRNAME (CADR STR)) (SETQ FIELDS (CDDR STR))) (T (SETQ 
FIELDS (CDR STR)))) (SETQ N 0) (MAPC FIELDS (FUNCTION (LAMBDA (X) (SETQ N (
ADD1 N)) (GEVMATCHB X (GETV VAL N) (CAR X) NIL))))))

(DE GEVPOP (FLG N) (PROG (TMP TOP TMPITEM) (COND ((LESSP N 1) (RETURN NIL))) 
LP (SETQ TMP (CAR GEVEDITCHAIN)) (SETQ GEVEDITCHAIN (CDR GEVEDITCHAIN)) (
COND ((NOT GEVEDITCHAIN) (RETURN (GEVQUIT)))) (SETQ TOP (CAAAR GEVEDITCHAIN)) (
SETQ TMPITEM (CAAR TMP)) (COND ((AND FLG (EQ (CAR (PNTH TMPITEM 5)) (QUOTE 
FORWARD))) (GO LP))) (COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO LP))) (COND ((
AND (PAIRP (CADDR TOP)) (EQ (CAADDR TOP) (QUOTE LISTOF)) (NOT (CDADR TOP))) (
GO LP))) (COND ((AND GEVEDITFLG (NOT (MEMBER (CADDDR TMPITEM) (QUOTE ("(...)" 
"---"))))) (GEVREFILLWINDOW)) (T (SETQ GEVEDITFLG NIL) (GEVFILLWINDOW)))))

(DE GEVPOSTEST (POS TPOS NAME ITEM FLG N) (COND ((AND (NOT (LESSP (CADR POS) (
CADR TPOS))) (NOT (GREATERP (CADR POS) (ADD1 (CADR TPOS)))) (NOT (LESSP (CAR 
POS) (CAR TPOS))) (LESSP (CAR POS) (PLUS (CAR TPOS) 11))) (LIST (LIST (LIST (
CAR TPOS) (SUB1 (CADR TPOS))) (LIST (TIMES 1 (ADD1 (SIZE NAME))) 1)) ITEM 
FLG N))))

(DE GEVPPS (ITEM COL WINDOW) (PROG (NAMEX TOP) (COND ((LESSP Y 0) (RETURN 
NIL))) (SETQ GEVLASTITEMNUMBER (ADD1 GEVLASTITEMNUMBER)) (PROG (S POS) (SETQ 
S (GEVSTRINGIFY GEVLASTITEMNUMBER)) (SETQ POS (LIST 1 Y)) (COND ((GREATERP (
CADR POS) 0) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (
TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (
TERMINAL-PRINTSTRING TERMINAL S) (TERPRI) (COND ((LESSP (CADR POS) (CAR (
PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 5) (CADR POS))))))) (SETQ NAMEX (PLUS 
4 (TIMES COL 1))) (RPLACA (CAR (PNTH ITEM 7)) NAMEX) (RPLACA (CDAR (PNTH 
ITEM 7)) Y) (COND ((EQ (CAR (PNTH ITEM 5)) (QUOTE FULLVALUE)) (PROG (POS) (
SETQ POS (LIST NAMEX Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (SETQ X (
CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR 
WINDOW)) (PLUS Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL "(expanded)")
(TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH 
WINDOW 5) (CADR POS)))))))) ((CAR ITEM) (COND ((NUMBERP (CAR ITEM)) (PROG (
POS) (SETQ POS (LIST NAMEX Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (
SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL "#") (
TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 
5) (CADR POS))))))) (SETQ NAMEX (ADD1 NAMEX)))) (PROG (S POS) (SETQ S (
GEVLENGTHBOUND (CAR ITEM) 11)) (SETQ POS (LIST NAMEX Y)) (COND ((GREATERP (
CADR POS) 0) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (
TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (
TERMINAL-PRINTSTRING TERMINAL S) (TERPRI) (COND ((LESSP (CADR POS) (CAR (
PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 5) (CADR POS))))))))) (COND ((OR (NOT (
CAR (PNTH ITEM 5))) (MEMQ (CAR (PNTH ITEM 5)) (QUOTE (FORWARD BACKUP PROP 
ADJ MSG ISA)))) (RPLACA (CAR (PNTH ITEM 8)) 18) (RPLACA (CDAR (PNTH ITEM 
8)) Y) (PROG (S POS) (SETQ S (OR (CADDDR ITEM) (CAR (RPLACA (CDDDR ITEM) (
GEVSHORTVALUE (CADR ITEM) (CADDR ITEM) (DIFFERENCE GEVSHORTCHARS COL)))))) (
SETQ POS (LIST 18 Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (SETQ X (
CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR 
WINDOW)) (PLUS Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL S) (
TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 
5) (CADR POS))))))) (COND ((NE (CADDDR ITEM) (CADR ITEM)) (PROG (POS) (SETQ 
POS (LIST 16 Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (SETQ X (CAR POS)) (
SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS 
Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL "~") (TERPRI) (COND ((
LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 5) (CADR POS)))))))
)) (SETQ Y (SUB1 Y))) ((EQ (CAR (PNTH ITEM 5)) (QUOTE FULLVALUE)) (SETQ Y (
SUB1 Y)) (PROG (VALUE POSITION) (SETQ VALUE (CADR ITEM)) (SETQ POSITION (
LIST 1 Y)) (PROG (X Y) (SETQ X (CAR POSITION)) (SETQ Y (CADR POSITION)) (
TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (
RESETLST (RESETSAVE SYSPRETTYFLG T) (RESETSAVE TTYLINELENGTH (SUB1 (
DIFFERENCE (CAADDR WINDOW) (CAR POSITION)))) (SHOWPRINT VALUE) (CAR (RPLACA (
PNTH WINDOW 5) 1)))) (SETQ Y (SUB1 (CAR (PNTH WINDOW 5))))) ((EQ (CAR (PNTH 
ITEM 5)) (QUOTE DISPLAY)) (GEVEXPROP (CADR ITEM) (CADDR ITEM) (QUOTE 
GEVDISPLAY) (QUOTE MSG) (LIST WINDOW Y))) (T (SETQ Y (SUB1 Y)) (MAPC (CAR (
PNTH ITEM 6)) (FUNCTION (LAMBDA (VSUB) (GEVPPS VSUB (PLUS COL 2) WINDOW))))))))

(DE GEVPROGRAM NIL (PROG (TOPITEM COMMAND SET PATH DONE NEXT TYPE NEWFN 
RESULT LAST ABORTFLG) (SETQ TOPITEM (CAAAR GEVEDITCHAIN)) (COND ((OR (EQ (
SETQ COMMAND (MENU-SELECT (COPY (QUOTE (MENU (QUIT COLLECT TOTAL AVERAGE 
MAXIMUM MINIMUM) (WINDOW (0 0) (0 0) NIL 0)))))) (QUOTE QUIT)) (NOT COMMAND)) (
RETURN NIL))) (COND ((OR (EQ (SETQ SET (GEVPROPMENU (CADDR TOPITEM) (QUOTE 
LIST) NIL)) (QUOTE QUIT)) (EQ SET (QUOTE POP)) (NOT SET)) (RETURN NIL))) (
SETQ PATH (LIST SET (LIST (CAR TOPITEM) (CADDR TOPITEM)))) (SETQ NEXT SET) (
SETQ TYPE (CADADR SET)) (PROG NIL GLLABEL1 (COND ((AND (NOT DONE) (NOT 
ABORTFLG)) (SETQ NEXT (GEVPROPMENU TYPE (AND (NE COMMAND (QUOTE COLLECT)) (
QUOTE NUMBER)) (EQ COMMAND (QUOTE COLLECT)))) (COND ((ATOM NEXT) (CASEQ NEXT ((
NIL QUIT) (SETQ ABORTFLG T)) (POP (COND ((NOT (CDDR PATH)) (SETQ ABORTFLG T)) (
T (SETQ NEXT (CAR PATH)) (SETQ PATH (CDR PATH)) (SETQ NEXT (CAR PATH)) (SETQ 
TYPE (CADR NEXT)) (COND ((PAIRP TYPE) (SETQ TYPE (CADR TYPE)))) (SETQ LAST (
CAR NEXT))))) (DONE (SETQ DONE T)))) (T (SETQ PATH (CONS NEXT PATH)) (SETQ 
TYPE (CADR NEXT)) (SETQ LAST (CAR NEXT)))) (COND ((MEMQ TYPE (QUOTE (ATOM 
INTEGER STRING REAL BOOLEAN NIL))) (SETQ DONE T))) (GO GLLABEL1)))) (COND (
ABORTFLG (RETURN NIL))) (SETQ PATH (REVERSIP PATH)) (SETQ NEWFN (
GEVMAKENEWFN COMMAND (CADDR TOPITEM) SET (CDDR PATH))) (GEVPUTD (QUOTE 
GEVNEWFN) (CAR NEWFN)) (SETQ RESULT (GEVdoNEWFN (CADR TOPITEM))) (PRIN1 
COMMAND) (SPACES 1) (MAPC (CDDR PATH) (FUNCTION (LAMBDA (X) (PRIN1 (CAR X)) (
SPACES 1)))) (PRINC "OF ") (PRIN1 (CAAR PATH)) (SPACES 1) (PRIN1 (CAADR PATH)) (
PRINC " = ") (PRINT RESULT) (RPLACA (CDDAR GEVEDITCHAIN) (ACONC (CADDAR 
GEVEDITCHAIN) (LIST (CONCAT (GEVSTRINGIFY COMMAND) (CONCAT " " (GEVSTRINGIFY 
LAST))) RESULT (CADR NEWFN) NIL (QUOTE MSG) NIL (APPEND (QUOTE (0 0)) NIL) (
APPEND (QUOTE (0 0)) NIL)))) (GEVDISPLAYNEWPROP)))

(DE GEVPROPMENU (OBJ FILTER FLG) (PROG (PROPS SEL PNAMES MENU) (SETQ PROPS (
GEVGETNAMES OBJ FILTER)) (COND ((NOT PROPS) (RETURN NIL)) (T (SETQ PNAMES (
MAPCAR PROPS (FUNCTION CAR))) (SETQ SEL (MENU-SELECT (LIST (QUOTE MENU) (
CONS (QUOTE QUIT) (CONS (QUOTE POP) (COND (FLG (CONS (QUOTE DONE) PNAMES)) (
T PNAMES)))) (COPY (QUOTE (WINDOW (0 0) (0 0) NIL 0)))))) (RETURN (CASEQ SEL ((
QUIT POP DONE NIL) SEL) (T (ASSOC SEL PROPS))))))))

(DE GEVPROPNAMES (OBJ PROPTYPE FILTER) (PROG (RESULT TYPE) (SETQ RESULT (
MAPCAN (CASEQ PROPTYPE (PROP (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (
QUOTE PROP))) (ADJ (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE ADJ))) (
ISA (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE ISA))) (MSG (LISTGET (
CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE MSG)))) (FUNCTION (LAMBDA (P) (AND (
SETQ TYPE (GEVPROPTYPES OBJ (CAR P) (QUOTE PROP))) (GEVFILTER TYPE FILTER) (
CONS (LIST (CAR P) TYPE) NIL)))))) (MAPC (LISTGET (CDR (GET OBJ (QUOTE 
GLSTRUCTURE))) (QUOTE SUPERS)) (FUNCTION (LAMBDA (S) (SETQ RESULT (NCONC 
RESULT (GEVPROPNAMES S PROPTYPE FILTER)))))) (RETURN RESULT)))

(DE GEVPROPTYPE (STR PROPNAME PROPTYPE) (PROG (PL SUBPL PROPENT TMP) (COND ((
NOT (ATOM STR)) (RETURN NIL)) ((AND (SETQ PROPENT (GEVGETPROP STR PROPNAME 
PROPTYPE)) (SETQ TMP (LISTGET (CDDR PROPENT) (QUOTE RESULT)))) (RETURN TMP)) ((
AND PROPENT (ATOM (CADR PROPENT)) (SETQ TMP (GET (CADR PROPENT) (QUOTE 
GLRESULTTYPE)))) (RETURN TMP)) ((AND (SETQ PL (GET STR (QUOTE GLPROPFNS))) (
SETQ SUBPL (ASSOC PROPTYPE PL)) (SETQ PROPENT (ASSOC PROPNAME (CDR SUBPL))) (
SETQ TMP (CADDR PROPENT))) (RETURN TMP)) ((EQ PROPTYPE (QUOTE ADJ)) (RETURN (
QUOTE BOOLEAN))))))

(DE GEVPROPTYPES (OBJ NAME TYPE) (OR (GEVPROPTYPE OBJ NAME TYPE) (AND (
GEVCOMPPROP OBJ NAME TYPE) (GEVPROPTYPE OBJ NAME TYPE))))

(DE GEVPUSH (ITEM) (PROG (NEWITEMS TOPITEM LSTITEM) (COND ((EQ (CAR (PNTH 
ITEM 5)) (QUOTE BACKUP)) (GEVPOP NIL 1) (RETURN NIL))) (SETQ TOPITEM (CAAAR 
GEVEDITCHAIN)) (COND ((EQ (CAR (PNTH ITEM 5)) (QUOTE FORWARD)) (SETQ 
NEWITEMS (GEVPUSHLISTOF ITEM T))) ((AND (ATOM (CADDR ITEM)) (NOT (GET (CADDR 
ITEM) (QUOTE GLSTRUCTURE)))) (CASEQ (CADDR ITEM) ((ATOM NUMBER REAL INTEGER 
STRING ANYTHING) (COND ((EQ (CADR ITEM) (CADDDR ITEM)) (RETURN NIL)) (T (
SETQ NEWITEMS (LIST (LIST (CAR ITEM) (CADR ITEM) (CADDR ITEM) (CADDDR ITEM) (
QUOTE FULLVALUE) NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))))))
(T (RETURN NIL)))) ((AND (PAIRP (CADDR ITEM)) (EQ (CAADDR ITEM) (QUOTE 
LISTOF))) (SETQ NEWITEMS (GEVPUSHLISTOF ITEM NIL)))) (SETQ GEVEDITCHAIN (
CONS (LIST (CONS ITEM (CAAR GEVEDITCHAIN)) NEWITEMS NIL) GEVEDITCHAIN)) (
GEVREFILLWINDOW) (COND ((AND (PAIRP (CADDR ITEM)) (EQ (CAADDR ITEM) (QUOTE 
LISTOF)) (NOT (CDADR ITEM))) (SETQ LSTITEM (CAADAR GEVEDITCHAIN)) (GEVPUSH (
CAAR (PNTH LSTITEM 6))) (RETURN NIL)))))

(DE GEVPUSHLISTOF (ITEM FLG) (PROG (ITEMTYPE TOPFRAME N NROOM LST VALS TMP) (
COND ((NOT (CADR ITEM)) (RETURN NIL))) (SETQ TOPFRAME (CAR GEVEDITCHAIN)) (
SETQ NROOM (DIFFERENCE (DIFFERENCE (QUOTIENT (CADR (CADDR GEVWINDOW)) 1) 
4) (LENGTH (CAR TOPFRAME)))) (COND (FLG (SETQ LST (CONS (LIST NIL NIL NIL 
"(..." (QUOTE BACKUP) NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 
0)) NIL)) LST)) (SETQ N (CAR ITEM)) (SETQ ITEMTYPE (CADDR ITEM)) (SETQ NROOM (
SUB1 NROOM)) (SETQ VALS (CAR (PNTH ITEM 6)))) (T (SETQ N 1) (SETQ ITEMTYPE (
CADR (CADDR ITEM))) (SETQ VALS (CADR ITEM)))) (PROG NIL GLLABEL1 (COND ((AND 
VALS (OR (GREATERP NROOM 1) (AND (EQN NROOM 1) (NOT (CDR VALS))))) (SETQ LST (
CONS (LIST N (PROG1 (SETQ TMP (CAR VALS)) (SETQ VALS (CDR VALS))) ITEMTYPE 
NIL NIL NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) LST)) (
SETQ NROOM (SUB1 NROOM)) (SETQ N (ADD1 N)) (GO GLLABEL1)))) (COND (VALS (
SETQ LST (CONS (LIST N NIL ITEMTYPE "...)" (QUOTE FORWARD) VALS (APPEND (
QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) LST)))) (RETURN (LIST (LIST 
"expanded" NIL ITEMTYPE NIL (QUOTE LISTOF) (REVERSIP LST) (APPEND (QUOTE (
0 0)) NIL) (APPEND (QUOTE (0 0)) NIL))))))

(DE GEVQUIT NIL (SETQ GEVACTIVEFLG NIL) (WINDOW-CLOSE GEVWINDOW) (COND (
GEVMENUWINDOW (WINDOW-CLOSE GEVMENUWINDOW))))

(DE GEVREDOPROPS (TOP) (PROG (ITEM L) (SETQ ITEM (CAAR TOP)) (COND ((AND (
NOT (CADDR TOP)) (NE (SETQ L (GEVEXPROP (CADR ITEM) (CADDR ITEM) (QUOTE 
DISPLAYPROPS) (QUOTE PROP) NIL)) (QUOTE GEVERROR))) (COND ((ATOM L) (
GEVCOMMANDPROP ITEM (QUOTE PROP) (QUOTE ALL))) ((PAIRP L) (MAPC L (FUNCTION (
LAMBDA (X) (GEVCOMMANDPROP ITEM (QUOTE PROP) X))))))) (T (MAPC (CADDR TOP) (
FUNCTION (LAMBDA (X) (COND ((NE (CAR (PNTH X 5)) (QUOTE MSG)) (RPLACA (CDR X) (
GEVEXPROP (CADR ITEM) (CADDR ITEM) (CAR X) (CAR (PNTH X 5)) NIL)) (RPLACA (
CDDDR X) NIL))))))))))

(DE GEVREFILLWINDOW NIL (PROG (TOP TOPITEM SUBS TOPSUB) (SETQ TOP (CAR 
GEVEDITCHAIN)) (SETQ TOPITEM (CAAAR GEVEDITCHAIN)) (SETQ TOPSUB (CAADR TOP)) (
COND ((OR (NOT TOPSUB) (AND (NE (CAR (PNTH TOPSUB 5)) (QUOTE FULLVALUE)) (NE (
CAR (PNTH TOPSUB 5)) (QUOTE LISTOF)))) (COND ((GEVGETPROP (CADDR TOPITEM) (
QUOTE GEVDISPLAY) (QUOTE MSG)) (RPLACA (CDR TOP) (LIST (LIST NIL (CADR 
TOPITEM) (CADDR TOPITEM) NIL (QUOTE DISPLAY) NIL (APPEND (QUOTE (0 0)) NIL) (
APPEND (QUOTE (0 0)) NIL))))) (T (SETQ SUBS (GEVMATCH (CADDR TOPITEM) (CADR 
TOPITEM) T)) (SETQ TOPSUB (CAR SUBS)) (RPLACA (CDR TOP) (COND ((AND (NOT (
CDR SUBS)) (EQ (CAR (PNTH TOPSUB 5)) (QUOTE STRUCTURE)) (EQUAL (CADR TOPSUB) (
CADR TOPITEM)) (EQUAL (CADDR TOPSUB) (CADDR TOPITEM))) (CAR (PNTH TOPSUB 
6))) (T SUBS))))))) (GEVREDOPROPS TOP) (GEVFILLWINDOW)))

(DE GEVSHORTATOMVAL (ATM NCHARS) (COND ((NUMBERP ATM) (COND ((GREATERP (
FLATSIZE2 ATM) NCHARS) (GEVSHORTSTRINGVAL (GEVSTRINGIFY ATM) NCHARS)) (T ATM)))
((GREATERP (FLATSIZE2 ATM) NCHARS) (CONCAT (SUBSTRING ATM 1 (SUB1 NCHARS)) "-"))
(T ATM)))

(DE GEVSHORTCONSVAL (VAL STR NCHARS) (PROG (NLEFT RES TMP NC) (SETQ RES (
CONS "(" RES)) (SETQ NLEFT (DIFFERENCE NCHARS 5)) (SETQ TMP (GEVSHORTVALUE (
CAR VAL) (CADR STR) (DIFFERENCE NLEFT 3))) (SETQ NC (FLATSIZE2 TMP)) (COND ((
GREATERP NC (DIFFERENCE NLEFT 3)) (SETQ TMP "---") (SETQ NC 3))) (SETQ RES (
CONS (GEVSTRINGIFY TMP) RES)) (SETQ RES (CONS " . " RES)) (SETQ NLEFT (
DIFFERENCE NLEFT NC)) (SETQ TMP (GEVSHORTVALUE (CDR VAL) (CADDR STR) NLEFT)) (
SETQ NC (FLATSIZE2 TMP)) (COND ((GREATERP NC NLEFT) (SETQ TMP "---") (SETQ 
NC 3))) (SETQ RES (CONS (GEVSTRINGIFY TMP) RES)) (SETQ RES (CONS ")" RES)) (
RETURN (GEVCONCAT (REVERSIP RES)))))

(DE GEVSHORTLISTVAL (VAL STR NCHARS) (PROG (NLEFT RES TMP QUIT NC NCI REST 
RSTR) (SETQ RES (CONS "(" RES)) (SETQ REST 4) (SETQ NLEFT (DIFFERENCE NCHARS 
2)) (SETQ RSTR (CDR STR)) (PROG NIL GLLABEL1 (COND ((AND VAL (NOT QUIT) (
GREATERP (SETQ NCI (COND ((CDR VAL) (DIFFERENCE NLEFT REST)) (T NLEFT))) 
2)) (SETQ TMP (GEVSHORTVALUE (CAR VAL) (COND ((EQ (CAR STR) (QUOTE LISTOF)) (
CADR STR)) ((EQ (CAR STR) (QUOTE LIST)) (CAR RSTR))) NCI)) (SETQ QUIT (
MEMBER TMP (QUOTE (GEVERROR "(...)" "---" "???")))) (SETQ NC (FLATSIZE2 TMP)) (
COND ((AND (GREATERP NC NCI) (CDR RES)) (SETQ QUIT T)) (T (COND ((GREATERP 
NC NCI) (SETQ TMP "---") (SETQ NC 3) (SETQ QUIT T))) (SETQ RES (CONS (
GEVSTRINGIFY TMP) RES)) (SETQ NLEFT (DIFFERENCE NLEFT NC)) (SETQ VAL (CDR 
VAL)) (SETQ RSTR (CDR RSTR)) (COND (VAL (SETQ RES (CONS " " RES)) (SETQ 
NLEFT (SUB1 NLEFT)))))) (GO GLLABEL1)))) (COND (VAL (SETQ RES (CONS "..." 
RES)))) (SETQ RES (CONS ")" RES)) (RETURN (GEVCONCAT (REVERSIP RES)))))

(DE GEVSHORTSTRINGVAL (VAL NCHARS) (COND ((STRINGP VAL) (GEVLENGTHBOUND VAL 
NCHARS)) (T "???")))

(DE GEVSHORTVALUE (VAL STR NCHARS) (PROG (TMP) (SETQ STR (GEVXTRTYPE STR)) (
RETURN (COND ((AND (ATOM STR) (MEMQ STR (QUOTE (ATOM INTEGER REAL)))) (
GEVSHORTATOMVAL VAL NCHARS)) ((EQ STR (QUOTE STRING)) (GEVSHORTSTRINGVAL VAL 
NCHARS)) ((AND (ATOM STR) (NE (SETQ TMP (GEVEXPROP VAL STR (QUOTE SHORTVALUE) (
QUOTE PROP) NIL)) (QUOTE GEVERROR))) (GEVLENGTHBOUND TMP NCHARS)) ((OR (ATOM 
VAL) (NUMBERP VAL)) (GEVSHORTATOMVAL VAL NCHARS)) ((STRINGP VAL) (
GEVSHORTSTRINGVAL VAL NCHARS)) ((PAIRP STR) (CASEQ (CAR STR) ((LISTOF LIST) (
COND ((PAIRP VAL) (GEVSHORTLISTVAL VAL STR NCHARS)) (T "???"))) (CONS (COND ((
PAIRP VAL) (GEVSHORTCONSVAL VAL STR NCHARS)) (T "???"))) (T "---"))) ((PAIRP 
VAL) (GEVSHORTLISTVAL VAL (QUOTE (LISTOF ANYTHING)) NCHARS)) (T "---")))))

(DE GEVXTRTYPE (TYPE) (COND ((ATOM TYPE) TYPE) ((NOT (PAIRP TYPE)) NIL) ((
AND (MEMQ (CAR TYPE) (QUOTE (A AN A AN AN TRANSPARENT))) (CDR TYPE) (ATOM (
CADR TYPE))) (CADR TYPE)) ((MEMQ (CAR TYPE) GEVTYPENAMES) TYPE) ((AND (NOT (
UNBOUNDP GLUSERSTRNAMES)) (ASSOC (CAR TYPE) GLUSERSTRNAMES)) TYPE) ((AND (
ATOM (CAR TYPE)) (CDR TYPE)) (GEVXTRTYPE (CADR TYPE))) (T (ERROR 0 (LIST (
QUOTE GEVXTRTYPE) (LIST TYPE "is an illegal type specification."))) NIL)))

(SETQ GEVTYPENAMES (QUOTE (CONS LIST RECORD LISTOF ALIST ATOM OBJECT 
LISTOBJECT ATOMOBJECT)))