(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL)))
(IL:FILECREATED "16-May-90 21:51:00" IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-DEBUG.;2| 6465   

      IL:|changes| IL:|to:|  (IL:VARS IL:SEDIT-DEBUGCOMS)

      IL:|previous| IL:|date:| "13-Apr-88 13:02:09" 
IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-DEBUG.;1|)


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

(IL:PRETTYCOMPRINT IL:SEDIT-DEBUGCOMS)

(IL:RPAQQ IL:SEDIT-DEBUGCOMS ((IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
                                         IL:SEDIT-DEBUG)
                                  (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILES 
                                                                                     IL:SEDIT-DECLS))
                                  (IL:VARS FILES)
                                  (IL:FUNCTIONS FNS-TO-FUNCTIONS LOADPROP-SOURCES 
                                         DISTRIBUTE-CALL-INFO WHO-DOES)
                                  (IL:COMMANDS "icontext" "ienv" "ipoint" "isel" "inode")))

(IL:PUTPROPS IL:SEDIT-DEBUG IL:FILETYPE :COMPILE-FILE)

(IL:PUTPROPS IL:SEDIT-DEBUG IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
                                                                   (DEFPACKAGE IL:SEDIT
                                                                          (:USE IL:LISP IL:XCL))))
(IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE 

(IL:FILESLOAD IL:SEDIT-DECLS)
)

(IL:RPAQQ FILES (IL:SEDIT-DECLS IL:SEDIT IL:SEDIT-ACCESS IL:SEDIT-ATOMIC IL:SEDIT-BASE 
                           IL:SEDIT-COMMANDS IL:SEDIT-COMMENTS IL:SEDIT-DEBUG IL:SEDIT-EXPORTS 
                           IL:SEDIT-INDENT IL:SEDIT-LINEAR IL:SEDIT-LIST-FORMATS IL:SEDIT-LISTS 
                           IL:SEDIT-TERMINAL IL:SEDIT-TOPLEVEL IL:SEDIT-WINDOW))

(DEFUN FNS-TO-FUNCTIONS (SYM &OPTIONAL (EDIT? T)
                                 (EDITCOMS? NIL))

(IL:* IL:|;;;| "Sym is assumed to have a FNS definition.  Give it a FUNCTIONS definition instead.")

   (LET ((OLDDEF (IL:GETDEF SYM 'IL:FNS)))
        (UNLESS (AND OLDDEF (LISTP OLDDEF)
                     (EQ (FIRST OLDDEF)
                         'IL:LAMBDA))
               (ERROR "Invalid or missing FNS definition for ~S." SYM))
        (LET ((NEWDEF (COPY-TREE (LIST* 'DEFUN SYM (REST OLDDEF))))
              (FILE (IL:WHEREIS SYM 'IL:FNS)))
             (IL:PUTDEF SYM 'IL:FUNCTIONS NEWDEF 'IL:DEFINED)
             (IL:DELDEF SYM 'IL:FNS)
             (UNLESS (IL:GETDEF SYM 'IL:FUNCTIONS)
                    (ERROR "The functions definition went away!"))
             (WHEN EDIT?
                 (ED SYM '(IL:FUNCTIONS)))
             (WHEN (AND FILE (LISTP FILE)
                        (NULL (REST FILE)))
                 (IL:ADDTOFILE SYM 'IL:FUNCTIONS (FIRST FILE))
                 (WHEN EDITCOMS?
                     (ED (FIRST FILE)
                         '(IL:FILES)))))))

(DEFUN LOADPROP-SOURCES ()
   (DECLARE (SPECIAL FILES))
   (DOLIST (F FILES)
       (IL:LOAD F 'IL:ALLPROP)))

(DEFUN DISTRIBUTE-CALL-INFO (&OPTIONAL FILE-LIST)
   (DECLARE (SPECIAL FILES))
   (IL:FOR FILE IL:INSIDE (IL:U-CASE (OR FILE-LIST FILES))
      IL:DO (IL:FOR FN IL:IN (APPEND (IL:FILECOMSLST FILE 'IL:FUNCTIONS)
                                                (IL:FILEFNSLST FILE)) IL:WHEN (IL:CCODEP FN)
                   IL:DO (IL:BLOCK)
                         (LET ((Y (IL:CALLSCCODE FN)))
                              (IL:FOR Z IL:IN (CADR Y)
                                 IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:CALLEDBY)
                                                  FN))
                              (IL:FOR Z IL:IN (CADDR Y)
                                 IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:BOUNDBY)
                                                  FN))
                              (IL:FOR Z IL:IN (CADDDR Y)
                                 IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:USEDFREEBY)
                                                  FN))
                              (IL:FOR Z IL:IN (CAR (CDDDDR Y))
                                 IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:USEDGLOBALBY)
                                                  FN))))))

(DEFUN WHO-DOES (METHOD-NAME)
   (LET (L FN)
        (DOLIST (TY TYPES)
            (WHEN (SETQ FN (IL:RECORDACCESS METHOD-NAME TY NIL 'IL:FETCH))
                  (IL:PUSHNEW L FN)))
        L))

(DEFCOMMAND "icontext" (&OPTIONAL (INSPECT? T)
                                  (WINDOWSPEC (IL:GETPOSITION)))
   (LET ((CONTEXT (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
                         'EDIT-CONTEXT)))
        (WHEN INSPECT? (INSPECT CONTEXT))
        NIL))

(DEFCOMMAND "ienv" (&OPTIONAL (INSPECT? T)
                              (WINDOWSPEC (IL:GETPOSITION)))
   (LET ((ENV (IL:FETCH ENVIRONMENT IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
                                                         'EDIT-CONTEXT))))
        (WHEN INSPECT? (INSPECT ENV))
        ENV NIL))

(DEFCOMMAND "ipoint" (&OPTIONAL (INSPECT? T)
                                (WINDOWSPEC (IL:GETPOSITION)))
   (LET ((POINT (IL:FETCH CARET-POINT IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
                                                           'EDIT-CONTEXT))))
        (WHEN INSPECT? (INSPECT POINT))
        POINT NIL))

(DEFCOMMAND "isel" (&OPTIONAL (INSPECT? T)
                              (WINDOWSPEC (IL:GETPOSITION)))
   (LET ((SELECTION (IL:FETCH SELECTION IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
                                                             'EDIT-CONTEXT))))
        (WHEN INSPECT? (INSPECT SELECTION))
        NIL))

(DEFCOMMAND "inode" (&OPTIONAL (WINDOWSPEC (IL:GETPOSITION)))
   (INSPECT (IL:FETCH SELECT-NODE IL:OF (IL:FETCH SELECTION IL:OF (IL:WINDOWPROP
                                                                                   (IL:WHICHW 
                                                                                          WINDOWSPEC)
                                                                                   'EDIT-CONTEXT))))
   NIL)
(IL:PUTPROPS IL:SEDIT-DEBUG IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL)))
IL:STOP
