(* Filed on: {phylum}<desrivieres>nlisp>sm-top *)


(GLOBALVARS EXPRQ QNONEMPTY EXPRLIST)

(ADD.EDITOR.MODE 'n-LISP '(SET.MODE.NLISP)
   "n-LISP source code.")

(DEFINEQ (SET.MODE.NLISP (LAMBDA ()
  (PROG (PROCESS WINDOW)
    (SETQ PROCESS (THIS.PROCESS))
    (SETQ WINDOW (PROCESSPROP PROCESS 'WINDOW))

    (WINDOWPROP WINDOW 'EDITMODE 'N-LISP)

    (* Turn on paren. balancing, etc. *)
    (PB.ENABLE.BALANCING TEDIT.READTABLE)
    (PB.ENABLE.COPY.WHITESPACE TEDIT.READTABLE)
    (PB.ENABLE.NLISP.EVAL TEDIT.READTABLE) 
))))

(DEFINEQ (PB.READ.AND.GIVE.TO.NLISP 
  (LAMBDA (STREAM TEXTOBJ)
   (PROG (FORM START END SEL TEMPFILE)
      (TEDIT.SHOWSEL STREAM NIL)
      (SETQ START (PB.GETCARETPTR TEXTOBJ))
      (SETFILEPTR STREAM START)
      (SETQ FORM (READ STREAM NLISP-READ-TABLE))
      (SETQ END (GETFILEPTR STREAM))
    (*
      (SETQ TEMPFILE
         (OPENFILE (QUOTE {CORE}EVALEXPR.SCRATCH)
                   (QUOTE OUTPUT)))
      (COPYBYTES STREAM TEMPFILE START END)
      (CLOSEF? (QUOTE {CORE}EVALEXPR.SCRATCH))
    *)
      (PB.SETCARETPTR STREAM END)
      (TEDIT.NORMALIZECARET TEXTOBJ)
      (WITH.MONITOR EXPRQ
         (TCONC EXPRLIST (LIST FORM TEMPFILE))
         (NOTIFY.EVENT QNONEMPTY T))
      (BLOCK)
))))

(DEFINEQ (PB.ENABLE.NLISP.EVAL (LAMBDA (RDTABLE)
   (TEDIT.SETFUNCTION 
        (CHARCODE "~")  
        (QUOTE PB.READ.AND.GIVE.TO.NLISP)  
        RDTABLE))))



(DEFINEQ (1.9-LISP-CONSUMER (LAMBDA ()
   (PROG (STREAM WINDOW)
     (SETQ EXPRQ (CREATE.MONITORLOCK 'EXPRQ))
     (SETQ QNONEMPTY (CREATE.EVENT 'QNONEMPTY))
     (SETQ EXPRLIST (CONS))
     (SETQ WINDOW (CREATEW NIL "1.9-LISP top level typescript"))
     (RESETSAVE NIL 
        (LIST 'PROGN (LIST 'CLOSEW WINDOW)))
     (SETQ STREAM (OPENTEXTSTREAM " " WINDOW))
     (OUTPUT WINDOW)
     (TEDIT.SETSEL STREAM 1 0 'RIGHT)
     (TEDIT.INSERT STREAM 
        (CONCAT "Session start. " (DATE) (CHARACTER 13)))
     (1.9-LISP STREAM)) )))

(DEFINEQ (NLISP (LAMBDA ()
   (DEL.PROCESS '1.9-LISP-CONSUMER)
   (DISMISS 2000) (* Wait for dust to settle. *)
   (ADD.PROCESS '(1.9-LISP-CONSUMER)) )))

(DEFINEQ (PROMPT&READ (LAMBDA (STREAM)
    (PROG (ELEMENT EXP TEMPFILE)
      (TEDIT.INSERT STREAM "I> ")
      (WITH.MONITOR EXPRQ
         (UNTIL (NOT (NULL (CAR EXPRLIST))) DO
             (MONITOR.AWAIT.EVENT EXPRQ QNONEMPTY))
         (SETQ ELEMENT (CAR (CAR EXPRLIST)))
         (RPLACA EXPRLIST (CDR (CAR EXPRLIST)))
         (COND ((NULL (CAR EXPRLIST))
                (RPLACD EXPRLIST NIL))))
      (SETQ EXP (CAR ELEMENT))
      (SETQ TEMPFILE (CADR ELEMENT))
      (DELFILE TEMPFILE) (* For the time being. *)
      (PB.SETCARETPTR STREAM (GETEOFPTR STREAM))
      (TEDIT.INSERT STREAM
         (CONCAT (L-CASE EXP) (CHARACTER 13)))
      (TEDIT.NORMALIZECARET (TEXTOBJ STREAM)) 
      (BLOCK)
      (RETURN (IMPORT (U-CASE-ATOMS EXP)))) )))

(DEFINEQ (PROMPT&PRINT (LAMBDA (RESULT STREAM)
    (TEDIT.INSERT STREAM
        (CONCAT "I= " (L-CASE (EXPORT RESULT)) (CHARACTER 13)))
    (BLOCK) )))


STOP