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

(FILECREATED "27-Jul-90 07:56:00" {DSK}<usr>local>lde>loops>src>SYSTEM>LOOPS-TTYEDIT.;2
 5269   

      changes to%:  (VARS LOOPS-TTYEDITCOMS)

      previous date%: "18-Jun-87 15:30:08" {DSK}<usr>local>lde>loops>src>SYSTEM>LOOPS-TTYEDIT.;1)


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

(PRETTYCOMPRINT LOOPS-TTYEDITCOMS)

(RPAQQ LOOPS-TTYEDITCOMS ((* * Define some TTY editor macros for dealing with Loops) (* * Make the editor GETD understand LAMBDATRANS forms) (FNS \Edit-GETDEF \Edit-Convert-LambdaTrans) (P (CHANGENAME (QUOTE EDITGETD) (QUOTE GETDEF) (QUOTE \Edit-GETDEF))) (* * Editor macros) (FNS \Edit-Method \Edit-Get-Method \Edit-Get-Class-For-Selector \Edit-Get-Selector-From-Form) (USERMACROS EDITM GETM INSPECT)))
(* * Define some TTY editor macros for dealing with Loops)


(* * Make the editor GETD understand LAMBDATRANS forms)


(DEFINEQ

(\Edit-GETDEF
  (LAMBDA (name type source options)                         (* ; "Edited 17-Jun-87 16:32 by smL")

(* ;;; "Just like GETDEF")

    (GETDEF name type source options)))

(\Edit-Convert-LambdaTrans
  (LAMBDA (lambdaForm)                                       (* smL "18-Aug-86 18:23")
          
          (* * Convert a fn def to a standard LAMBDA expression)

    (DECLARE (GLOBALVARS LAMBDATRANFNS))
    (LET ((lambdaTransFns (ASSOC (CAR lambdaForm)
                                 LAMBDATRANFNS)))
         (if lambdaTransFns
             then (\Edit-Convert-LambdaTrans (APPLY* (CADR lambdaTransFns)
                                                    lambdaForm))
           else lambdaForm))))
)

(CHANGENAME (QUOTE EDITGETD) (QUOTE GETDEF) (QUOTE \Edit-GETDEF))
(* * Editor macros)


(DEFINEQ

(\Edit-Method
  (LAMBDA (form className)                                   (* smL "20-Aug-86 13:22")
          
          (* * Edit the method given in the form)

    (LET ((class (if (NULL className)
                     then (\Edit-Get-Class-For-Selector form)
                   elseif (NULL (GetClassRec className))
                     then NIL
                   else className)))
         (if class
             then (_ (GetClassRec class)
                     EditMethod
                     (\Edit-Get-Selector-From-Form form)
                     NIL)))))

(\Edit-Get-Method
  (LAMBDA (msgBody className)                                (* smL "20-Aug-86 13:27")
          
          (* * Get an implementation of the msg form)

    (LET ((selector (\Edit-Get-Selector-From-Form msgBody))
          (class (if (NULL className)
                     then (\Edit-Get-Class-For-Selector msgBody)
                   elseif (NULL (GetClassRec className))
                     then NIL
                   else className)))
         (if class
             then `(,(FetchMethod ($! class)
                            selector) ,(CADR msgBody) ,@(CDDDR msgBody))))))

(\Edit-Get-Class-For-Selector
  (LAMBDA (form)                                             (* smL "18-Aug-86 12:57")
          
          (* * Prompt the user for the class to use when processing the given form -
          form is either a selector or a message send form -
          Return the class name, or NIL if no class is picked.)

    (LET* ((selector (\Edit-Get-Selector-From-Form form))
           (classes (if selector
                        then (RESETFORM (CURSOR WAITINGCURSOR)
                                    (SORT (for class in (_ ($ Class)
                                                           AllInstances!)
                                             when (_ class ListAttribute 'Method selector)
                                             collect (_ class ClassName)))))))
          (if classes
              then (MENU (create MENU
                                ITEMS _ classes
                                TITLE _ (CONCAT "Class for method " selector)
                                CENTERFLG _ T))))))

(\Edit-Get-Selector-From-Form
  (LAMBDA (form)                                             (* smL "18-Aug-86 12:40")
          
          (* * Get the selector from the form -
          form is either a LITATOM {in which case it is the selector} or a message send 
          form.)

    (if (ATOM form)
        then form
      elseif (MEMB (CAR form)
                   '(_ _Super
                       _SuperFringe
                       _Proto
                       _New
                       _Process))
        then (CADDR form)
      else (printout PROMPTWINDOW T "Not a message form!" T))))
)

(ADDTOVAR USERMACROS (GETM (className) (BIND (E (SETQ %#1 (%##)) T) (E (SETQ %#2 (if (LISTP %#1) then (\Edit-Get-Method %#1 (QUOTE className)) else NIL)) T) (IF %#2 ((I %: %#2))) GETD)) (EDITM (className) (E (\Edit-Method (%##) (QUOTE className)))) (GETM NIL (BIND (E (SETQ %#1 (%##)) T) (E (SETQ %#2 (if (LISTP %#1) then (\Edit-Get-Method %#1 NIL) else NIL)) T) (IF %#2 ((I %: %#2))) GETD)) (EDITM NIL (E (\Edit-Method (%##) NIL))) (INSPECT NIL (E (INSPECT (%##)))))

(ADDTOVAR EDITCOMSA GETM EDITM INSPECT)

(ADDTOVAR EDITCOMSL EDITM GETM)
(PUTPROPS LOOPS-TTYEDIT COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (982 1707 (\Edit-GETDEF 992 . 1173) (\Edit-Convert-LambdaTrans 1175 . 1705)) (1801 4623 
(\Edit-Method 1811 . 2376) (\Edit-Get-Method 2378 . 2976) (\Edit-Get-Class-For-Selector 2978 . 4021) (
\Edit-Get-Selector-From-Form 4023 . 4621)))))
STOP