Artifact 1a89ccc3b905eaa5e20f8aa1d2ff6954acbcf3e1b79085c8d0193f77a2d1a2a2:
- File
psl-1983/3-1/glisp/gevhrd.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: 2719) [annotate] [blame] [check-ins using] [more...]
% 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)