(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)))