Artifact d541892fd71713ceb17c9bef42275ffd2c79eab02679647b3eeb09ba84e977b4:

• File psl-1983/3-1/glisp/gevcrt.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 3051) [annotate] [blame] [check-ins using] [more...]

% GEVCRT.SL.9     07 April 83
% derived from <NOVAK>GEVCRT.PSL.1 20-Mar-83 12:41:24 

% Written by Gordon Novak Jr.
% Copyright (c) Hewlett-Packard 1983


(fluid '(n p))

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


% edited: 19-Mar-83 22:41 
(DG GEVINITEDITWINDOW NIL
(PROG NIL (GEVWINDOW _ (A WINDOW WITH START =
			  (A VECTOR WITH X = 0 Y = 3)
			  SIZE =
			  (A VECTOR WITH X = 46 Y = 20)
			  TITLE = "GEV Structure Inspector"))
      (RETURN GEVWINDOW)))


% edited: 19-Mar-83 21:12 
% Wait in a loop for mouse actions within the edit window. 
(DG GEVMOUSELOOP NIL
(PROG (INP N TMP)
      LP
      (SEND GEVWINDOW MOVETOXY 0 -1)
      (SEND TERMINAL ERASEEOL)
      (SEND GEVWINDOW MOVETOXY 0 -1)
      (SEND TERMINAL PRINTSTRING "GEV: ")
      (echoon)
      (INP _ (READ))
      (echooff)
      (SEND TERMINAL ERASEEOL)
      (IF INP=T AND (N _ (READ))
	  IS NUMERIC THEN (GEVNSELECT N NIL)
	  (GO LP)
	  ELSEIF INP IS NUMERIC THEN (GEVNSELECT INP T)
	  (GO LP)
	  ELSEIF
	  (TMP _ (ASSOC INP '((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 (SEND GEVWINDOW MOVETOXY 0 -1)
	      (SEND TERMINAL ERASEEOL)
	      (RETURN NIL)
	      ELSE
	      (GO LP))
	  ELSEIF INP = 'R
	  THEN
	  (SEND GEVWINDOW OPEN)
	  (GEVFILLWINDOW)
	  (GO LP)
	  ELSE
	  (PRIN1 "? Quit POP Edit PRogram Prop Adj Isa Msg Redraw")
	  (TERPRI)
	  (GO LP))))


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