(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "SEDIT" (USE "LISP" "XCL")))

(IL:FILECREATED "10-Jul-91 19:11:12" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>SEDIT-TOPLEVEL.;5|
 36139  

      IL:|changes| IL:|to:|  (IL:VARS IL:SEDIT-TOPLEVELCOMS)
                             (IL:FNS SEDITE)

      IL:|previous| IL:|date:| " 3-Apr-91 15:43:40" 
IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>SEDIT-TOPLEVEL.;4|)


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

(IL:PRETTYCOMPRINT IL:SEDIT-TOPLEVELCOMS)

(IL:RPAQQ IL:SEDIT-TOPLEVELCOMS

          ((IL:PROP IL:FILETYPE IL:SEDIT-TOPLEVEL)
           (IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-TOPLEVEL)
           (IL:LOCALVARS . T)
           (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILES IL:SEDIT-DECLS))
           (IL:INITVARS CONTEXTS REGIONS)
           (IL:VARS (IL:*DISPLAY-EDITOR* 'SEDIT))
           (IL:FNS SEDIT RESET GET-WINDOW-REGION SAVE-WINDOW-REGION)
           (IL:FNS GET-CONTEXT DISINTEGRATE-CONTEXT AWAKE-COMMAND-PROCESS AWAKE-ME MARKASCHANGEDFN 
                  NEW-FUNCTION-BODY)
           (IL:FUNCTIONS QUERY-THROW-AWAY-CHANGES SET-OPTIONS SET-PROPS START-PROCESS)
           (IL:COMS 

                  (IL:* IL:|;;| 

       "THESE CAN ALL BE NUKED WITH THE NEW EDIT INTERFACE AND A DETACHED TTY/EDITOR (WOZ 1/25/91)")


                  (IL:PROP (IL:|Definition-for-EDITL| IL:|Definition-for-EDITE| 
                                  IL:|Definition-for-EDITDATE|)
                         SEDIT)
                  (IL:FNS SEDITE SEDITL FN-CHANGED PROP-CHANGED PROPLST-CHANGED VAR-CHANGED 
                         ALIST-COMPLETION COMPLETION PROPS-COMPLETION TTYFN 
                         LOCATE-NODE-FROM-EDITCHAIN)
                  
                  (IL:* IL:|;;| "Mess around with the tty editor's TTY: command by defining a hook and then making TTY: a macro which calls the hook.")


                  (IL:FUNCTIONS SMART-TTYFN)
                  (IL:P (PUSHNEW '(IL:TTY\: NIL (IL:E (SMART-TTYFN)
                                                      T))
                               IL:EDITMACROS :TEST #'IL:EQUAL)))
           (IL:FNS PRETTY-PRINT MAP-FONT)
           
           (IL:* IL:|;;| "these guys allow you to print and read structures with broken atoms and gaps.  just a convenience for the loser who forgets to get them out of his code.")


           (IL:FUNCTIONS MAKE-BROKEN-ATOM PRINT-BROKEN-ATOM MAKE-GAP PRINT-GAP)
           (IL:P (IL:DEFPRINT 'BROKEN-ATOM 'PRINT-BROKEN-ATOM)
                 (IL:DEFPRINT 'GAP 'PRINT-GAP))))

(IL:PUTPROPS IL:SEDIT-TOPLEVEL
 IL:FILETYPE
 :COMPILE-FILE)

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

(IL:LOCALVARS . T)
)
(IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE 

(IL:FILESLOAD IL:SEDIT-DECLS)
)

(IL:RPAQ? CONTEXTS
 NIL)

(IL:RPAQ? REGIONS
 NIL)

(IL:RPAQQ IL:*DISPLAY-EDITOR*
 SEDIT)
(IL:DEFINEQ

(SEDIT

  (IL:LAMBDA (STRUCTURE PROPS OPTIONS)
              (IL:* IL:\; "Edited 25-Jan-91 13:51 by woz")

    (OR STRUCTURE (IL:SETQ STRUCTURE BASIC-GAP))
    (LET* ((NAME (IL:LISTGET PROPS :NAME))
           (TYPE (OR (IL:LISTGET PROPS :TYPE)
                     :EXPRESSION))
           (CONTEXT (GET-CONTEXT
 STRUCTURE NAME TYPE))
           (WINDOW (IL:|fetch|
 DISPLAY-WINDOW IL:|of|
 CONTEXT)))
          (SET-PROPS
 CONTEXT PROPS)
          (SET-OPTIONS
 CONTEXT OPTIONS)
          (COND
             ((NULL WINDOW)

              (IL:* IL:|;;| "this is a new context, needs to be setup from scratch")


              (START-PROCESS
 CONTEXT NAME)
              CONTEXT)
             ((AND (IL:OPENWP WINDOW)
                   (IL:PROCESSP (IL:WINDOWPROP WINDOW 'IL:PROCESS)))

              (IL:* IL:|;;| "open and active")


              (IL:TOTOPW WINDOW)
              (WHEN (OR (NOT (EQ T (IL:|fetch|
 (EDIT-CONTEXT CHANGED-STRUCTURE?) IL:|of|

                                                                                     CONTEXT)))
                        (QUERY-THROW-AWAY-CHANGES
 NAME OPTIONS))

                  (IL:* IL:|;;| 

"there are no changes on this edit, or user said throw away changes, so we will restart this edit.")


                  (IL:|replace|
 CHANGED-STRUCTURE? IL:|of|
 CONTEXT IL:|with|
 STRUCTURE)
                  (IL:RESTART.PROCESS (IL:WINDOWPROP WINDOW 'IL:PROCESS))
                  CONTEXT))
             ((IL:OPENWP (IL:WINDOWPROP WINDOW 'IL:ICONWINDOW))

              (IL:* IL:|;;| "shrunk")


              (IL:|replace|
 CHANGED-STRUCTURE? IL:|of|
 CONTEXT IL:|with|
 STRUCTURE)
              (IL:EXPANDW WINDOW)
              CONTEXT)
             (T 
                (IL:* IL:|;;| "found a dead context.  get rid of it and try again.")


                (DISINTEGRATE-CONTEXT
 CONTEXT)
                (SEDIT
 STRUCTURE PROPS OPTIONS))))))

(reset

(il:lambda nil (il:* il:\; "Edited 10-Jul-87 08:35 by DCB") (cond (contexts (il:error "Can't reset SEdit while there are open SEdit windows")) (t (create-environments) (reset-formats) t)))
)

(get-window-region

(il:lambda (context reason name type) (il:* il:\; "Edited 19-Nov-87 10:18 by DCB") (il:* il:|;;;| "called to get a region for this sedit window.  should return the region for the sedit including the prompt window.  context is being built and needs a window.  the context will have at least the name (IconTitle) and type (EditType) of the object being edited, and can be used as desired to map between contexts and windows.  If reason is :CREATE, then this function must return a region.  If :EXPAND, then this algorithm returns a region from the stack only if SEDIT.KEEP.WINDOW.REGION is nil, otherwise it returns NIL, telling the window system not to reshape on expansion.") (when (or (eq reason :create) (not keep-window-region)) (or (il:pop regions) (progn (il:|printout| il:promptwindow t "Select region for SEdit window.") (il:getregion 30 20)))))
)

(SAVE-WINDOW-REGION

  (IL:LAMBDA (CONTEXT REASON NAME TYPE REGION)
      (IL:* IL:\; "Edited 23-Nov-87 17:46 by DCB")


(IL:* IL:|;;;| "Release this sedit windows region to be used again.  If we're shrinking, KEEP-WINDOW-REGION determines whether to release the region or not.  If an icon is being closed, don't release the region because it was handled appropriately when the window as shrunk.   remember, we're maintaining regions including the prompt window height, so use WINDOWREGION to get the whole region.")


    (WHEN (OR (EQ REASON :CLOSE)
              (AND (EQ REASON :SHRINK)
                   (NOT KEEP-WINDOW-REGION)))
        (IL:|push|
 REGIONS (OR REGION (IL:WINDOWREGION (IL:|fetch|
 DISPLAY-WINDOW
                                                              IL:|of|
 CONTEXT)))))))
)
(IL:DEFINEQ

(GET-CONTEXT

  (IL:LAMBDA (STRUCTURE NAME TYPE SEARCH-ONLY?)
     (IL:* IL:\; "Edited  5-Dec-90 13:00 by woz")


(IL:* IL:|;;;| "we've been asked to get the edit context for a new edit.  if a context matching this description (same name and same type, or  EQ structure) already exists, we'll return it rather than creating a new one.  Also, if SEARCH-ONLY? is true then don't create a new one, just return NIL if not found.")


    (IL:|bind|
 WINDOW IL:|for|
 CONTEXT IL:|in|
 CONTEXTS
       IL:|when|
 (OR (AND NAME (EQUAL NAME (IL:|fetch|
 ICON-TITLE IL:|of|
 CONTEXT))
                              (EQ TYPE (IL:|fetch|
 EDIT-TYPE IL:|of|
 CONTEXT)))
                         (AND STRUCTURE (IL:|type?|
 EDIT-NODE (IL:|fetch|
 ROOT IL:|of|

                                                                                       CONTEXT))
                              (EQ STRUCTURE (IL:|fetch|
 STRUCTURE
                                               IL:|of|
 (SUBNODE 1 (IL:|fetch|
 ROOT
                                                                         IL:|of|
 CONTEXT))))))
       IL:|do|
 

             (IL:* IL:|;;| "we found a context that matches,  return it.")


             (RETURN CONTEXT)
       IL:|finally|
 

             (IL:* IL:|;;| 

           "this is a new editing task, so make an appropriate context and get it started")


             (IF SEARCH-ONLY?
                 (RETURN NIL)
                 (LET ((CONTEXT (IL:|create|
 EDIT-CONTEXT
                                       COMPLETION-EVENT IL:_ (IL:CREATE.EVENT (IL:CONCAT EDITOR-NAME
                                                                                     NAME))
                                       ROOT IL:_ STRUCTURE
                                       ICON-TITLE IL:_ NAME
                                       EDIT-TYPE IL:_ TYPE)))
                      (PUSH CONTEXT CONTEXTS)
                      (RETURN CONTEXT))))))

(DISINTEGRATE-CONTEXT

  (IL:LAMBDA (CONTEXT)
                              (IL:* IL:\; "Edited  5-Dec-90 17:45 by woz")


(IL:* IL:|;;;| "terminate this edit context.  we mark it as dead, remove it from the active edits list, smash the connections between the context and the window")


    (WHEN CONTEXT
        (IL:NOTIFY.EVENT (IL:|fetch|
 COMPLETION-EVENT IL:|of|
 CONTEXT))
        (IL:|replace|
 CONTEXT-LOCK IL:|of|
 CONTEXT IL:|with|
 'DEAD)
        (IL:WINDOWPROP (IL:|fetch|
 DISPLAY-WINDOW IL:|of|
 CONTEXT)
               'EDIT-CONTEXT NIL)
        (IL:|replace|
 DISPLAY-WINDOW IL:|of|
 CONTEXT IL:|with|
 NIL)
        (IL:SETQ CONTEXTS (IL:DREMOVE CONTEXT CONTEXTS)))))

(AWAKE-COMMAND-PROCESS

  (IL:LAMBDA (CONTEXT COMMAND)
                      (IL:* IL:\; "Edited  5-Dec-90 16:52 by woz")


    (IL:* IL:|;;| "if this context has a process associated with it, and the process is currently stuck waiting for input, unstick it so that it can look around and (presumably) notice some important change in its environment.  This is also called when someone in another process, such as a command menu or a window menu operation, wants to tell the command process to execute the command.  Note that under a few circumstances this function will be called by a running command in the sedit process.  For example, the complete-and-close command calls il:closew which calls sedit's closefn which tries to wake up the sedit to let it know the window was closed.  In this case, awake-command-porcess will result in a no-op because sedit has a command running, and therefore cannot be woken up.  COMMAND is a command form which will be used as the value returned from GETKEY in SEDIT1.  COMMAND should be of the form (<fn> <normalize?> <extra args>), so that <fn> will be applied to the context, the charcode invokeing the command (NIL in this case), and the extra args.  After the command runs the window will scroll to normalize the caret if <normalize?> is T.  If COMMAND is NIL then the SEdit will just update the window.")


    (LET ((PROCESS (IL:WINDOWPROP (IL:|fetch|
 DISPLAY-WINDOW IL:|of|
 CONTEXT)
                          'IL:PROCESS)))
         (WHEN (IL:PROCESSP PROCESS)
             (IL:PROCESS.APPLY PROCESS 'AWAKE-ME (LIST COMMAND))))))

(awake-me

(il:lambda (result) (il:* il:\; "Edited  7-Jul-87 12:59 by DCB") (il:* il:|;;| "this rather ugly little function checks to see if it's being called under getkey (presumably by PROCESS.APPLY from awake.command.process) and if so forces the getkey to return result") (let ((stack-frame (il:stkpos (quote getkey)))) (when stack-frame (il:retfrom stack-frame result t))))
)

(MARKASCHANGEDFN

  (IL:LAMBDA (NAME TYPE REASON)
                     (IL:* IL:\; "Edited  3-Apr-91 15:42 by jds")


(IL:* IL:|;;;| "When a managed object is changed, we must check if we have an open edit on it.  If so, calling SEdit again, with the fresh definition, will  force the update.  This is fairly tricky, though.  Markaschanged is called as a result of editing a managed definition, so this markaschangedfn could be running in the sedit process under the completion-fn half way through completion.  IDEALLY in this case we could say \"i know it changed, i just changed it!\" and ignore this call.  BUT FOR NOW (1/14/91) since the manager can change the definition on completion (editdates, for one), we have to notify SEdit.  Since calling editdef will restart the sedit process, the completion-fn will not finish, so do the verify-structure here.")


    (LET* ((FORM (IL:PROCESSPROP (IL:THIS.PROCESS)
                        'IL:FORM))
           CONTEXT)
          (COND
             ((AND (EQ (CAR FORM)
                       'SEDIT1)
                   (IL:|type?|
 EDIT-CONTEXT (SETQ CONTEXT (CADADR FORM)))
                   (EQ NAME (IL:|fetch|
 ICON-TITLE IL:|of|
 CONTEXT))
                   (EQ TYPE (IL:|fetch|
 EDIT-TYPE IL:|of|
 CONTEXT)))

              (IL:* IL:|;;| "we're running under the edit that is completing")


              (UNLESS *IGNORE-CHANGES-ON-COMPLETION*
                  (VERIFY-STRUCTURE CONTEXT NIL (IL:GETDEF NAME TYPE NIL '(IL:EDIT IL:NOCOPY)))))
             ((GET-CONTEXT
 NIL NAME TYPE T)

              (IL:* IL:|;;| "found a matching context elsewhere")


              (IL:EDITDEF NAME TYPE NIL NIL '(:DONTWAIT)))))))

(new-function-body

(il:lambda (dummy-body) (il:* il:\; "Edited  7-Jul-87 12:59 by DCB") (if (il:neq (il:editmode) (quote sedit)) (il:copy dummy-body) (list (quote il:lambda) args-gap body-gap)))
)
)

(DEFUN QUERY-THROW-AWAY-CHANGES
 (NAME OPTIONS)

(IL:* IL:|;;;| "this gets called when sedit is restarting because it got called again, but the structure doesn't match and changes have been made.  should we throw away the changes and restart with the new structure, or not restart and keep the changes?  ask the user.")


   (IF (IL:EQMEMB :DISPLAY OPTIONS)
       (IL:MENU (IL:|create|
 IL:MENU
                       IL:ITEMS IL:_ '(("Throw away changes and restart with new structure" T)
                                       ("Keep changes and don't restart with new structure" NIL))
                       IL:TITLE IL:_ (FORMAT NIL "An edit session with changes already exists for ~S"
                                            NAME)))
       (IF (EQ 'IL:Y (IL:ASKUSER NIL NIL (FORMAT NIL "An edit session with changes already exists for ~S.  Throw away changes and restart with new structure? "
                                                NAME)))
           T)))

(DEFUN SET-OPTIONS
 (CONTEXT OPTIONS)

(IL:* IL:|;;;| "set up the OPTIONS provided in the call to SEDIT for this context.  Most of these options do not require immediate action.  Rather, they control how some command or interaction will work later, so we just store the option list in the context.  Most of these options are really edit-interface options, not sedit options.  We stash them so that when the *edit-fn* is called under M-O, it will be handed the same options that this edit was started with")


   (IL:REPLACE
 (EDIT-CONTEXT EDIT-OPTIONS) IL:OF
 CONTEXT IL:WITH
 (IF (LISTP OPTIONS)
                                                                                 OPTIONS
                                                                                 (LIST OPTIONS))))

(DEFUN SET-PROPS
 (CONTEXT PROPS)

(IL:* IL:|;;;| "go through the PROPS list supplied in the call to SEDIT and store the info in the context.  The :NAME and :TYPE props are already handled, because get-context uses this information to find an appropriate context.  Grab the current values of the variables that determine reading and printing, and save them in a profile in the context, so that later changes to the globals don't affect existing contexts. ")


   (IL:REPLACE
 (EDIT-CONTEXT COMPLETION-FN) IL:OF
 CONTEXT IL:WITH
 (OR (IL:LISTGET PROPS 
                                                                                       :COMPLETION-FN
                                                                                         )
                                                                                  #'NULL))
   (IL:REPLACE
 (EDIT-CONTEXT ROOT-CHANGED-FN) IL:OF
 CONTEXT IL:WITH
 (OR (IL:LISTGET
                                                                                     PROPS 
                                                                                     :ROOT-CHANGED-FN
                                                                                     )
                                                                                    #'NULL))
   (IL:REPLACE
 (EDIT-CONTEXT ENVIRONMENT) IL:OF
 CONTEXT IL:WITH
 (OR (IL:LISTGET PROPS 
                                                                                       :ENVIRONMENT)
                                                                                LISP-EDIT-ENVIRONMENT
                                                                                ))
   (IL:REPLACE
 (EDIT-CONTEXT PROFILE) IL:OF
 CONTEXT IL:WITH
 (OR (IL:LISTGET PROPS 
                                                                                   :PROFILE)
                                                                            (SAVE-PROFILE
                                                                             (COPY-PROFILE 
                                                                                    "READ-PRINT"))))
   (IL:REPLACE
 (EDIT-CONTEXT EVAL-IN-PROCESS) IL:OF
 CONTEXT IL:WITH
 (OR (IL:LISTGET
                                                                                     PROPS 
                                                                                     :EVAL-IN-PROCESS
                                                                                     )
                                                                                    (EVAL-IN-PROCESS)
                                                                                    ))
   (IL:REPLACE
 (EDIT-CONTEXT EVAL-FN) IL:OF
 CONTEXT IL:WITH
 (OR (IL:LISTGET PROPS 
                                                                                   :EVAL-FN)
                                                                            (XCL::PROFILE-ENTRY-VALUE
                                                                             '*EVAL-FUNCTION*)))
   (WHEN (IL:LISTGET PROPS :SELECT-STRUCTURE)
       (IL:REPLACE
 (EDIT-CONTEXT FIND-CANDIDATE) IL:OF
 CONTEXT
          IL:WITH
 (CONS (IL:LISTGET PROPS :SELECT-STRUCTURE)
                            (OR (IL:LISTGET PROPS :SELECT-INSTANCE)
                                1)))))

(DEFUN START-PROCESS
 (CONTEXT)

(IL:* IL:|;;;| "the context is ready.  start the sedit process.  the rest of the initialization will happen in the sedit process, and the completion-event will be notified (by SEDIT1) when the sedit is initialized.")


   (LET ((NAME (IL:FETCH
 (EDIT-CONTEXT ICON-TITLE) IL:OF
 CONTEXT))
         (EVENT (IL:|fetch|
 (EDIT-CONTEXT COMPLETION-EVENT) IL:|of|
 CONTEXT)))
        (IL:ADD.PROCESS (LIST 'SEDIT1 (IL:KWOTE CONTEXT))
               'IL:NAME
               (IF NAME
                   (IL:CONCAT EDITOR-NAME " " NAME)
                   EDITOR-NAME))
        (IL:|until|
 (EQ EVENT (IL:AWAIT.EVENT EVENT)))))



(IL:* IL:|;;| 
"THESE CAN ALL BE NUKED WITH THE NEW EDIT INTERFACE AND A DETACHED TTY/EDITOR (WOZ 1/25/91)")



(IL:PUTPROPS SEDIT
 IL:|Definition-for-EDITL|
 SEDITL)

(IL:PUTPROPS SEDIT
 IL:|Definition-for-EDITE|
 SEDITE)

(IL:PUTPROPS SEDIT
 IL:|Definition-for-EDITDATE|
 IL:TTY/EDITDATE)
(IL:DEFINEQ

(SEDITE

  (IL:LAMBDA (EXPR COMS ATOM TYPE IFCHANGEDFN OPTIONS)

                                                        (IL:* IL:\; "Edited 10-Jul-91 19:04 by jds")


(IL:* IL:|;;;| "Convert call to EDITE into sedit format (structure props options).  The completion-fn is determined based on TYPE, since the file manager isn't very consistent about IL:PROPLST and IL:ALIST.  Since EDITE is supposed to wait for completion, create a completion event which is notified by the completion-fn.  Also, if the top cons is changed, try to smash the completed structure into EXPR to provide eqness.")


(IL:* IL:|;;;| "IDEALLY: this whole mess wouldn't exist- if il:putdef could handle il:proplst, etc, then completion could simply call putdef, not special case as it does here.")


    (LET* ((EVENT (IL:CREATE.EVENT "SEDITE Completion"))
           (NEW-EXPR)
           (COMPLETION-FN
            (OR (AND IL:FILEPKGFLG
                     (IL:SELECTQ TYPE
                           (IL:PROPLST (LET ((OLD-PROPS (IL:APPEND (IL:GETPROPLIST ATOM))))
                                            #'(LAMBDA (CONTEXT STRUCTURE CHANGED?)
                                                     (FUNCALL #'PROPS-COMPLETION CONTEXT STRUCTURE 
                                                            CHANGED? ATOM IFCHANGEDFN OLD-PROPS)
                                                     (SETQ NEW-EXPR STRUCTURE)
                                                     (IL:NOTIFY.EVENT EVENT))))
                           (IL:VARS (WHEN (IL:EQMEMB 'IL:ALIST (IL:GETPROP ATOM 'IL:VARTYPE))
                                        (LET ((OLD-VAL (IL:MAPCAR (IL:FUNCTION CAR)
                                                              (IL:EVALV ATOM))))
                                             #'(LAMBDA (CONTEXT STRUCTURE CHANGED?)
                                                      (FUNCALL #'ALIST-COMPLETION CONTEXT STRUCTURE 
                                                             CHANGED? ATOM IFCHANGEDFN OLD-VAL)
                                                      (SETQ NEW-EXPR STRUCTURE)
                                                      (IL:NOTIFY.EVENT EVENT)))))
                           NIL))
                (AND ATOM TYPE #'(LAMBDA (CONTEXT STRUCTURE CHANGED?)
                                        (FUNCALL #'COMPLETION CONTEXT STRUCTURE CHANGED? ATOM TYPE 
                                               IFCHANGEDFN)
                                        (SETQ NEW-EXPR STRUCTURE)
                                        (IL:NOTIFY.EVENT EVENT)))
                #'(LAMBDA (CONTEXT STRUCTURE CHANGED?)
                         (SETQ NEW-EXPR STRUCTURE)
                         (IL:NOTIFY.EVENT EVENT))))
           (ROOT-CHANGED-FN (IL:SELECTQ TYPE
                                  (IL:PROPLST (LIST (IL:FUNCTION PROPLST-CHANGED)
                                                    ATOM))
                                  (IL:VARS (LIST (IL:FUNCTION VAR-CHANGED)
                                                 ATOM))
                                  (IL:FNS (LIST (IL:FUNCTION FN-CHANGED)
                                                ATOM))
                                  NIL)))
          (COND
             (COMS (IL:TTY/EDITE EXPR COMS ATOM TYPE IFCHANGEDFN OPTIONS))
             (T (WHEN (AND IL:FILEPKGFLG (OR IL:CLISPARRAY (PROGN (IL:CLISPTRAN (CONS)
                                                                         (CONS))
                                                                  IL:CLISPARRAY)))
                    (IL:SELECTQ TYPE
                          (IL:PROPLST (IL:|for|
 X IL:|in|
 (IL:GETPROPLIST ATOM)
                                         IL:|unless|
 (OR (IL:NLISTP X)
                                                             (IL:GETHASH X IL:CLISPARRAY))
                                         IL:|do|
 (IL:PUTHASH X (CONS (CAR X)
                                                                         (CDR X))
                                                            IL:CLISPARRAY)))
                          (IL:VARS (WHEN (IL:EQMEMB 'IL:ALIST (IL:GETPROP ATOM 'IL:VARTYPE))
                                       (IL:|for|
 X IL:|in|
 (IL:EVALV ATOM)
                                          IL:|unless|
 (OR (IL:NLISTP X)
                                                              (IL:GETHASH X IL:CLISPARRAY))
                                          IL:|do|
 (IL:PUTHASH X (CONS (CAR X)
                                                                          (CDR X))
                                                             IL:CLISPARRAY))))
                          NIL))
                (SEDIT
 EXPR (LIST :NAME ATOM :TYPE TYPE :COMPLETION-FN COMPLETION-FN 
                                      :ROOT-CHANGED-FN ROOT-CHANGED-FN)
                       OPTIONS)
                (UNLESS (IL:EQMEMB :DONTWAIT OPTIONS)
                    (IL:|until|
 (EQ EVENT (IL:AWAIT.EVENT EVENT))))

                (IL:* IL:|;;| "EDITE is for side effects (but we return the correct structure anyway.  If the user replaced the top cons, smash the new structure into it.  Have to copy the new structure in this case because, if the user wrapped the top cons, smashing into it will result in a circular list.  Additionally, if there is an sedit root-changed-fn, assume the caller handled the root change then, and eqness is not necessary.")


                (IF (OR (EQ NEW-EXPR EXPR)
                        ROOT-CHANGED-FN
                        (NOT (CONSP EXPR))
                        (NOT (CONSP NEW-EXPR)))
                    NEW-EXPR
                    (IL:RPLNODE2 EXPR (COPY-TREE NEW-EXPR))))))))

(SEDITL

  (IL:LAMBDA (EDITEXPR EDITCOMS ATOM MESSAGE EDITCHANGES)

                                                        (IL:* IL:\; "Edited 25-Jan-91 13:45 by woz")

    (DECLARE
 (SPECIAL TYPE))

(IL:* IL:|;;;| "this is SEdit's definition for  EDITL.  if there are no COMS (normal case) we start an interactive SEdit.  otherwise, we run the TTY editor to execute the coms, and arrange to start an SEdit if it stops for input.")


    (COND
       (EDITCOMS 

              (IL:* IL:|;;| "used to push stuff on il:editmacros, now we bind il:ttyeditfn")


              (IL:* IL:|;;| "(il:resetvar il:editmacros (cons '(il:tty\\: nil (il:e (ttyfn il:atm type) t)) il:editmacros) (il:tty/editl editexpr editcoms atom message editchanges))")


              (LET ((IL:TTYEDITFN #'(LAMBDA NIL (TTYFN
 ATOM TYPE))))
                   (DECLARE
 (SPECIAL IL:TTYEDITFN))
                   (IL:TTY/EDITL EDITEXPR EDITCOMS ATOM MESSAGE EDITCHANGES)))
       (T (SEDIT
 (CAR EDITEXPR)
                 (LIST :NAME ATOM :TYPE (AND (BOUNDP 'TYPE)
                                             TYPE)))
          EDITEXPR))))

(fn-changed

(il:lambda (structure atom) (il:* il:\; "Edited  7-Jul-87 12:59 by DCB") (cond ((not (il:ccodep (il:getd atom))) (il:putd atom structure)) ((il:listp (il:getprop atom (quote il:expr))) (il:putprop atom (quote il:expr) structure)) (t (il:shouldnt "where did this come from?"))))
)

(prop-changed

(il:lambda (structure atom) (il:* il:\; "Edited  7-Jul-87 12:59 by DCB") (il:putprop atom (quote il:expr) structure))
)

(proplst-changed

(il:lambda (structure atom) (il:* il:\; "Edited  7-Jul-87 12:59 by DCB") (il:setproplist atom structure))
)

(var-changed

(il:lambda (structure atom) (il:* il:\; "Edited  7-Jul-87 12:59 by DCB") (set atom structure)))

(alist-completion

(il:lambda (context structure changed? atom ifchangedfn old-keys) (il:* il:\; "Edited 18-Jan-88 15:43 by woz") (when (eq changed? t) (il:* il:|;;| "don't do anything if changed is NIL or :ABORT ") (let (found-change old-value) (il:for x il:in old-keys il:unless (il:assoc x structure) il:do (il:markaschanged (list atom x) (quote il:alists) nil) (il:setq found-change t)) (il:for x il:in structure il:when (and (il:listp x) (not (and il:clisparray (il:setq old-value (il:gethash x il:clisparray)) (eq (car x) (car old-value)) (eq (cdr x) (cdr old-value))))) il:do (il:puthash x nil il:clisparray) (il:markaschanged (list atom (car x)) (quote il:alists) nil) (il:setq found-change t)) (when (not found-change) (completion context structure changed? atom (quote il:alists) ifchangedfn)))))
)

(completion

(il:lambda (context structure changed? atom type ifchangedfn) (il:* il:\; "Edited 18-Jan-88 15:40 by woz") (cond ((or (not changed?) (eq changed? :abort))) ((eq type (quote il:fns)) (il:fixeditdate structure) (il:putdef atom type structure) (il:* il:|;;| "(if  (CCODEP (GETD atom)) then (if (NEQ structure (GETPROP atom (QUOTE EXPR))) then (SHOULDNT 'where did this come from?') else (if (OR (EQ DFNFLG (QUOTE PROP)) (EQ DFNFLG (QUOTE ALLPROP))) then (SETQ message ' NOT unsaved.') else (UNSAVEDEF atom) (SETQ message ' unsaved.')) (if (OPENWP (fetch DisplayWindow of context)) then (printout (get.prompt.window context) atom message) else (* ;  'window was closed.  msg in promptwindow.') (printout PROMPTWINDOW T atom message))) else (if (NEQ structure (GETD atom)) then (if (NULL (GETD atom)) then (PUTD atom structure) else (SHOULDNT 'where did this come from?'))))")) (ifchangedfn (il:* il:|;;| "this is a bit wrong:  the doc for edite says the ifchangedfn gets called with the last arg NIL if the editor is aborted.  But we don't call the ifchangedfn at all if the user did an abort command.  The idea is that ABORT is implemented as \"don't install even if changes we're made\"") (funcall ifchangedfn atom structure type t)) ((il:neq type (quote il:proplst)) (il:markaschanged atom type))) (when (and (il:litatom atom) il:addspellflg) (il:addspell atom)))
)

(props-completion

(il:lambda (context structure changed? atom ifchangedfn oldprops) (il:* il:\; "Edited 20-Apr-88 11:39 by woz") (when (eq changed? t) (il:* il:|;;| "don't do anything if changed? is NIL or :ABORT") (il:bind old-value found-one il:for new-prop il:on (il:getproplist atom) il:by (cddr new-prop) il:unless (il:for old-prop il:on oldprops il:by (cddr old-prop) il:when (eq (car old-prop) (car new-prop)) il:do (return (and (eq (cadr old-prop) (cadr new-prop)) (or (il:nlistp (cadr old-prop)) (and il:clisparray (il:setq old-value (il:gethash (cadr new-prop) il:clisparray)) (eq (caadr new-prop) (car old-value)) (eq (cdadr new-prop) (cdr old-value)) (or (il:puthash (cadr new-prop) nil il:clisparray) t)))))) il:do (il:markaschanged (list atom (car new-prop)) (quote il:props) nil) (il:setq found-one t))))
)

(TTYFN

  (IL:LAMBDA (ATM TYPE)
                             (IL:* IL:\; "Edited 21-Jan-91 12:02 by woz")

    (DECLARE
 (SPECIAL IL:L IL:EDITCHANGES))

    (IL:* IL:|;;| "this is a replacement for the TTY editor's TTY: command, which starts an SEdit process to do interactive editing for a while.  it uses the TTY editor's edit chain to determine the initial selection in the structure, and scrolls the window to make sure the selection's visible.  it then waits until the user signals that they've done enough editing (usually by closing or shrinking the window)")


    (LET* ((EDIT-CHANGES IL:EDITCHANGES)
           (EVENT (IL:CREATE.EVENT "SEdit TTYFN Completion"))
           (COMPLETION-FN #'(LAMBDA (CONTEXT STRUCTURE CHANGED?)
                                   (WHEN (EQ CHANGED? T)
                                       (RPLACA (CDR EDIT-CHANGES)
                                              T))
                                   (IL:NOTIFY.EVENT EVENT)))
           (CONTEXT (SEDIT
 (CAR (LAST IL:L))
                           (LIST :NAME ATM :TYPE TYPE :COMPLETION-FN COMPLETION-FN)))
           NODE)
          (IL:WITH.MONITOR (IL:|fetch|
 CONTEXT-LOCK IL:|of|
 CONTEXT)
              (WHEN (IL:SETQ NODE (LOCATE-NODE-FROM-EDITCHAIN
 IL:L (IL:|fetch|
 ROOT
                                                                          IL:|of|
 CONTEXT)))
                  (SELECTION-DOWN CONTEXT)
                  (SELECT-NODE CONTEXT NODE)
                  (SET-POINT-NOWHERE (IL:|fetch|
 CARET-POINT IL:|of|
 CONTEXT))
                  (NORMALIZE-SELECTION CONTEXT)
                  (SELECTION-UP CONTEXT)))

          (IL:* IL:|;;| "let the user do their editing, then signal completion, before we return")


          (IL:|until|
 (EQ EVENT (IL:AWAIT.EVENT EVENT))))))

(locate-node-from-editchain

(il:lambda (chain root) (il:* il:\; "Edited 17-Nov-87 11:27 by DCB") (il:* il:|;;;| "when SEdit is called under the TTY editor, it gets an edit chain to determine the initial selection.  this process finds the node that editchain refers to (or returns NIL if no such node exists)") (if (null chain) root (il:for subnode il:in (cdr (il:fetch sub-nodes il:of (locate-node-from-editchain (cdr chain) root))) il:thereis (eq (il:fetch structure il:of subnode) (car chain)))))
)
)



(IL:* IL:|;;| 
"Mess around with the tty editor's TTY: command by defining a hook and then making TTY: a macro which calls the hook."
)



(DEFUN SMART-TTYFN
 ()

(IL:* IL:|;;;| "This is a replacement for the TTY editor's TTY: command, which is supposed to start up a TTY editor.  We first check to see if we're ")


   (DECLARE
 (SPECIAL IL:L IL:TTYEDITFN))
   (IF (AND (BOUNDP 'IL:TTYEDITFN)
            IL:TTYEDITFN)
       (FUNCALL IL:TTYEDITFN)
       (IL:EDITL0 IL:L NIL 'IL:TTY\: 'IL:TTY\:)))

(PUSHNEW '(IL:TTY\: NIL (IL:E (SMART-TTYFN
)
                              T))
       IL:EDITMACROS :TEST #'IL:EQUAL)
(IL:DEFINEQ

(pretty-print

(il:lambda (structure stream right-margin) (il:* il:\; "Edited  7-Jul-87 12:59 by DCB") (il:* il:|;;;| "with just a little hacking, SEdit can be used to prettyprint functions onto TEdit streams.  we make up a slightly weird context, and run the parser and linearizer each once.  stream is actually the textobj of the tedit stream.  note that right.margin is in micas (since that's the unit that interpress font widths are expressed in)") (or (boundp (quote pretty-print-env)) (create-pretty-print-env)) (let ((context (il:create edit-context display-window il:_ stream environment il:_ pretty-print-env current-x il:_ 0 comment-width il:_ (il:fixr (il:times 200 il:micasperpt)) comment-separation il:_ (il:fixr (il:times 30 il:micasperpt)))) (root (il:create edit-node node-type il:_ type-root sub-nodes il:_ (list 0) start-x il:_ 0 depth il:_ 0))) (il:replace current-node il:of context il:with root) (parse structure context) (compute-all-formats context nil) (linearize (subnode 1 root) context (il:fixr right-margin))))
)

(map-font

(il:lambda (font env) (il:* il:\; "Edited 17-Nov-87 10:43 by DCB") (il:* il:|;;| "this is called when using the prettyprint environment, under output.string.  we have to map the font into something acceptable to TEDIT.INSERT (since interpress fonts confuse it)") (cond ((eq font (il:fetch default-font il:of env)) il:defaultfont) ((eq font (il:fetch keyword-font il:of env)) il:clispfont) ((eq font (il:fetch italic-font il:of env)) il:italicfont) ((eq font (il:fetch comment-font il:of env)) il:commentfont) ((eq font (il:fetch broken-atom-font il:of env)) il:boldfont) (t (il:shouldnt "unexpected font!"))))
)
)



(IL:* IL:|;;| 
"these guys allow you to print and read structures with broken atoms and gaps.  just a convenience for the loser who forgets to get them out of his code."
)



(DEFUN MAKE-BROKEN-ATOM
 (STRING)
   (IL:|create|
 BROKEN-ATOM
          ATOM-CHARS IL:_ STRING))

(DEFUN PRINT-BROKEN-ATOM
 (BROKEN-ATOM STREAM X)
   (FORMAT STREAM "#.(~S ~S)" 'MAKE-BROKEN-ATOM (IL:|fetch|
 ATOM-CHARS IL:|of|
 BROKEN-ATOM))
   T)

(DEFUN MAKE-GAP
 (ITEM)
   (IL:|create|
 GAP
          LINEAR-ITEM IL:_ ITEM))

(DEFUN PRINT-GAP
 (GAP STREAM X)
   (FORMAT STREAM "#.(~S '~S)" 'MAKE-GAP (IL:|fetch|
 LINEAR-ITEM IL:|of|
 GAP))
   T)

(IL:DEFPRINT 'BROKEN-ATOM 'PRINT-BROKEN-ATOM)

(IL:DEFPRINT 'GAP 'PRINT-GAP)
(IL:PUTPROPS IL:SEDIT-TOPLEVEL IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL (3202 7114 (SEDIT 3215 . 5201) (RESET 5203 . 5404) (GET-WINDOW-REGION 5406 . 6283) (
SAVE-WINDOW-REGION 6285 . 7112)) (7115 13776 (GET-CONTEXT 7128 . 9148) (DISINTEGRATE-CONTEXT 9150 . 
9876) (AWAKE-COMMAND-PROCESS 9878 . 11471) (AWAKE-ME 11473 . 11856) (MARKASCHANGEDFN 11858 . 13572) (
NEW-FUNCTION-BODY 13574 . 13774)) (19971 32948 (SEDITE 19984 . 25751) (SEDITL 25753 . 26898) (
FN-CHANGED 26900 . 27195) (PROP-CHANGED 27197 . 27334) (PROPLST-CHANGED 27336 . 27464) (VAR-CHANGED 
27466 . 27578) (ALIST-COMPLETION 27580 . 28391) (COMPLETION 28393 . 29773) (PROPS-COMPLETION 29775 . 
30600) (TTYFN 30602 . 32440) (LOCATE-NODE-FROM-EDITCHAIN 32442 . 32946)) (33586 35271 (PRETTY-PRINT 
33599 . 34642) (MAP-FONT 34644 . 35269)))))
IL:STOP