(FILECREATED "11-AUG-83 16:59:40" {DSK}GEVAUX.LSP;13 6725
changes to: (VARS GEVAUXCOMS)
(FNS GEVSYSTEMINIT)
previous date: " 7-AUG-83 16:15:55" {DSK}GEVAUX.LSP;12)
(PRETTYCOMPRINT GEVAUXCOMS)
(RPAQQ GEVAUXCOMS [(GLISPCONSTANTS GEVNUMBERCHARS GEVNUMBERPOS GEVWINDOWTOPMARGIN)
(FNS GEVAPPLY GEVBUTTONEVENTFN GEVCONCAT GEVENTER GEVENTERPRINT GEVEXIT GEVEXITPRINT
GEVINITEDITWINDOW GEVMOUSELOOP GEVMOVEWINDOWFN GEVPUTD GEVSTRINGIFY GEVSYSTEMINIT
PICTURE-GEVDISPLAY PRINC)
(P (GEVSYSTEMINIT))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
[GLISPCONSTANTS
(GEVNUMBERCHARS 0 INTEGER )
(GEVNUMBERPOS 3 INTEGER )
(GEVWINDOWTOPMARGIN 10 INTEGER )
]
(DEFINEQ
(GEVAPPLY
[LAMBDA (FN ARGS) (* GSN "25-MAR-83 09:45")
(* Apply a function or LAMBDA form.
In some Lisps, it may be necessary to GLISP-compile the
function first.)
(APPLY FN ARGS])
(GEVBUTTONEVENTFN
[GLAMBDA NIL (* edited: "15-MAR-83 11:29")
(* Respond to a button event within the editing window.)
(PROG (POS SELECTION TMP TOP N)
(GETMOUSESTATE)
(POS ←(SEND MOUSE POSITIONIN GEVWINDOW)) (* Test the state of the left mouse button.)
(IF ~(SEND MOUSE TESTBUTTON GEVMOUSEBUTTON)
THEN (* Button is now up.)
(IF GEVMOUSEAREA
THEN (IF (SEND GEVMOUSEAREA:AREA CONTAINS? POS)
THEN (SELECTION←GEVMOUSEAREA)
(GEVMOUSEAREA←NIL)
(SEND GEVWINDOW INVERTAREA SELECTION:AREA)
(* Execute action.)
(GEVITEMEVENTFN SELECTION:ITEM SELECTION:GROUP SELECTION:FLAG)
(RETURN)
ELSE (SEND GEVWINDOW INVERTAREA GEVMOUSEAREA:AREA)
(GEVMOUSEAREA←NIL))
ELSE (* Button is now down.)
(IF GEVMOUSEAREA
THEN (IF (SEND GEVMOUSEAREA:AREA CONTAINS? POS)
THEN (RETURN)
ELSE (* Mouse has moved out of area with button down.)
(SELECTION←GEVMOUSEAREA)
(GEVMOUSEAREA←NIL)
(SEND GEVWINDOW INVERTAREA SELECTION:AREA)))
(* Try to find an item at current mouse position.)
(IF GEVMOUSEAREA ←(GEVFINDPOS POS GEVEDITCHAIN:TOPFRAME)
THEN (SEND GEVWINDOW INVERTAREA GEVMOUSEAREA:AREA])
(GEVCONCAT
[LAMBDA (L) (* GSN " 4-APR-83 16:23")
(APPLY (FUNCTION CONCAT)
L])
(GEVENTER
[LAMBDA NIL (* edited: "14-MAR-83 16:29")
NIL])
(GEVENTERPRINT
[LAMBDA NIL (* GSN "26-JUL-83 17:18")
NIL])
(GEVEXIT
[LAMBDA NIL (* edited: "14-MAR-83 16:30")
NIL])
(GEVEXITPRINT
[LAMBDA NIL (* GSN "26-JUL-83 17:19")
NIL])
(GEVINITEDITWINDOW
[LAMBDA NIL (* GSN "15-MAR-83 15:29")
(* Initialize an edit window for the GLISP structure
editor.)
(PROG (GEVMENU (LEFT 600)
(BOTTOM 200)
(WIDTH 300)
(HEIGHT 400))
(SETQ GEVWINDOW
(CREATEW (create REGION
LEFT ← LEFT
BOTTOM ← BOTTOM
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
"GEV Structure Editor Window"))
(SETQ GEVMOUSEAREA NIL)
(WINDOWPROP GEVWINDOW (QUOTE BUTTONEVENTFN)
(QUOTE GEVBUTTONEVENTFN))
(WINDOWPROP GEVWINDOW (QUOTE MOVEFN)
(QUOTE GEVMOVEWINDOWFN))
(SETQ GEVMENUWINDOWHEIGHT 40)
(SETQ GEVMENUWINDOW (CREATEW (create REGION
LEFT ← LEFT
BOTTOM ←(IDIFFERENCE BOTTOM GEVMENUWINDOWHEIGHT)
WIDTH ← WIDTH
HEIGHT ← GEVMENUWINDOWHEIGHT)
NIL 0))
(SETQ GEVMENU (create MENU
ITEMS ←(QUOTE (QUIT POP EDIT PROGRAM PROP ADJ ISA MSG))
CENTERFLG ← T
MENUROWS ← 2
MENUFONT ←(FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD))
ITEMHEIGHT ← 15
ITEMWIDTH ←(IDIFFERENCE (IQUOTIENT WIDTH 4)
2)
WHENSELECTEDFN ←(QUOTE GEVCOMMANDFN)))
(ADDMENU GEVMENU GEVMENUWINDOW)
(RETURN GEVWINDOW])
(GEVMOUSELOOP
(GLAMBDA NIL (* edited: "27-SEP-82 16:24")
(* Wait in a loop for mouse actions within the edit
window.)
(PROG NIL)))
(GEVMOVEWINDOWFN
[LAMBDA (W NEWPOS) (* edited: " 5-OCT-82 11:36")
(PROG NIL
(MOVEW GEVMENUWINDOW (CONS (CAR NEWPOS)
(IDIFFERENCE (CDR NEWPOS)
GEVMENUWINDOWHEIGHT])
(GEVPUTD
[LAMBDA (FN DEF) (* GSN "25-MAR-83 09:59")
(PUTD FN DEF])
(GEVSTRINGIFY
[LAMBDA (X) (* edited: "11-MAR-83 14:50")
(* Make X into a string so CONCAT will take it.)
X])
(GEVSYSTEMINIT
[LAMBDA NIL (* GSN "11-AUG-83 16:59")
(SETQ WINDOWCHARWIDTH (SELECTQ (SYSTEMTYPE)
(D 7)
1])
(PICTURE-GEVDISPLAY
(GLAMBDA (PICTURE:WINDOW WINDOW:WINDOW YMAX) (* GSN " 4-FEB-83 17:03")
(* Display PICTURE in WINDOW within YMAX.)
(GLOBAL Y:INTEGER)
(PROG (PWD PHT NEWX NEWY)
(PHT←(MIN (YMAX - 20)
PICTURE:HEIGHT))
(PWD ←(MIN (WINDOW:WIDTH - 20)
PICTURE:WIDTH))
(NEWX ←(WINDOW:WIDTH - PWD)/2)
(NEWY ← YMAX - PHT - 10)
(MOVEW PICTURE (CONS 0 0)) (* Also copy the picture onto the current window.)
(BITBLT PICTURE 1 1 WINDOW NEWX NEWY PWD PHT (QUOTE INPUT)
(QUOTE REPLACE)
NIL NIL)
(MOVEW PICTURE (CONS (WINDOW:LEFT+NEWX)
(WINDOW:BOTTOM+NEWY)))
(Y ← NEWY - 12))))
(PRINC
[LAMBDA (X) (* GSN "25-MAR-83 10:16")
(PRIN1 X])
)
(GEVSYSTEMINIT)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (781 6567 (GEVAPPLY 791 . 1103) (GEVBUTTONEVENTFN 1105 . 2684) (GEVCONCAT 2686 . 2820) (
GEVENTER 2822 . 2932) (GEVENTERPRINT 2934 . 3045) (GEVEXIT 3047 . 3156) (GEVEXITPRINT 3158 . 3268) (
GEVINITEDITWINDOW 3270 . 4658) (GEVMOUSELOOP 4660 . 4916) (GEVMOVEWINDOWFN 4918 . 5154) (GEVPUTD 5156
. 5270) (GEVSTRINGIFY 5272 . 5494) (GEVSYSTEMINIT 5496 . 5669) (PICTURE-GEVDISPLAY 5671 . 6455) (
PRINC 6457 . 6565)))))
STOP