(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)

(FILECREATED "16-May-90 16:29:25" |{DSK}<usr>local>lde>lispcore>sources>EXEC-COMMANDS.;2|
 4370   

      |changes| |to:|  (VARS EXEC-COMMANDSCOMS)

      |previous| |date:| " 2-Jun-87 14:53:25" |{DSK}<usr>local>lde>lispcore>sources>EXEC-COMMANDS.;1|
)


; Copyright (c) 1986, 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT EXEC-COMMANDSCOMS)

(RPAQQ EXEC-COMMANDSCOMS
 ((GLOBALVARS SPELLINGS1 SPELLINGS2 USERWORDS)
                              (FNS PRINTPROPS PRINTBINDINGS)
                              (LISPXMACROS PL PB \;)
                              (COMMANDS "PB" "RETRY")
                              (PROP FILETYPE EXEC-COMMANDS)))
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS SPELLINGS1 SPELLINGS2 USERWORDS)
)
(DEFINEQ

(printprops

  (lambda (at)
                                               (* |lmm| " 7-May-84 15:35")

    (resetform (printlevel '(2 . 3))
           (map (or (getproplist at)
                    (getproplist (or (misspelled? at nil userwords)
                                     at)))
                (function (lambda (tl)
                            (prin2 (car tl)
                                   t t)
                            (prin1 " : " t)
                            (showprint (cadr tl)
                                   t t)))
                (function cddr)))))

(printbindings

  (lambda (at pos fl)
                                        (* |lmm| "14-Aug-84 20:33")

                                                             (* |Print| |out| |the| |bindings| |of| 

                                                             |an| |atom|)

    (resetform (printlevel 2 3)
           (prog (name val epos)
                 (or fl (setq fl t))
                 (|printout| fl "bindings for " at ": " t)
                 (setq pos (stknth 0 (or pos 'printbindings)))
             lp  (or (setq pos (stkscan at pos pos))
                     (go out))
                 (setq val (stkarg at pos))
                 (prin1 '" @ " fl)
                 (prin2 (stkname pos)
                        fl t)
                 (cond
                    ((not (realframep pos))
                     (prin1 "/" fl)
                     (prog nil
                           (setq epos (stknth 1 pos epos))
                       lp  (cond
                              ((realframep epos)
                               (prin2 (stkname epos)
                                      fl t))
                              ((setq epos (stknth 1 epos epos))
                               (go lp))
                              (t (prin1 "? " fl))))))
                 (prin1 '" : " fl)
                 (showprint val fl t)
                 (and (setq pos (stknth 1 pos pos))
                      (go lp))
             out (relstk epos)
                 (prin1 " @ " fl)
             last
                 (prin1 '"TOP : " fl)
                 (showprint (gettopval at)
                        fl t)
                 (return)))))
)

(ADDTOVAR LISPXHISTORYMACROS

          (PL (COND (LISPXLINE (MAPC (NLAMBDA.ARGS LISPXLINE)
                                     (FUNCTION PRINTPROPS)))
                    (T '(E PL))))
          (PB (COND (LISPXLINE (MAPC (NLAMBDA.ARGS LISPXLINE)
                                     (FUNCTION (LAMBDA (X)
                                                      (PRINTBINDINGS X (AND (EQ LISPXID '\:)
                                                                            LASTPOS))))))
                    (T '(E PB))))
          (\; NIL NIL))

(ADDTOVAR HISTORYCOMS
 \;)

(DEFCOMMAND "PB"
 (VARIABLE)
   "Show where on the stack VARIABLE is (special) bound"
   (PRINTBINDINGS
 VARIABLE)
   (CL:VALUES))

(DEFCOMMAND ("RETRY"
 :HISTORY) (&REST EVENT-SPEC)
   "Re-execute specified events with debugging"
   (SETQ RETRYFLAG T)                                        (* \; 

"Bound by and noticed in DO-EVENT.  Causes HELPFLAG to be bound to !BREAK while executing the form.")

   (EVENTS-INPUT (FIND-HISTORY-EVENTS (OR EVENT-SPEC '(-1))
                        LISPXHISTORY)))

(PUTPROPS EXEC-COMMANDS
 FILETYPE
 CL:COMPILE-FILE)
(PUTPROPS EXEC-COMMANDS COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (836 3105 (PRINTPROPS 846 . 1437) (PRINTBINDINGS 1439 . 3103)))))
STOP