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

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