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

(FILECREATED "16-May-90 15:24:15" |{DSK}<usr>local>lde>lispcore>sources>DEBUGEDIT.;2|
 4300   

      |changes| |to:|  (VARS DEBUGEDITCOMS)

      |previous| |date:| "12-Jan-88 18:16:06" |{DSK}<usr>local>lde>lispcore>sources>DEBUGEDIT.;1|)


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

(PRETTYCOMPRINT DEBUGEDITCOMS)

(RPAQQ DEBUGEDITCOMS
 ((COMMANDS "EDIT")
                          (FUNCTIONS EDIT-IN-FNS EDIT-IN-FUNCTION FIND-EDIT-LOCATION 
                                 FIND-EDIT-LOCATION-TAIL)
                          (PROP FILETYPE DEBUGEDIT)))

(DEFCOMMAND ("EDIT"
 :DEBUGGER) ()
   "Edit call to function at LASTPOS"
   (DECLARE
 (CL:SPECIAL BRKVALUES))
   (RESETLST
       (LET ((POS (STKNTH 0 LASTPOS))
             SEEN NAME DEF)
            (RESETSAVE NIL (LIST 'RELSTK POS))
            (WHILE
 POS FINALLY
 (RETURN "Can't")
               DO
 (SETQ NAME (STKNAME POS))
                     (COND
                        ((NOT (CL:SYMBOLP NAME))             (* \; 

                                                           "non-symbol names are not editable?")

                         )
                        ((FMEMB NAME '(EVAL CL:EVAL))
                         (CL:PUSH (STKARG 1 POS)
                                SEEN)                        (* \; "remember EVALs as lists")

                         )
                        (T (COND
                              ((AND (EXPRP NAME)
                                    (OR (AND (SETQ DEF (GETDEF NAME 'FUNCTIONS NIL
                                                              '(EDIT NOERROR NOCOPY)))
                                             (EDIT-IN-FUNCTION NAME DEF SEEN))
                                        (EDIT-IN-FNS NAME (GETD NAME)
                                               SEEN)))
                               (CL:SETF BRKVALUES (LIST ':REVERT (STKARGS POS)
                                                        (STKNTH 0 POS)
                                                        NAME))
                               (RETURN NAME))
                              (T (CL:PUSH NAME SEEN)))))
                     (SETQ POS (STKNTH -1 POS POS))))))

(CL:DEFUN EDIT-IN-FNS
 (NAME DEF SEEN)

   (* |;;| "NOT YET")


   (LET ((LOC (FIND-EDIT-LOCATION DEF SEEN)))
        (EDITDEF NAME 'FNS (CONS '= DEF)
               (AND LOC `((ORR ((F= ,LOC)))
                          TTY\:)))
        (OR NAME T)))

(CL:DEFUN EDIT-IN-FUNCTION
 (NAME DEF SEEN)
   (LET ((LOC (FIND-EDIT-LOCATION DEF SEEN)))
        (EDITDEF NAME 'FUNCTIONS (CONS '= DEF)
               (AND LOC `((ORR ((F= ,LOC)))
                          TTY\:)))
        (OR NAME T)))

(CL:DEFUN FIND-EDIT-LOCATION
 (DEFINITION SEEN)
   "return edit location in DEFINITION of lowest caller in SEEN found"
   (LET ((*REMOVE-INTERLISP-COMMENTS* (EQ *REMOVE-INTERLISP-COMMENTS* T))
                                                             (* \; " if :WARN set to NIL")

         (EXPRS (REVERSE SEEN))
         FOUND)
        (WHILE
 EXPRS DO
 (COND
                                   ((NLISTP (CAR EXPRS))
                                    (POP
 EXPRS))
                                   ((SETQ FOUND (AND (LISTP (CAR EXPRS))
                                                     (FIND-EDIT-LOCATION-TAIL DEFINITION (CAR EXPRS)
                                                            NIL)))
                                    (AND (NULL (CDR FOUND))
                                         (RETURN (CAR FOUND))))))))

(CL:DEFUN FIND-EDIT-LOCATION-TAIL
 (X EXPRESSION OTHERS)
   (COND
      ((NLISTP X)
       OTHERS)
      ((EQ (CAAR X)
           '*)

       (* |;;| "ignore comments")


       (FIND-EDIT-LOCATION-TAIL (CDR X)
              EXPRESSION OTHERS))
      ((EQUAL EXPRESSION (REMOVE-COMMENTS X))
       (CONS X OTHERS))
      (T (FIND-EDIT-LOCATION-TAIL (CDR X)
                EXPRESSION
                (FIND-EDIT-LOCATION-TAIL (CAR X)
                       EXPRESSION OTHERS)))))

(PUTPROPS DEBUGEDIT
 FILETYPE
 CL:COMPILE-FILE)
(PUTPROPS DEBUGEDIT COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP