(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "29-Sep-87 12:03:08" {DSK}<LISPFILES>MATT>STEP-COMMAND-MENU.\;11 7859
|changes| |to:| (FUNCTIONS USER::STEP-COMMAND-AFTER USER::STEP-COMMAND-ASKUSER-MENUSELFN
USER::STEP-COMMAND-BEFORE USER::STEP-COMMAND-WRAPPER
USER::STEP-COMMAND-ASKUSER)
(VARS STEP-COMMAND-MENUCOMS)
|previous| |date:| " 4-May-87 16:45:38" {DSK}<LISPFILES>MATT>STEP-COMMAND-MENU.\;8)
; Copyright (c) 1987 by Beckman Instruments, Inc. All rights reserved.
(PRETTYCOMPRINT STEP-COMMAND-MENUCOMS)
(RPAQQ STEP-COMMAND-MENUCOMS ((INITVARS (*STEP-COMMAND-MENU* T)
(USER::*STEP-COMMAND-INVERT-MENU-SHADE* 1))
(P (CL:PROCLAIM '(CL:SPECIAL *STEP-COMMAND-MENU*
USER::*STEP-COMMAND-INVERT-MENU-SHADE*)))
(FUNCTIONS USER::STEP-COMMAND-AFTER USER::STEP-COMMAND-ASKUSER
USER::STEP-COMMAND-ASKUSER-MENUSELFN USER::STEP-COMMAND-BEFORE
USER::STEP-COMMAND-WRAPPER)
(P (CHANGENAME 'CL::STEP-COMMAND 'ASKUSER 'USER::STEP-COMMAND-ASKUSER)
(MOVD 'CL::STEP-COMMAND 'USER::STEP-COMMAND-ORIGINAL)
(MOVD 'USER::STEP-COMMAND-WRAPPER 'CL::STEP-COMMAND))
(PROP (MAKEFILE-ENVIRONMENT)
STEP-COMMAND-MENU)))
(RPAQ? *STEP-COMMAND-MENU* T)
(RPAQ? USER::*STEP-COMMAND-INVERT-MENU-SHADE* 1)
(CL:PROCLAIM '(CL:SPECIAL *STEP-COMMAND-MENU* USER::*STEP-COMMAND-INVERT-MENU-SHADE*))
(CL:DEFUN USER::STEP-COMMAND-AFTER NIL (* \; "Edited 29-Sep-87 11:39 by Matt Heffron")
(LET ((USER::STEP-WINDOW (WFROMDS CL::*STEP-IO*)))
(CL:WHEN (AND *STEP-COMMAND-MENU* (CL:ZEROP
CL::*STEP-INDENTATION-LEVEL*
))
(REMOVEWINDOW (WINDOWPROP USER::STEP-WINDOW
'USER::STEP-MENUW))
(WINDOWPROP USER::STEP-WINDOW 'USER::STEP-MENUW
NIL)
(WINDOWPROP USER::STEP-WINDOW 'USER::STEP-EVENT
NIL))))
(CL:DEFUN USER::STEP-COMMAND-ASKUSER (USER::WAIT USER::DEFAULT USER::MESS USER::KEYLIST)
(* \; "Edited 1-May-87 10:25 by Matt Heffron")
(CL:IF *STEP-COMMAND-MENU* (LET ((USER::MENUW (WINDOWPROP (WFROMDS CL::*STEP-IO*)
'USER::STEP-MENUW)))
(INVERTW USER::MENUW USER::*STEP-COMMAND-INVERT-MENU-SHADE*)
(WINDOWPROP USER::MENUW 'USER::STEP-ACTIVE T)
(AWAIT.EVENT (WINDOWPROP USER::MENUW 'USER::STEP-EVENT))
(WINDOWPROP USER::MENUW 'USER::STEP-ACTIVE NIL)
(INVERTW USER::MENUW USER::*STEP-COMMAND-INVERT-MENU-SHADE*)
(WINDOWPROP USER::MENUW 'USER::STEP-VALUE))
(ASKUSER USER::WAIT USER::DEFAULT USER::MESS USER::KEYLIST)))
(CL:DEFUN USER::STEP-COMMAND-ASKUSER-MENUSELFN (USER::ITEM USER::MENU USER::BUTTON)
(* \; "Edited 1-May-87 10:25 by Matt Heffron")
(LET ((USER::W (WFROMMENU USER::MENU)))
(CL:WHEN (WINDOWPROP USER::W 'USER::STEP-ACTIVE)
(WINDOWPROP USER::W 'USER::STEP-VALUE (CADR USER::ITEM))
(NOTIFY.EVENT (WINDOWPROP USER::W 'USER::STEP-EVENT)))))
(CL:DEFUN USER::STEP-COMMAND-BEFORE
NIL (* \; "Edited 29-Sep-87 11:43 by Matt Heffron")
(LET ((USER::STEP-WINDOW (WFROMDS CL::*STEP-IO*)))
(CL:WHEN (AND *STEP-COMMAND-MENU* (NOT (WINDOWPROP USER::STEP-WINDOW 'USER::STEP-MENUW)))
(LET ((USER::WREGION (WINDOWREGION USER::STEP-WINDOW))
USER::MENUW USER::MREGION)
(CL:SETQ USER::MENUW
(MENUWINDOW (|create| MENU
ITEMS ← '(("Step" \
"Step - Evaluate this expression, stepping on the sub-expressions"
)
("Next" N
"Next - Evaluate this expression without stepping"
)
("Finish" F
"Finish - Complete evaluation without the stepper"
)
("Abort" ↑
"Abort - Abort this evaluation"))
WHENSELECTEDFN ← #'
USER::STEP-COMMAND-ASKUSER-MENUSELFN
MENUCOLUMNS ← 1
TITLE ← " Commands "
CENTERFLG ← T)
T))
(CL:SETQ USER::MREGION (WINDOWREGION USER::MENUW))
(ATTACHWINDOW USER::MENUW USER::STEP-WINDOW
(CL:IF (> (+ (|fetch| (REGION LEFT) |of| USER::WREGION)
(|fetch| (REGION WIDTH) |of| USER::WREGION)
(|fetch| (REGION WIDTH) |of| USER::MREGION))
SCREENWIDTH)
'LEFT
'RIGHT)
'BOTTOM)
(WINDOWPROP USER::STEP-WINDOW 'USER::STEP-MENUW USER::MENUW)
(WINDOWPROP USER::MENUW 'USER::STEP-EVENT (CREATE.EVENT 'USER::STEP-MENU))
(INVERTW USER::MENUW USER::*STEP-COMMAND-INVERT-MENU-SHADE*)))))
(CL:DEFUN USER::STEP-COMMAND-WRAPPER (USER::FORM USER::ENVIRONMENT)
(* \; "Edited 1-May-87 11:33 by Matt Heffron")
(CL:IF *STEP-COMMAND-MENU* (CL:UNWIND-PROTECT (PROGN (USER::STEP-COMMAND-BEFORE)
(USER::STEP-COMMAND-ORIGINAL USER::FORM
USER::ENVIRONMENT))
(USER::STEP-COMMAND-AFTER))
(USER::STEP-COMMAND-ORIGINAL USER::FORM USER::ENVIRONMENT)))
(CHANGENAME 'CL::STEP-COMMAND 'ASKUSER 'USER::STEP-COMMAND-ASKUSER)
(MOVD 'CL::STEP-COMMAND 'USER::STEP-COMMAND-ORIGINAL)
(MOVD 'USER::STEP-COMMAND-WRAPPER 'CL::STEP-COMMAND)
(PUTPROPS STEP-COMMAND-MENU MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "INTERLISP"))
(PUTPROPS STEP-COMMAND-MENU COPYRIGHT ("Beckman Instruments, Inc" 1987))
(DECLARE\: DONTCOPY
(FILEMAP (NIL)))
STOP