(* 3-LISP mode for EMACS. *)


(GLOBALVARS EMACS.LAST.STREAM.FLASHED
            EMACS.LAST.CORRESPONDING.OPEN.PTR 
            EMACS.LAST.CLOSE.PTR
            EMACS.LAST.CLOSE.CHARACTER)

(CONSTANTS EMACS.WORD)
(SETQ EMACS.WORD 16)

(DEFINEQ (EMACS.ENTER.3LISP.MODE (LAMBDA ()
  (SETQ EMACS.LAST.STREAM.FLASHED NIL)
  (SETQ EMACS.LAST.CORRESPONDING.OPEN.PTR NIL) 
  (SETQ EMACS.LAST.CLOSE.PTR NIL) 
  (SETQ EMACS.LAST.CLOSE.CHARACTER NIL)
  (* Define EMACS.WORD for 3-LISP. *)
  (FOR I FROM 0 TO 255 DO
      (SETA EMACS.ARRAY I
             (LOGOR (ELT EMACS.ARRAY I) EMACS.WORD)))
  (FOR I IN (CONSTANT (LIST (CHARCODE "(") (CHARCODE ")") 
          (CHARCODE "[") (CHARCODE "]") (CHARCODE CR)  
          (CHARCODE LF) (CHARCODE TAB) (CHARCODE SP)  
          (CHARCODE "'") (CHARCODE "^") (CHARCODE "\")  
          (CHARCODE ",") (CHARCODE "%""))) DO
     (SETA EMACS.ARRAY I
          (LOGAND (ELT EMACS.ARRAY I)
               (LOGNOT EMACS.WORD)))))
  NIL)))


(* Backward "skip-read" for 3-lisp; i.e., returns no result, just 
   positions the stream pointer to before the first
   character of the sexpression to the left of the
   initial position of the cursor.  Error return if
   the input cannot be parsed, with the stream pointer
   left just before the character at which things
   seemed screwy. *)

(DEFINEQ (EMACS.SEXPR.BACK (LAMBDA (STREAM)
  (PROG (CHAR CLOSE.PTR)
     (EMACS.SKIP.SYNTAX.BACK STREAM EMACS.WS)
     (IF (EMACS.BOFP STREAM)  THEN         
         (ERROR!))
     (SETQ CHAR (\BACKBIN STREAM))
     (IF (EQ CHAR (CHARCODE ")")) THEN
         (EMACS.BALANCED.SEXPR.BACK STREAM (CHARCODE "(") (CHARCODE ")"))
         (SKIP.PREFIX.CHARACTERS.BACK STREAM)
         (RETURN NIL))
 
     (IF (EQ CHAR (CHARCODE "]")) THEN
         (EMACS.BALANCED.SEXPR.BACK STREAM (CHARCODE "[") (CHARCODE "]"))
         (SKIP.PREFIX.CHARACTERS.BACK STREAM)
         (RETURN NIL))

     (IF (EQ CHAR (CHARCODE "%"" )) THEN
         (PROG ()
            AGAIN
              (WHILE (AND (NOT (EMACS.BOFP STREAM))
                        (NEQ (SETQ CHAR (\BACKBIN STREAM)) 
                             (CHARCODE %" ))) DO
                   (* Keep reading. *))
              (IF (EQ (\BACKPEEKBIN STREAM) (CHARCODE %%)) THEN
                  (\BACKBIN STREAM)
                  (GO AGAIN)))
          (SKIP.PREFIX.CHARACTERS.BACK STREAM)
          (RETURN NIL))

     (IF (EQ CHAR (CHARCODE "(")) THEN
         (ERROR!))

     (IF (EQ CHAR (CHARCODE "[")) THEN
         (ERROR!))

     (EMACS.SKIP.SYNTAX.BACK STREAM EMACS.WORD)
     (SKIP.PREFIX.CHARACTERS.BACK STREAM)
     (RETURN)))))
           
               
(DEFINEQ (SKIP.PREFIX.CHARACTERS.BACK (LAMBDA (STREAM)
  (PROG (CHAR)
    (EMACS.SKIP.SYNTAX.BACK STREAM EMACS.WS)
    (WHILE (AND (NOT (EMACS.BOFP STREAM))
                (MEMB (SETQ CHAR (\BACKPEEKBIN STREAM))
                  (CONSTANT 
                    (LIST (CHARCODE %,) (CHARCODE %^)
                          (CHARCODE %\) (CHARCODE %'))))) DO
       (\BACKBIN STREAM)
       (EMACS.SKIP.SYNTAX.BACK STREAM EMACS.WS))
    (EMACS.SKIP.SYNTAX.FWD STREAM EMACS.WS)
    (RETURN)))))


(* EMACS.BALANCED.SEXPR.BACK: Back-skips the rest of an s-expr 
   that is bounded by single-character delimiters. OPENER is
   (the character code of) the opening delimiter; CLOSER is
   that of the matching closing delimiter.  Assumes that
   the stream is positioned to the left of the closing delimiter.
   Leaves the stream positioned to the left of the corresponding
   opening delimiter.  A simple one-entry cache is used. *)     

(DEFINEQ (EMACS.BALANCED.SEXPR.BACK (LAMBDA (STREAM OPENER CLOSER)
  (IF (NULL (NLSETQ
    (PROG (CHAR CLOSE.PTR)
      (SETQ CLOSE.PTR (EMACS.GETFILEPTR STREAM))
      (IF (AND (EQUAL EMACS.LAST.CLOSE.PTR CLOSE.PTR)
                (EQ EMACS.LAST.STREAM.FLASHED STREAM)
                (EQ CLOSER EMACS.LAST.CLOSE.CHARACTER)) THEN
        (EMACS.SETCARETPTR STREAM EMACS.LAST.CORRESPONDING.OPEN.PTR)
       ELSE  
        (WHILE (NEQ (SETQ CHAR (\BACKPEEKBIN STREAM)) OPENER) DO
            (EMACS.SEXPR.BACK STREAM)) 
        (\BACKBIN STREAM)
        (SETQ EMACS.LAST.CLOSE.PTR CLOSE.PTR) 
        (SETQ EMACS.LAST.STREAM.FLASHED STREAM) 
        (SETQ EMACS.LAST.CLOSE.CHARACTER CLOSER) 
        (SETQ EMACS.LAST.CORRESPONDING.OPEN.PTR
                (EMACS.GETFILEPTR STREAM))))
      T)) THEN
          (SETQ EMACS.LAST.STREAM.FLASHED NIL)
          (ERROR!)))))



(* Parenthesis balancing. *)

(DEFINEQ (EMACS.FLASH.SEXPR.BACK (LAMBDA (STREAM)
   (PROG (INITIAL.PTR MATCHED FINAL.PTR)
      (SETQ INITIAL.PTR (EMACS.GETFILEPTR STREAM))
      (SETQ MATCHED
          (NLSETQ
              (EMACS.SEXPR.BACK STREAM)
              T))
      (SETQ FINAL.PTR (EMACS.GETFILEPTR STREAM))
      (IF (NOT MATCHED) THEN
          (RINGBELLS))
      (IF (NOT (NULL (EMACS.GETFILEPTR STREAM))) THEN
          (TEDIT.SHOWSEL STREAM NIL)
          (TEDIT.SETSEL STREAM (ADD1 FINAL.PTR) 1 'RIGHT T)
          (DISMISS (IF MATCHED THEN 200 ELSE 1000)))
      (EMACS.SETCARETPTR STREAM INITIAL.PTR) 
      (RETURN))))) 

(DEFINEQ (\\COM.FLASH.PAREN (LAMBDA (STREAM)
   (\BOUT STREAM (CHARCODE ")"))
   (EMACS.FLASH.SEXPR.BACK STREAM))))

(EMACS.MAKE.COMMAND (CHARCODE ")") '\\COM.FLASH.PAREN) 

(DEFINEQ (\\COM.FLASH.BRACKET (LAMBDA (STREAM)
   (\BOUT STREAM (CHARCODE "]"))
   (EMACS.FLASH.SEXPR.BACK STREAM))))

(EMACS.MAKE.COMMAND (CHARCODE "]") '\\COM.FLASH.BRACKET)
        

(* New versions of commands that detect bad s-exprs. *)

(DEFINEQ (\\COM.BACKWARDS.SEXPR (LAMBDA (STREAM)
  (IF (NOT (NLSETQ (EMACS.SEXPR.BACK STREAM) T)) THEN
      (RINGBELLS)))))

(DEFINEQ (\\COM.FORWARD.SEXPR (LAMBDA (STREAM)
  (IF (NOT (NLSETQ (EMACS.SEXPR.FWD STREAM) T)) THEN
      (RINGBELLS)))))