(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL-USER")

(il:filecreated "14-Aug-87 17:09:50" il:{qv}<jellinek>convert>debugger-context.\;2
        

      il:|changes| il:|to:|  (il:commands "unlex")
                             (il:functions open-lex-env init-debugger-context lex-eval-input)
                             (il:vars il:debugger-contextcoms)

      il:|previous| il:|date:| "10-Aug-87 13:19:47" il:{qv}<jellinek>tools>lex-tool.\;1)


; Copyright (c) 1987 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:debugger-contextcoms)

(il:rpaqq il:debugger-contextcoms
 (

(il:* il:|;;;| "Debugger-Context -- fix the Xerox Lisp debugger so that you can work with lexically-defined functions, variables, blocks, and tag-bodies sensibly.")


                                   

(il:* il:|;;;| "Written out of frustration by Herb Jellinek, 13-Aug-87.")


                                   (il:functions init-debugger-context lex-do-event open-lex-env)
                                   (il:variables xcl::*environment*)
                                   (il:p (init-debugger-context))
                                   (il:commands "lex" "unlex")
                                   (il:prop il:makefile-environment il:debugger-context)))



(il:* il:|;;;| 
"Debugger-Context -- fix the Xerox Lisp debugger so that you can work with lexically-defined functions, variables, blocks, and tag-bodies sensibly."
)





(il:* il:|;;;| "Written out of frustration by Herb Jellinek, 13-Aug-87.")



(defun init-debugger-context
 nil "Set things up for the DEBUGGER-CONTEXT hack"
                                 (undoably (setf *per-exec-variables* 
                                                             (il:* il:\; 

                                          "cause *environment* to be bound to nil in each executive.")


                                                 (acons 'xcl::*environment* nil *per-exec-variables*)
                                                 )           (il:* il:\; 

                                          "\"advise\" do-event to look at *environment* for its env.")


                                        (unless (fboundp 'old-do-event)
                                               (setf (symbol-function 'old-do-event)
                                                     (symbol-function 'il:do-event))
                                               (setf (symbol-function 'il:do-event)
                                                     (symbol-function 'lex-do-event)))))


(defun lex-do-event
 (original-input env &optional (fn nil function-p)) 
                                             "Replacement for the executive's old DO-EVENT function."
   (if function-p (old-do-event original-input (or env xcl::*environment*)
                         fn)
       (old-do-event original-input (or env xcl::*environment*))))


(defun open-lex-env
 nil "Finds the 'current' lex env and makes this debugger instance use it"
                        (let ((frame-vars (il:stkargs il:lastpos)))
                             (declare
 (special il:lastpos))
                             (dolist (value frame-vars (format t ";; ? found no lexical environment")
                                            )
                                    (if (il:environment-p value)
                                        (progn (setq xcl::*environment* value)
                                               (format t ";; set lexical environment")
                                               (return))))))


(defvar xcl::*environment*
 nil)

(init-debugger-context)

(defcommand ("lex"
 :debugger) nil 
                              "Sets the debugger's lexical environment to that of the selected frame"
                                  (open-lex-env)             (il:* il:\; "")


                                  (values))


(defcommand ("unlex"
 :debugger) nil "Unsets the lexical environment in the debugger" (setq 
                                                                                   xcl::*environment* 
                                                                                           nil)
                                    (format t ";; unset lexical environment")
                                    (values))


(il:putprops il:debugger-context il:makefile-environment
 (:readtable "XCL" :package "XCL-USER"))
(il:putprops il:debugger-context il:copyright ("Xerox Corporation" 1987))
il:stop