% GEVHRD.SL.4 07 April 83
% derived from <NOVAK>GEVCRT.PSL.1 20-Mar-83 12:41:24
(fluid '(n))
(GLOBAL '(GEVMENUWINDOW GEVSAVEESC GEVSAVEGLQUIET GEVSAVEGCGAG GEVMOUSEAREA
glquietflg gllispdialect gevtypenames gluserstrnames mouse terminal
))
% TTY input replacement for mouse operations.
% GSN 07 March 83
(dg gevmouseloop ()
(prog (input n tmp)
lp (prin2 "GEV: ")
(input _ (read))
(if input='t and (n _ (read))
is numeric then (gevnselect n nil)
(go lp)
elseif input is numeric
then (gevnselect input t) (go lp)
elseif (tmp _ (assoc input
'((q quit)(pop pop)(e edit)(pr program)
(p prop)(a adj)(i isa)(m msg))))
then (gevcommandfn (cadr tmp))
(if (cadr tmp)='quit or ~gevactiveflg
then (return nil)
else (go lp)))
err (prin2 "? Quit POP Edit PRogram Prop Adj Isa Msg")
(terpri)
(go lp) ))
(DE GEVENTER NIL
(setq gevsavegcgag !*GC)
(setq !*GC nil)
(SETQ GEVSAVEGLQUIET GLQUIETFLG)
(SETQ GLQUIETFLG T))
(DE GEVEXIT NIL
(setq !*GC gevsavegcgag)
(SETQ GLQUIETFLG GEVSAVEGLQUIET))
% edited: 19-Mar-83 22:41
(DG GEVINITEDITWINDOW NIL
(PROG NIL (GEVWINDOW _ (A WINDOW WITH START =
(A VECTOR WITH X = 0 Y = 0)
SIZE =
(A VECTOR WITH X = 400 Y = 500)
TITLE = "GEV Structure Inspector"))
(RETURN GEVWINDOW)))
% edited: 19-Mar-83 21:42
% Select the Nth item in the display and push down to zoom in on it.
(DG GEVNSELECT (N:INTEGER FLAG:BOOLEAN)
(PROG (L TOP SUBLIST GROUP ITEM)
(GROUP _ 0)
(TOP _ GEVEDITCHAIN:TOPFRAME)
LP
(IF ~TOP THEN (RETURN NIL))
(SUBLIST -_ TOP)
(GROUP _+ 1)
(IF GROUP=1 AND (L _ (LENGTH SUBLIST))
>=N THEN (ITEM _ (CAR (PNth SUBLIST (L + 1 - N))))
ELSEIF ~ (ITEM _ (GEVNTHITEM SUBLIST))
THEN
(GO LP))
(IF ITEM:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
THEN
(RETURN NIL)
ELSE
(RETURN (GEVITEMEVENTFN ITEM GROUP FLAG)))))
% edited: 19-Mar-83 22:15
% Find the Nth item in a tree structure of items.
(DG GEVNTHITEM (L: (LISTOF GSEITEM))
(GLOBAL N:INTEGER)(PROG (TMP RES)
(IF N<=0 THEN (ERROR 0 NIL)
ELSEIF ~L THEN (RETURN NIL)
ELSEIF N=1 THEN (RETURN (CAR L))
ELSE
(N _- 1)
(TMP -_ L)
(IF TMP:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
AND
(RES _ (GEVNTHITEM TMP:SUBVALUES))
THEN
(RETURN RES)
ELSE
(RETURN (GEVNTHITEM L))))))
(GLISPCONSTANTS
(GEVNUMBERCHARS 2 INTEGER)
(GEVNUMBERPOS 1 INTEGER)
)
(SETQ GEVMENUWINDOW NIL)
(SETQ GEVMOUSEAREA NIL)