;;; Command dispatch table functions for ZWEI.   -*- Mode:LISP; Package:ZWEI -*-
  * * ( c ) Copyright 1980 Massachusetts Institute of Technology * *
;;; The functions in this file implement COMTABs.
;;; This file also contains the basic editor command loop.

  A COMTAB is a command table .   It conceptually is indexed by possible user " keystrokes "
;;; (a keystroke may also be a mouse push or anything else like that), and contains
;;; a COMMAND for each one.  A COMMAND may be any of:
;;;   NIL    -- The keystroke is unassigned.  If there is a COMTAB-INDIRECT-TO,
              look in that COMTAB .
    : UNDEFINED -- The keystroke is REALLY unassigned , regardless of indirecting .
    A list -- The command is a synonym , pointing at some other slot in the COMTAB .
              the list should have two elements , the control - meta and the char parts
;;;             of a keystroke on the keyboard.
    Some other symbol -- A command as defined by DEFCOM ,  .
(DEFSTRUCT (COMTAB)
  COMTAB-KEYBOARD-ARRAY		;Commands gotten by typing on the keyboard.
  COMTAB-MOUSE-ARRAY		;Commands gotten by pushing mouse buttons.
Alist of long - named commands .
A COMTAB to try when you find NIL in this COMTAB .

;;; Needed by COM-LIST-COMMANDS, among others.
(DEFUN EXTENDED-COMMAND-ALIST (COMTAB) (COMTAB-EXTENDED-COMMANDS COMTAB))

  Given a COMTAB and a character like those from the command stream ,
  return the corresponding command .   If the third arg is non - NIL ,
  do not chase down when you find a list in the COMTAB .
(DEFUN COMMAND-LOOKUP (CHAR COMTAB &OPTIONAL NO-INDIRECTION-P)
  (DO ((CTB COMTAB) (CH CHAR)
       (KEYBOARD-ARRAY) (COMMAND))
      (NIL)
    (SETQ KEYBOARD-ARRAY (COMTAB-KEYBOARD-ARRAY CTB)
	  COMMAND (COND ((NOT (ARRAYP KEYBOARD-ARRAY))
			 (CDR (ASSQ CH KEYBOARD-ARRAY)))
			((LDB-TEST %%KBD-MOUSE CH)
			 (AREF (COMTAB-MOUSE-ARRAY CTB)
			       (MIN (LDB %%KBD-MOUSE-N-CLICKS CH) 1)
			       (LDB %%KBD-MOUSE-BUTTON CH)))
			(T
			 (AREF KEYBOARD-ARRAY
			       (LDB %%KBD-CHAR CH)
			       (LDB %%KBD-CONTROL-META CH)))))
    (IF (OR (NOT (LISTP COMMAND)) NO-INDIRECTION-P)
	(AND (OR COMMAND (NULL (SETQ CTB (COMTAB-INDIRECT-TO CTB))))
	     (RETURN COMMAND))
	(SETQ CTB COMTAB
	      CH (DPB (FIRST COMMAND) %%KBD-CONTROL-META (SECOND COMMAND))))))

  Store COMMAND in the slot of COMTAB denoted by  .
(DEFUN COMMAND-STORE (COMMAND CHAR COMTAB &AUX KEYBOARD-ARRAY)
  (SETQ KEYBOARD-ARRAY (COMTAB-KEYBOARD-ARRAY COMTAB))
  (COND ((NOT (ARRAYP KEYBOARD-ARRAY))
	 (LET ((ELEMENT (ASSQ CHAR KEYBOARD-ARRAY)))
	   (IF ELEMENT (RPLACD ELEMENT COMMAND)
	       (PUSH (CONS CHAR COMMAND) (COMTAB-KEYBOARD-ARRAY COMTAB)))))
	((LDB-TEST %%KBD-MOUSE CHAR)
	 (ASET COMMAND
	       (COMTAB-MOUSE-ARRAY COMTAB)
	       (MIN (LDB %%KBD-MOUSE-N-CLICKS CHAR) 1)
	       (LDB %%KBD-MOUSE-BUTTON CHAR)))
	(T
	 (ASET COMMAND
	       KEYBOARD-ARRAY
	       (LDB %%KBD-CHAR CHAR)
	       (LDB %%KBD-CONTROL-META CHAR)))))

  Execute the result of calling COMMAND - LOOKUP ( without the third argument ) .
;;; This should be given the CHAR as well as the COMMAND, for error message reporting.
  The third arg is also for error reporting , and is used if this COMTAB was gotten
;;; from a prefix command.  The elements of the hook-list are applied
;;; to the char before the comand is run, AFTER the error checks are made.
(DEFUN COMMAND-EXECUTE (COMMAND CHAR &OPTIONAL PREFIX-CHAR HOOK-LIST)
  (COND ((MEMQ COMMAND '(NIL :UNDEFINED))
	 (BARF "~:[~:@C ~;~*~]~:@C is not a defined key.~:[  (Do Dah, Do Dah)~]"
	       (NOT PREFIX-CHAR) PREFIX-CHAR CHAR (NOT (= CHAR #/))))
	((AND (SYMBOLP COMMAND)
	      (NOT (FBOUNDP COMMAND)))
	 (BARF "~S is not implemented." COMMAND)))
  (DOLIST (HOOK HOOK-LIST)
    (FUNCALL HOOK CHAR))
  (FUNCALL COMMAND))

;;; Push a hook onto the COMMAND-HOOK with the right priority, returning the undo form
(DEFUN COMMAND-HOOK (HOOK HOOK-SYMBOL)
  (LET ((PRI (GET HOOK 'COMMAND-HOOK-PRIORITY)))
    (OR PRI (FERROR NIL "~S is not a valid command hook." HOOK))
    (DO ((L (SYMEVAL HOOK-SYMBOL) (CDR L))
	 (PREV NIL L))
	((OR (NULL L)
	     (> (GET (CAR L) 'COMMAND-HOOK-PRIORITY) PRI))
	 (LET ((X (CONS HOOK L)))
	   (COND (PREV (RPLACD PREV X))
		 (T (SET HOOK-SYMBOL X)))))))
  `(SETQ ,HOOK-SYMBOL (DELQ ',HOOK ,HOOK-SYMBOL)))

  Create a new , empty COMTAB .
(DEFUN CREATE-COMTAB ()
  (MAKE-COMTAB COMTAB-KEYBOARD-ARRAY (MAKE-ARRAY NIL 'ART-Q '(240 16.))
	       COMTAB-MOUSE-ARRAY (MAKE-ARRAY NIL 'ART-Q '(2 3))))

;;; Create a comtab for just storing mode changes in
(DEFUN CREATE-SPARSE-COMTAB ()
  (MAKE-COMTAB COMTAB-KEYBOARD-ARRAY NIL))

  Copy a COMTAB .   Copies the arrays , and the list structure of the extended command alist .
  NOTE : this function does n't make the comtab occupy fewer pages , since the array part
  and the alist part ca n't be on the same page anyway , and the alist part is all on one
  page since it was consed up all at once .   Furthermore the new copy is not EQ to the
  old copy , which screws up comtab indirection .
(DEFUN COPY-COMTAB (OLD-COMTAB)
  (LET ((NEW-COMTAB (CREATE-COMTAB)))
    (LET ((OKBD (COMTAB-KEYBOARD-ARRAY OLD-COMTAB))
	  (OMSE (COMTAB-MOUSE-ARRAY OLD-COMTAB))
	  (NKBD (COMTAB-KEYBOARD-ARRAY NEW-COMTAB))
	  (NMSE (COMTAB-MOUSE-ARRAY NEW-COMTAB)))
       (DOTIMES (I (ARRAY-DIMENSION-N 1 OKBD))
	 (DOTIMES (J (ARRAY-DIMENSION-N 2 OKBD))
	   (ASET (AREF OKBD I J) NKBD I J)))
       (DOTIMES (I (ARRAY-DIMENSION-N 1 OMSE))
	 (DOTIMES (J (ARRAY-DIMENSION-N 2 OMSE))
	   (ASET (AREF OMSE I J) NMSE I J))))
    (SETF (COMTAB-INDIRECT-TO NEW-COMTAB) (COMTAB-INDIRECT-TO OLD-COMTAB))
    (SETF (COMTAB-EXTENDED-COMMANDS NEW-COMTAB)
	  (SUBST NIL NIL (COMTAB-EXTENDED-COMMANDS OLD-COMTAB)))
    NEW-COMTAB))

  The first argument is a COMTAB to modify ; if it is NIL , a new COMTAB is created .
  The second argument is a list of specifications .   The elements are considered in
  pairs .   The first of a pair is a char name ( see COMMAND - CHAR - FROM - NAME below ) .
  The second is indicates the command to store in the slot denoted by that char ,
  and the second is the command to store .
  The first element may be a list , in which case iteration is requested ;
  it should be a two - list of a command name and an iteration count .
;;; The specified character and that many contiguous slots after it are specified.
  The second is then either a symbol to be stored in all of the slots ,
;;; or a function to be applied to the char whose slot is under consideration,
;;; in which case what it returns is stored.
  The third argument is a list of new entries to be appended to the comtab 's
;;; extended command alist.
  If a new COMTAB is created , all entries for lower - case keyboard characters
;;; are set to indirect through the corresponding upper-case characters.
(DEFUN SET-COMTAB (COMTAB SPECS &OPTIONAL EXTENDED-COMMANDS)
  (COND ((NULL COMTAB)
	 (SETQ COMTAB (CREATE-COMTAB))
	 (SET-COMTAB-UPPERCASE-INDIRECTION COMTAB)))
  (DO L SPECS (CDDR L) (NULL L)
    (COND ((LISTP (CAR L))
	   (DO ((CHAR (COMMAND-CHAR-FROM-NAME (CAAR L)) (1+ CHAR))
		(I 0 (1+ I))
		(TO (CADAR L))
		(COMMAND (CADR L)))
	       (( I TO))
	     (COMMAND-STORE (IF (SYMBOLP COMMAND)
				COMMAND
				(FUNCALL COMMAND CHAR))
			    CHAR
			    COMTAB)))
	(T (COMMAND-STORE (CADR L) (COMMAND-CHAR-FROM-NAME (CAR L)) COMTAB))))
  (SETF (COMTAB-EXTENDED-COMMANDS COMTAB)
	(APPEND EXTENDED-COMMANDS (COMTAB-EXTENDED-COMMANDS COMTAB)))
  COMTAB)

  Make lower - case characters in this COMTAB all indirect to the
;;; corresponding upper-case characters.
(DEFUN SET-COMTAB-UPPERCASE-INDIRECTION (COMTAB)
  (LET ((ARRAY (COMTAB-KEYBOARD-ARRAY COMTAB)))
    (DOTIMES (I (ARRAY-DIMENSION-N 2 ARRAY))
       (DO CHAR #/a (1+ CHAR) (> CHAR #/z)
	 (ASET (LIST I (- CHAR 40)) ARRAY CHAR I)))))

  Simulate the effect of the Teco 7 - bit character set
;;; But only store over undefined commands
(DEFUN SET-COMTAB-CONTROL-INDIRECTION (COMTAB)
  (LET ((ARRAY (COMTAB-KEYBOARD-ARRAY COMTAB)))
Indirect things like  to things like control - I
    (DOLIST (CHAR '(#\CR #\LF #\TAB #\BS #\FF #\VT))
      (AND (NULL (AREF ARRAY CHAR 0))
	   (ASET (LIST 1 (- CHAR 100)) ARRAY CHAR 0)))
    ;;Indirect all meta things through the corresponding non-meta thing
    (DO I 2 (1+ I) (= I 4)
      (DOTIMES (CHAR (ARRAY-DIMENSION-N 1 ARRAY))
	(AND (NULL (AREF ARRAY CHAR I))
	     (ASET (LIST (- I 2) CHAR) ARRAY CHAR I))))
    ;;Indirect controls other than atsign through underscore to non-controls
    (DOTIMES (CHAR (ARRAY-DIMENSION-N 1 ARRAY))
      (AND (NOT (AND ( CHAR #/@) ( CHAR #/_)))
	   (NULL (AREF ARRAY CHAR 1))
	   (ASET (LIST 0 CHAR) ARRAY CHAR 1)))))

  Take a SET - COMTAB form , and make a second form that will undo what the first does .
(DEFUN MAKE-SET-COMTAB-UNDO-LIST (FORM)
  (LET ((COMTAB (EVAL (SECOND FORM)))
	(UN-SPECS))
    (COND ((NULL COMTAB)
	   (FERROR NIL "A (SET-COMTAB NIL ...) form cannot be undone.")))
    (DO S (EVAL (THIRD FORM)) (CDDR S) (NULL S)
      (LET ((CHAR-NAME (FIRST S)))
	(COND ((LISTP CHAR-NAME)
	       (FERROR NIL "A SET-COMTAB with a List character name cannot be undone.")))
	(PUSH (COMMAND-LOOKUP (COMMAND-CHAR-FROM-NAME CHAR-NAME) COMTAB) UN-SPECS)
	(PUSH CHAR-NAME UN-SPECS)))
    `(PROGN (REMOVE-EXTENDED-COMMANDS ',(EVAL (FOURTH FORM)) ',COMTAB)
	    (SET-COMTAB ',COMTAB ',UN-SPECS))))

(DEFUN SET-COMTAB-RETURN-UNDO (&REST &QUOTE FORM &AUX UNDO)
  (SETQ FORM (CONS 'SET-COMTAB FORM)
	UNDO (MAKE-SET-COMTAB-UNDO-LIST FORM))
  (EVAL FORM)
  UNDO)

(DEFUN REMOVE-EXTENDED-COMMANDS (COMMAND-LIST COMTAB)
  (LET ((EC (COMTAB-EXTENDED-COMMANDS COMTAB)))
    (DOLIST (COMMAND COMMAND-LIST)
	(SETQ EC (DELQ (ASSQ COMMAND EC) EC)))
    (SETF (COMTAB-EXTENDED-COMMANDS COMTAB) EC)))

;;; Set the indirection of OF to TO.
(DEFUN SET-COMTAB-INDIRECTION (OF TO)
  (SETF (COMTAB-INDIRECT-TO OF) TO))

;;; This takes a string specification of a command char (the numeric code for
;;; a keystroke), and returns the command char.  Specifications may look like:
;;;   "A", "B", "V", "", etc., referring to keyboard characters.
;;;   "MOUSE-n-m", where n and m are numbers relating which button and how many clicks.
;;; Note: this function is semi-obselete, since the reader allows specification of all
;;; characters.
(DEFUN COMMAND-CHAR-FROM-NAME (NAME)
  (IF (NUMBERP NAME) NAME
      (LET ((I (STRING-MATCH "MOUSE" NAME)))
	(COND ((NULL I)
  The name does not start with MOUSE .
	       (LET ((CHAR1 (AREF NAME 0)))
		 (LET ((X (ASSQ CHAR1 '((#/ . 0) (#/ . 1) (#/ . 2) (#/ . 3)))))
		   (COND ((NULL X) CHAR1)
			 (T (DPB (CDR X) %%KBD-CONTROL-META (AREF NAME 1)))))))
	      (T
	       (MULTIPLE-VALUE-BIND (BUTTON J)
		 (PARSE-NUMBER NAME (1+ I))
		 (LET ((N-CLICKS (PARSE-NUMBER NAME (1+ J))))
		   (COND ((OR (GREATERP 1 BUTTON 3)
			      (GREATERP 1 N-CLICKS 2))
			  (FERROR NIL "Invalid mouse specification ~A" NAME))
			 (T (DPB 1 %%KBD-MOUSE
				 (DPB (1- BUTTON) %%KBD-MOUSE-BUTTON
				      (DPB (1- N-CLICKS) %%KBD-MOUSE-N-CLICKS 0))))))))))))

(DEFUN KEY-EXECUTE (KEY &OPTIONAL (*NUMERIC-ARG-P* NIL) (*NUMERIC-ARG* 1))
  (COMMAND-EXECUTE (COMMAND-LOOKUP KEY *COMTAB*) KEY))

;; This is the Meta-X command.
;; Note that numeric arg is transmitted via dynamic scoping etc.
(DEFCOM COM-EXTENDED-COMMAND "" ()
  (LET ((ANS (GET-EXTENDED-COMMAND (FORMAT NIL "Extended command:~:[  (Arg = ~A.)~]"
					    (NOT *NUMERIC-ARG-P*)
					    (FORMAT-ARGUMENT *NUMERIC-ARG-P* *NUMERIC-ARG*))
				   *COMTAB*)))
    (COND ((EQUAL ANS "")
	   (BEEP)
	   DIS-NONE)
	  (T
	   (LET ((*CURRENT-COMMAND* (CDR ANS)))
	     (FUNCALL *CURRENT-COMMAND*))))))

(DEFUN FORMAT-ARGUMENT (ARG-P ARG)
  (SELECTQ ARG-P
    (NIL "")
    (:SIGN (IF (MINUSP ARG) "-" "+"))
    (:DIGITS (FORMAT NIL "~D" ARG))
    (:CONTROL-U
      (DO ((STR "Control-U" (STRING-APPEND "Control-U" #\SP STR))
	   (A (ABS ARG) (// A 4)))
	  ((= A 4) (IF (MINUSP ARG) (STRING-APPEND "-" #\SP STR) STR))))))

(DEFPROP COM-EXTENDED-COMMAND DOCUMENT-EXTENDED-COMMAND DOCUMENTATION-FUNCTION)
(DEFUN DOCUMENT-EXTENDED-COMMAND (COMMAND CHAR OP)
  (COND ((EQ OP ':NAME) "a prefix for extended commands")
	((MEMQ OP '(:FULL :SHORT))
	 (FORMAT T "Completing reads and executes a command from the mini buffer")
	 (COND ((EQ OP ':FULL)
		(SETQ COMMAND (GET-EXTENDED-COMMAND "Type a command to document:" *COMTAB*))
		(OR (EQUAL COMMAND "")
		    (PRINT-DOC OP (CDR COMMAND) CHAR)))))))

(DEFUN GET-EXTENDED-COMMAND (PROMPT COMTAB)
  (DO ((CI (COMTAB-INDIRECT-TO COMTAB) (COMTAB-INDIRECT-TO CI))
       (C *COMTAB* CI)
       (EC))
      ((NULL CI))
    (COND ((LISTP (SETQ EC (COMTAB-EXTENDED-COMMANDS C)))
	   (RPLACD (LAST EC)			;Put in alist indirections
		   (LOCF (COMTAB-EXTENDED-COMMANDS CI))))
	  ((OR (NULL EC) (LOCATIVEP EC))
	   (SETF (COMTAB-EXTENDED-COMMANDS C)
		 (LOCF (COMTAB-EXTENDED-COMMANDS CI))))))
  (COMPLETING-READ-FROM-MINI-BUFFER PROMPT
				    (COMTAB-EXTENDED-COMMANDS *COMTAB*)
				    NIL ;Impossible is not OK.
				    NIL ;Don't do initial completion (it won't work anyway)
				    "You are typing an extended command."
				    #'(LAMBDA (X)
					      (LET ((STANDARD-OUTPUT *TYPEOUT-WINDOW*))
						(PRINT-DOC ':FULL (CDR X))))))

(DEFCOM COM-ANY-EXTENDED-COMMAND "Execute any loaded zwei command, even if not assigned" ()
  (LET ((ANS (COMPLETING-READ-FROM-MINI-BUFFER
	       (FORMAT NIL "Command:~:[  (Arg = ~A)~]"
		       (NOT *NUMERIC-ARG-P*) (FORMAT-ARGUMENT *NUMERIC-ARG-P* *NUMERIC-ARG*))
	       *COMMAND-ALIST* NIL NIL
	       "You are typing the name of a ZWEI command."
	       #'(LAMBDA (X)
		   (LET ((STANDARD-OUTPUT *TYPEOUT-WINDOW*))
		     (PRINT-DOC ':FULL (CDR X)))))))
    (COND ((EQUAL ANS "")
	   (BEEP)
	   DIS-NONE)
	  (T
	   (LET ((*CURRENT-COMMAND* (CDR ANS)))
	     (FUNCALL *CURRENT-COMMAND*))))))

(LOCAL-DECLARE ((SPECIAL COMTAB))
(DEFUN MAKE-EXTENDED-COMMAND (THE-COMTAB)
  (LET-CLOSED ((COMTAB THE-COMTAB))
    'MAKE-EXTENDED-COMMAND-INTERNAL))

(DEFUN MAKE-EXTENDED-COMMAND-INTERNAL (&AUX (PREFIX-CHAR *LAST-COMMAND-CHAR*))
  (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
    (LET ((CHAR (FUNCALL STANDARD-INPUT ':MOUSE-OR-KBD-TYI-NO-HANG)))
      (COND ((NULL CHAR)	;Have to wait for it, so prompt
	     (PROMPT-LINE "~:[~*~;~A ~]~:@C: "
			  *NUMERIC-ARG-P* (FORMAT-ARGUMENT *NUMERIC-ARG-P* *NUMERIC-ARG*)
			  PREFIX-CHAR)
	     (SETQ CHAR (PROMPT-LINE-ACTIVATE
			  (FUNCALL STANDARD-INPUT ':MOUSE-OR-KBD-TYI)))
	     (PROMPT-LINE-MORE "~:@C" CHAR)
	     (FUNCALL *MODE-LINE-WINDOW* ':DONE-WITH-MODE-LINE-WINDOW)))
      (AND (LDB-TEST %%KBD-MOUSE CHAR) (BARF))
      (SETQ *LAST-COMMAND-CHAR* CHAR)))
  (SETQ *CURRENT-COMMAND* (COMMAND-LOOKUP *LAST-COMMAND-CHAR* COMTAB))
  (COMMAND-EXECUTE *CURRENT-COMMAND* *LAST-COMMAND-CHAR* PREFIX-CHAR))
)

(DEFUN GET-PREFIX-COMMAND-COMTAB (X)
  (SYMEVAL-IN-CLOSURE X 'COMTAB))

(DEFUN PREFIX-COMMAND-P (X &AUX TEM)
  (AND (CLOSUREP X)
       (SETQ TEM (CADR (%MAKE-POINTER DTP-LIST X)))
       (EQ (%FIND-STRUCTURE-HEADER TEM) 'COMTAB)))

(DEFUN MACRO-COMMAND-P (X &AUX TEM)
  (AND (CLOSUREP X)
       (SETQ TEM (CADR (%MAKE-POINTER DTP-LIST X)))
       (EQ (%FIND-STRUCTURE-HEADER TEM) 'SYMBOL)))

(DEFUN MAKE-MACRO-COMMAND (THE-SYMBOL)
  (LET-CLOSED ((SYMBOL THE-SYMBOL))
    #'(LAMBDA ()
	(LET ((MAC (GET SYMBOL 'MACRO-STREAM-MACRO)))
	  (OR MAC (BARF "The macro ~A is not defined." SYMBOL))
	  (OR (MEMQ ':MACRO-EXECUTE (FUNCALL STANDARD-INPUT ':WHICH-OPERATIONS))
	      (BARF "The input stream does not support macros."))
	  (FUNCALL STANDARD-INPUT ':MACRO-EXECUTE MAC
		   (AND *NUMERIC-ARG-P* *NUMERIC-ARG*))
	  DIS-NONE))))

(DEFUN KEY-FOR-COMMAND (COMMAND &OPTIONAL (COMTAB *COMTAB*))
  (DO-NAMED FOUND
      ((I 0 (1+ I)))
      (( I 4))
    (DOTIMES (J 220)
      (LET ((CH (DPB I %%KBD-CONTROL-META J))
	    TEM)
	(AND (EQ COMMAND (SETQ TEM (COMMAND-LOOKUP CH COMTAB)))
	     (RETURN-FROM FOUND (FORMAT NIL "~:C" CH)))
	(AND (PREFIX-COMMAND-P TEM)
	     (SETQ TEM (KEY-FOR-COMMAND COMMAND (GET-PREFIX-COMMAND-COMTAB TEM)))
	     (RETURN-FROM FOUND (FORMAT NIL "~:C ~A" CH TEM)))))))

;;; The command loop.

  This is the fundamental ZWEI command loop .   It takes a COMTAB and a window ,
  and lets the user edit the window using the COMTAB .   It finds the interval
;;; to edit by looking in the window.  This binds all of the standard per-invocation
;;; globals, except PACKAGE, which the caller must bind.
;;; The *COMMAND-LOOP-CLOSURE-LIST* is used to prevent consing new closures for the
  same set of COMTAB WINDOW NOT - TOP - LEVEL parameters , hopefully this wo nt screw
;;; anything.
(DEFVAR *COMMAND-LOOP-INSTANCE-LIST* NIL)
(DEFUN COMMAND-LOOP (COMTAB WINDOW &OPTIONAL (TYPE 'EDITOR) &AUX INSTANCE)
  (DOLIST (CLL *COMMAND-LOOP-INSTANCE-LIST*)
    (COND ((AND (EQ COMTAB (FIRST CLL))
		(EQ WINDOW (SECOND CLL))
		(EQ TYPE (THIRD CLL)))
	   (SETQ INSTANCE (FOURTH CLL))
	   (RETURN NIL))))
  (COND ((NULL INSTANCE)
	 (SETQ INSTANCE (MAKE-COMMAND-LOOP COMTAB WINDOW TYPE))
	 (PUSH (LIST COMTAB WINDOW TYPE INSTANCE) *COMMAND-LOOP-INSTANCE-LIST*)))
  (FUNCALL INSTANCE ':EDIT))

(DEFUN MAKE-COMMAND-LOOP (COMTAB WINDOW &OPTIONAL (TYPE 'EDITOR) &REST OPTIONS &AUX PLIST)
  (SETQ OPTIONS (COPYLIST OPTIONS)
	PLIST (LOCF OPTIONS))
  (PUTPROP PLIST COMTAB ':*COMTAB*)
  (PUTPROP PLIST WINDOW ':*WINDOW*)
  (INSTANTIATE-FLAVOR TYPE PLIST T))

(DEFMETHOD (EDITOR :AFTER :INIT) (IGNORE)
  (SETQ *INTERVAL* (WINDOW-INTERVAL *WINDOW*)))

(DEFMETHOD (TOP-LEVEL-EDITOR :AFTER :INIT) (IGNORE)
  (SETQ *MODE-COMTAB* (CREATE-SPARSE-COMTAB))
  (SET-COMTAB-INDIRECTION *MODE-COMTAB* *COMTAB*)
  (SETQ *COMTAB* *MODE-COMTAB*)
  (SETQ *MODE-WORD-SYNTAX-TABLE* (MAKE-SPARSE-SYNTAX-TABLE *WORD-SYNTAX-TABLE*))
  (TURN-ON-MODE *MAJOR-MODE*)
  (SETQ TV:IO-BUFFER (WINDOW-IO-BUFFER *WINDOW*))
  (SETQ *TYPEOUT-WINDOW* (WINDOW-TYPEOUT-WINDOW *WINDOW*))
  (MULTIPLE-VALUE (*MODE-LINE-WINDOW* *TYPEIN-WINDOW* *MINI-BUFFER-WINDOW*)
    (WINDOW-MODE-LINE-WINDOWS *WINDOW*)))

;;; This is the function that does the actual work
;Non top-level editors are only called from inside a top-level
;editor.  Therefore the instance variable TV:IO-BUFFER will always be accessible.
(LOCAL-DECLARE ((SPECIAL TV:IO-BUFFER))
(DEFMETHOD (EDITOR :EDIT) (&OPTIONAL (TOP-LEVEL-P (FUNCALL-SELF ':TOP-LEVEL-P)))
  (TV:PROCESS-TYPEAHEAD TV:IO-BUFFER
			#'(LAMBDA (CH)
			    (COND ((NLISTP CH) CH)
				  ((EQ (CAR CH) 'SELECT-WINDOW)
				   (APPLY #'PROCESS-SPECIAL-COMMAND CH)
				   NIL)
				  ((EQ (CAR CH) 'REDISPLAY)
				   NIL)
				  (T CH))))
  (UNWIND-PROTECT
Do n't expose yet , but on first redisplay
		    ':START-DELAYED-SELECT)
	   (*CATCH 'RETURN-FROM-COMMAND-LOOP
	     (*CATCH (IF TOP-LEVEL-P 'EXIT-TOP-LEVEL 'EXIT-CONTROL-R)
Make things like BREAK , TRACE , errors use typeout window
		   ((TERMINAL-IO *TYPEOUT-WINDOW*)
		    (STANDARD-OUTPUT 'SI:TERMINAL-IO-SYN-STREAM))
		   (NIL)
		 (*CATCH 'SI:TOP-LEVEL    ;Catch C-Z in error handlers.
		   (*CATCH 'ZWEI-COMMAND-LOOP
		     (*CATCH (IF TOP-LEVEL-P 'TOP-LEVEL 'DUMMY-TAG)
		       (PROG (CH)
			 (SETQ *LAST-COMMAND-TYPE* *CURRENT-COMMAND-TYPE*
			       *CURRENT-COMMAND-TYPE* NIL
			       *NUMERIC-ARG* 1
			       *NUMERIC-ARG-P* NIL
			       *NUMERIC-ARG-N-DIGITS* 0
			       *MARK-STAYS* NIL
			       *MINI-BUFFER-COMMAND* NIL)
			 (REDISPLAY-ALL-WINDOWS)
			 (SETQ *CENTERING-FRACTION* *CENTER-FRACTION*)
			UNREAL-COMMAND
			 (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
			   (SETQ CH (FUNCALL STANDARD-INPUT ':ANY-TYI)))
If EOF , return
				(RETURN NIL))
			       ((LISTP CH)			;Handle mouse, etc
				(SETQ *LAST-COMMAND-CHAR* CH)
				(COND ((NOT (APPLY #'PROCESS-SPECIAL-COMMAND CH))
				       (REDISPLAY-ALL-WINDOWS NIL NIL)
				       (GO UNREAL-COMMAND))))
			       ((NUMBERP CH)			;Keyboard or mouse character
				(COND ((EQ ':ARGUMENT (PROCESS-COMMAND-CHAR CH))
				       (SETQ *NUMERIC-ARG-N-DIGITS*
					     (1+ *NUMERIC-ARG-N-DIGITS*))
				       (REDISPLAY-ALL-WINDOWS NIL NIL)
				       (GO UNREAL-COMMAND)))))
			 ;; If there is typeout (window-typeout-stream style) that the user
			 ;; hasn't finished reading, wait for a character, and if it's space,
			 ;; ignore it and redisplay.
			 (COND ((TV:BASIC-TYPEOUT-WINDOW-INCOMPLETE-P *TYPEOUT-WINDOW*)
				(FUNCALL *TYPEOUT-WINDOW* ':MAKE-COMPLETE)
				(WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
				  (DO ((CHAR (FUNCALL STANDARD-INPUT ':ANY-TYI)
					     (FUNCALL STANDARD-INPUT ':ANY-TYI)))
				      ((NOT (AND (LISTP CHAR)
						 ;; Ignore requests to select current window
						 (EQ (FIRST CHAR) 'SELECT-WINDOW)
						 (EQ (SECOND CHAR) *WINDOW*)))
				       (OR (EQ CHAR #\SP)
					   ;; If it's not a space, unread it.  That will
					   ;; prevent redisplay.
					   (FUNCALL STANDARD-INPUT ':UNTYI CHAR)))))))))))
		 ;; If we Z from BREAK or an error, make the typeout go away.
		 ;; This is also executed after every real command, but not after
		 ;; mouse signals and keystrokes that just set the arguments for
		 ;; following commands.
		 (FUNCALL *TYPEOUT-WINDOW* ':MAKE-COMPLETE)))))
    (FUNCALL (WINDOW-SHEET *WINDOW*) ':FLUSH-DELAYED-SELECT))))

(DEFMETHOD (EDITOR :TOP-LEVEL-P) () NIL)
(DEFMETHOD (TOP-LEVEL-EDITOR :TOP-LEVEL-P) () T)
(DEFMETHOD (EDITOR :EXPOSE-MODE-LINE-WINDOW) (&OPTIONAL IGNORE))

;;; Handle a normal command character, either a keyboard or mouse
(DEFUN PROCESS-COMMAND-CHAR (CH &AUX VALUE LINE INDEX)
  (SETQ *LAST-COMMAND-CHAR* CH)
  ;; Look up the command in the table.
  (LET ((*CURRENT-COMMAND* (COMMAND-LOOKUP *LAST-COMMAND-CHAR* *COMTAB*)))
    ;; Execute the command.
    (MULTIPLE-VALUE (VALUE LINE INDEX)
      (COMMAND-EXECUTE *CURRENT-COMMAND* *LAST-COMMAND-CHAR* NIL *COMMAND-HOOK*))
    ;; This command is creating the argument to a subsequent command.
    (COND ((EQ VALUE ':ARGUMENT)
	   VALUE)
	  (T
	   ;; If the mark is not being preserved, make it go away.
	   (COND ((AND (NOT *MARK-STAYS*) (WINDOW-MARK-P *WINDOW*))
		  (SETF (WINDOW-MARK-P *WINDOW*) NIL)
		  (MUST-REDISPLAY *WINDOW* DIS-MARK-GOES)))
	   ;; Report the returned value of the command to the window.
	   (MUST-REDISPLAY *WINDOW* VALUE LINE INDEX)
	   ;; Call the post-command hooks
	   (DOLIST (HOOK *POST-COMMAND-HOOK*) (FUNCALL HOOK *LAST-COMMAND-CHAR*))))))

;;; This handles special commands from the window system
;;; returns non-NIL if the typeout window should be flushed like normal commands.
(DEFSELECT (PROCESS-SPECIAL-COMMAND UNKNOWN-SPECIAL-COMMAND)
  (REDISPLAY ()
    ;The window is presumably on our list of windows and will get redisplayed
    ;in the normal course of events when buffered input had been processed.
    NIL)
  (SELECT-WINDOW (WINDOW)
    (MAKE-WINDOW-CURRENT WINDOW)
    T)
  (CONFIGURATION-CHANGED ()
   (AND (NOT (WINDOW-EXPOSED-P *WINDOW*))
	(DOLIST (W *WINDOW-LIST*)
	  (AND (WINDOW-EXPOSED-P W)
	       (MAKE-WINDOW-CURRENT W NIL))))
   NIL)
  (SCROLL (WINDOW NLINES TYPE)
    (OR (EQ TYPE ':RELATIVE)
	(SETQ TYPE ':START
	      NLINES (FORWARD-LINE (INTERVAL-FIRST-BP (WINDOW-INTERVAL WINDOW)) NLINES T)))
    (REDISPLAY WINDOW TYPE NLINES)
    T)
  (:MOUSE (WINDOW CH *MOUSE-X* *MOUSE-Y*)
    (AND (MEMQ ':RECORD (FUNCALL STANDARD-INPUT ':WHICH-OPERATIONS))
	 (FUNCALL STANDARD-INPUT ':RECORD CH))
    (IF (NEQ WINDOW *WINDOW*)		;Given in another window,
	(LET ((*COMTAB* *STANDARD-COMTAB*)
	      (*LAST-COMMAND-TYPE* NIL)	;dont confuse mouse mark thing, and
	      *CURRENT-COMMAND-TYPE*
	      (*WINDOW* WINDOW))		;temporarily act there (mini-buffer)
	  (PROCESS-COMMAND-CHAR CH))
	(PROCESS-COMMAND-CHAR CH))
    T)
  ((:TYPEOUT-EXECUTE :EXECUTE) (FUNCTION &REST ARGS)
   (NOT (APPLY FUNCTION ARGS))))

(DEFUN UNKNOWN-SPECIAL-COMMAND (TYPE &REST REST)
  REST						;Not needed
  (CERROR T NIL 'UNKNOWN-SPECIAL-COMMAND "~S is not a valid special editor command" TYPE))

(DEFUN TYI-WITH-SCROLLING (&OPTIONAL MOUSE-OR-KBD-TYI-P)
  (DO ((CH)) (NIL)
    (COND ((NUMBERP (SETQ CH (FUNCALL STANDARD-INPUT ':ANY-TYI)))
	   (RETURN CH CH))
	  ((NLISTP CH))
	  ((EQ (CAR CH) 'SCROLL)
	   (APPLY #'PROCESS-SPECIAL-COMMAND CH))
	  ((AND MOUSE-OR-KBD-TYI-P (EQ (CAR CH) ':MOUSE))
	   (RETURN (THIRD CH) CH)))))

;;; Recursive edit on the same buffer
(DEFUN CONTROL-R (&AUX (COMTAB *COMTAB*))
  (COND ((NEQ COMTAB *CONTROL-R-COMTAB*)
	 (SET-COMTAB-INDIRECTION *CONTROL-R-COMTAB* COMTAB)
	 (SETQ COMTAB *CONTROL-R-COMTAB*)))
  (LET ((*COMTAB* COMTAB)
	(*MODE-LINE-LIST* `("[" ,@*MODE-LINE-LIST* " R]")))
    (FUNCALL-SELF ':EDIT NIL)))

;;; Recursive edit with a temporary window on the given interval
(DEFUN RECURSIVE-EDIT (INTERVAL MODE &OPTIONAL POINT
				     &AUX (WINDOW (CREATE-OVERLYING-WINDOW *WINDOW*))
				     (SHEET (WINDOW-SHEET WINDOW)))
  (SET-WINDOW-INTERVAL WINDOW INTERVAL)
  (AND POINT (MOVE-BP (WINDOW-POINT WINDOW) POINT))
  (LET ((*EDITOR-ALREADY-KNOWS* T))
    (TV:WINDOW-CALL (SHEET :DEACTIVATE)
      (LET ((*MODE-LINE-LIST* `("[" ,MODE " R]")))
	(COMMAND-LOOP *RECURSIVE-EDIT-COMTAB* WINDOW)))))

;;; Reports an error.  Takes a FORMAT control string and args.  If the string
;;; is not given, no message is reported.
(DEFUN BARF (&OPTIONAL CTL-STRING &REST ARGS)
  (OR (AND (MEMQ ':MACRO-ERROR (FUNCALL STANDARD-INPUT ':WHICH-OPERATIONS))
	   (FUNCALL STANDARD-INPUT ':MACRO-ERROR))
      (BEEP))
  (AND CTL-STRING
       (LEXPR-FUNCALL #'TYPEIN-LINE CTL-STRING ARGS))
May have altered the text before erring
  (*THROW 'ZWEI-COMMAND-LOOP T))	; so run the full redisplay algorithm

;;; The actual command tables used by the implemented ZWEI subsystems.

(DEFUN INITIALIZE-STANDARD-COMTABS ()
  (SETQ *STANDARD-COMTAB*
         (SET-COMTAB NIL
	  '((0 200) COM-STANDARD
	    #\BS COM-STANDARD
	    #/F COM-FORWARD
	    #/B COM-BACKWARD
	    #/N COM-DOWN-REAL-LINE
	    #/P COM-UP-REAL-LINE
	    #/V COM-NEXT-SCREEN
	    #/V COM-PREVIOUS-SCREEN
	    #/V COM-SCROLL-OTHER-WINDOW
	    #/A COM-BEGINNING-OF-LINE
	    #/E COM-END-OF-LINE
	    #/R COM-MOVE-TO-SCREEN-EDGE
	    #/< COM-GOTO-BEGINNING
	    #/> COM-GOTO-END
	    #/< COM-MARK-BEGINNING
	    #/> COM-MARK-END
	    #\SP COM-SET-POP-MARK
	    #/@ COM-SET-POP-MARK
	    #\SP COM-PUSH-POP-POINT-EXPLICIT
	    #\SP COM-MOVE-TO-PREVIOUS-POINT
	    #\CR COM-INSERT-CRS
	    #/O COM-MAKE-ROOM
	    #/O COM-SPLIT-LINE
	    #/O COM-THIS-INDENTATION
	    #/^ COM-DELETE-INDENTATION
	    #/^ COM-DELETE-INDENTATION
	    #/D COM-DELETE-FORWARD
	    #\RUBOUT COM-RUBOUT
	    #\RUBOUT COM-TAB-HACKING-RUBOUT
	    #/K COM-KILL-LINE
	    #\CLEAR COM-CLEAR
	    #\BREAK COM-BREAK
	    #/W COM-SAVE-REGION
	    #/W COM-KILL-REGION
	    #/W COM-APPEND-NEXT-KILL
	    #/Y COM-YANK
	    #/Y COM-YANK-POP
	    #/L COM-RECENTER-WINDOW
;	    #\FF COM-RECENTER-WINDOW
	    #\FF COM-COMPLETE-REDISPLAY
	    #/! COM-COMPLETE-REDISPLAY
	    #/U COM-QUADRUPLE-NUMERIC-ARG
	    #/- COM-NEGATE-NUMERIC-ARG
	    #/- COM-NEGATE-NUMERIC-ARG
	    #/- COM-NEGATE-NUMERIC-ARG
	    (#/0 10.) COM-NUMBERS
	    (#/0 10.) COM-NUMBERS
	    (#/0 10.) COM-NUMBERS
	    #/T COM-EXCHANGE-CHARACTERS
	    #/T COM-EXCHANGE-WORDS
	    #/T COM-EXCHANGE-SEXPS
	    #/F COM-FORWARD-WORD
	    #/B COM-BACKWARD-WORD
	    #/K COM-KILL-SENTENCE
	    #/D COM-KILL-WORD
	    #\RUBOUT COM-BACKWARD-KILL-WORD
	    #/@ COM-MARK-WORD
	    #/F COM-FORWARD-SEXP
	    #/N COM-FORWARD-LIST
	    #/B COM-BACKWARD-SEXP
	    #/P COM-BACKWARD-LIST
	    #/K COM-KILL-SEXP
	    #\RUBOUT COM-BACKWARD-KILL-SEXP
	    #/@ COM-MARK-SEXP
	    #/) COM-FORWARD-UP-LIST
	    #/( COM-BACKWARD-UP-LIST
	    #/U COM-BACKWARD-UP-LIST
	    #/[ COM-BEGINNING-OF-DEFUN
	    #/] COM-END-OF-DEFUN
	    #/A COM-BEGINNING-OF-DEFUN
	    #/E COM-END-OF-DEFUN
	    #/D COM-DOWN-LIST
	    #/( COM-MAKE-/(/)
	    #/) COM-MOVE-OVER-/)
;	    #/G COM-FORMAT-CODE
	    #/] COM-FORWARD-PARAGRAPH
	    #/[ COM-BACKWARD-PARAGRAPH
	    #/H COM-MARK-PARAGRAPH
	    #/E COM-FORWARD-SENTENCE
	    #/A COM-BACKWARD-SENTENCE
	    #/G COM-BEEP
	    #\TAB COM-INSERT-TAB
	    #\TAB COM-INDENT-FOR-LISP
	    #\TAB COM-INDENT-DIFFERENTLY
	    #\LF COM-INDENT-NEW-LINE
	    #/Q COM-INDENT-SEXP
	    #/; COM-INDENT-FOR-COMMENT
	    #/; COM-INDENT-FOR-COMMENT
	    #/; COM-KILL-COMMENT
	    #/N COM-DOWN-COMMENT-LINE
	    #/P COM-UP-COMMENT-LINE
	    #/Q COM-FILL-PARAGRAPH
	    #/G COM-FILL-REGION
	    #/\ COM-DELETE-HORIZONTAL-SPACE
	    #\CR COM-BACK-TO-INDENTATION
	    #/M COM-BACK-TO-INDENTATION
	    #\CR COM-BACK-TO-INDENTATION
	    #/M COM-BACK-TO-INDENTATION
	    #/U COM-UPPERCASE-WORD
	    #/L COM-LOWERCASE-WORD
	    #/C COM-UPPERCASE-INITIAL
	    #/\ COM-INDENT-REGION
	    #\FF COM-INSERT-FF
	    #\TAB COM-INSERT-TAB
	    #/S COM-CENTER-LINE
	    #/= COM-COUNT-LINES-REGION
	    #/= COM-FAST-WHERE-AM-I
	    #/S COM-INCREMENTAL-SEARCH
	    #/R COM-REVERSE-INCREMENTAL-SEARCH
	    #/ COM-EVALUATE-MINI-BUFFER
	    #/ COM-COMPILE-DEFUN
	    #/ COM-EVALUATE-DEFUN
	    #/ COM-EVALUATE-DEFUN-VERBOSE
	    #/ COM-EVALUATE-DEFUN-HACK
	    #/? COM-SELF-DOCUMENT
	    #/? COM-SELF-DOCUMENT
	    #/? COM-DOCUMENTATION
	    #\HELP COM-DOCUMENTATION
	    #/Q COM-VARIOUS-QUANTITIES
	    #/X COM-EXTENDED-COMMAND
	    #/X COM-ANY-EXTENDED-COMMAND
	    #/< COM-MARK-BEGINNING
	    #/> COM-MARK-END
	    #\LF COM-INDENT-NEW-COMMENT-LINE
	    #/% COM-REPLACE-STRING
	    #/% COM-QUERY-REPLACE
	    #/H COM-MARK-DEFUN
	    #/R COM-REPOSITION-WINDOW
	    #/' COM-UPCASE-DIGIT
	    #/ COM-FIND-PATTERN
	    #/Z COM-QUIT
	    #\END COM-QUIT
	    #/~ COM-NOT-MODIFIED
	    #/& COM-FROB-LISP-CONDITIONAL
	    #/$ COM-FROB-DO
	    #/ COM-QUICK-ARGLIST
	    #/ COM-BRIEF-DOCUMENTATION
	    #/ COM-LONG-DOCUMENTATION
	    #/J COM-CHANGE-FONT-CHAR
	    #/J COM-CHANGE-FONT-WORD
	    #/J COM-CHANGE-DEFAULT-FONT
	    #/# COM-TEXT-JUSTIFIER-CHANGE-FONT-WORD
	    #/_ COM-TEXT-JUSTIFIER-UNDERLINE-WORD
	    #/# COM-GOTO-CHARACTER
	    #\MOUSE-1-1 COM-MOUSE-MARK-REGION
	    #\MOUSE-1-2 COM-MOUSE-MOVE-REGION
	    #\MOUSE-2-1 COM-MOUSE-MARK-THING
	    #\MOUSE-2-2 COM-MOUSE-KILL-YANK
	    )
	  (MAKE-COMMAND-ALIST
	   '(;; COM*:
	     COM-INSTALL-COMMAND COM-ARGLIST COM-KEEP-LINES COM-FLUSH-LINES
	     COM-HOW-MANY COM-COUNT-LINES COM-QUERY-REPLACE COM-REPLACE-STRING
	     COM-OCCUR COM-LIST-ALL-DIRECTORY-NAMES COM-VIEW-DIRECTORY
	     COM-COMPILE-REGION COM-COMPILE-BUFFER COM-EVALUATE-REGION COM-EVALUATE-BUFFER
	     COM-VIEW-Q-REGISTER COM-LIST-Q-REGISTERS COM-KILL-Q-REGISTER
	     COM-LIST-VARIABLES COM-VARIABLE-APROPOS COM-VARIABLE-DOCUMENT COM-VARIABLE-SET
	     COM-GRIND-DEFINITION COM-GRIND-S-EXPRESSION COM-EVALUATE-INTO-BUFFER COM-TRACE
	     COM-VIEW-LOGIN-DIRECTORY COM-VIEW-XGP-QUEUE COM-VIEW-TTY-USERS COM-VIEW-MAIL
	     COM-ATOM-QUERY-REPLACE COM-FORMAT-CODE COM-MULTIPLE-QUERY-REPLACE
	     COM-MULTIPLE-QUERY-REPLACE-FROM-BUFFER COM-QUERY-EXCHANGE
	     COM-QUERY-REPLACE-LAST-KILL COM-QUERY-REPLACE-LET-BINDING
	     COM-FIND-UNBALANCED-PARENTHESES COM-MACRO-EXPAND-SEXP
	     COM-UNDO COM-FILL-LONG-COMMENT COM-UNCOMMENT-REGION
	     COM-SORT-LINES COM-SORT-PARAGRAPHS COM-SORT-VIA-KEYBOARD-MACROS
  DOC :
	     COM-LIST-COMMANDS COM-APROPOS COM-WHERE-IS COM-DESCRIBE-COMMAND
	     ;; FILES:
	     COM-INSERT-FILE COM-WRITE-REGION COM-APPEND-TO-FILE COM-PREPEND-TO-FILE
	     COM-VIEW-FILE COM-LIST-FILES COM-RENAME-FILE COM-COPY-FILE COM-DELETE-FILE
	     ;; MODES:
	     COM-LISP-MODE COM-TEXT-MODE COM-FUNDAMENTAL-MODE COM-PL1-MODE COM-BOLIO-MODE
	     COM-ELECTRIC-PL1-MODE COM-ATOM-WORD-MODE COM-EMACS-MODE COM-OVERWRITE-MODE
	     COM-TECO-MODE COM-MACSYMA-MODE COM-AUTO-FILL-MODE COM-WORD-ABBREV-MODE
	     COM-INSERT-WORD-ABBREVS COM-KILL-ALL-WORD-ABBREVS COM-LIST-WORD-ABBREVS
	     COM-DEFINE-WORD-ABBREVS COM-EDIT-WORD-ABBREVS COM-LIST-SOME-WORD-ABBREVS
	     COM-WRITE-WORD-ABBREV-FILE COM-READ-WORD-ABBREV-FILE COM-MAKE-WORD-ABBREV
	     COM-EDIT-TAB-STOPS COM-MIDAS-MODE COM-ELECTRIC-SHIFT-LOCK-MODE
  FONT , KBDMAC , DIRED
	     COM-SET-FONTS COM-INSTALL-MACRO COM-VIEW-KBD-MACRO
	     ))))
  (SETQ *STANDARD-CONTROL-X-COMTAB*
	(SET-COMTAB NIL '(#/G COM-PREFIX-BEEP
			  #/D COM-DISPLAY-DIRECTORY
			  #/N COM-SET-GOAL-COLUMN
			  #/P COM-MARK-PAGE
			  #/X COM-SWAP-POINT-AND-MARK
			  #/G COM-OPEN-GET-Q-REG
			  #/X COM-PUT-Q-REG
			  #/L COM-COUNT-LINES-PAGE
			  #\RUBOUT COM-BACKWARD-KILL-SENTENCE
			  #/; COM-SET-COMMENT-COL
			  #/. COM-SET-FILL-PREFIX
			  #/F COM-SET-FILL-COLUMN
			  #/U COM-UPPERCASE-REGION
			  #/L COM-LOWERCASE-REGION
			  #/O COM-DELETE-BLANK-LINES
			  #/I COM-INDENT-RIGIDLY
			  #/= COM-WHERE-AM-I
			  #/[ COM-PREVIOUS-PAGE
			  #/] COM-NEXT-PAGE
			  #/H COM-MARK-WHOLE
			  #/C COM-QUIT
			  #/J COM-CHANGE-FONT-REGION
			  #/( COM-START-KBD-MACRO
			  #/) COM-END-KBD-MACRO
			  #/E COM-CALL-LAST-KBD-MACRO
			  #/Q COM-KBD-MACRO-QUERY
			  #/ COM-REPEAT-LAST-MINI-BUFFER-COMMAND
			  #/T COM-EXCHANGE-LINES
			  #/T COM-EXCHANGE-REGIONS
			  #/# COM-TEXT-JUSTIFIER-CHANGE-FONT-REGION
			  #/_ COM-TEXT-JUSTIFIER-UNDERLINE-REGION
			  #\SP COM-MOVE-TO-DEFAULT-PREVIOUS-POINT
			  )))
  (SET-COMTAB-CONTROL-INDIRECTION *STANDARD-CONTROL-X-COMTAB*)
  (SET-COMTAB *STANDARD-COMTAB*
              (LIST #/X (MAKE-EXTENDED-COMMAND *STANDARD-CONTROL-X-COMTAB*)))
  (SETQ *COMPLETING-READER-COMTAB*
	(SET-COMTAB NIL '(#/ COM-COMPLETE
			  #\SP COM-SELF-INSERT-AND-COMPLETE
			  #/) COM-SELF-INSERT-AND-COMPLETE
			  #/? COM-LIST-COMPLETIONS
			  #/Q COM-QUOTED-INSERT
			  #\HELP COM-DOCUMENT-COMPLETING-READ
			  #// COM-COMPLETION-APROPOS
			  #\CR COM-COMPLETE-AND-EXIT
			  #/G COM-MINI-BUFFER-BEEP
			  #\CR COM-COMPLETE-AND-EXIT
			  #\END COM-COMPLETE-AND-EXIT
			  #\MOUSE-1-1 COM-MOUSE-END-OF-MINI-BUFFER
                          #\MOUSE-3-1 COM-MOUSE-LIST-COMPLETIONS
                          #/Z :UNDEFINED
			  #/Z :UNDEFINED
			  #/Z :UNDEFINED)))
  (SET-COMTAB-INDIRECTION *COMPLETING-READER-COMTAB* *STANDARD-COMTAB*)
  (SETQ *CONTROL-R-COMTAB*
	(SET-COMTAB NIL '(#/ COM-EXIT-CONTROL-R
			  #\END COM-EXIT-CONTROL-R)))
  (SET-COMTAB-INDIRECTION *CONTROL-R-COMTAB* *STANDARD-COMTAB*)
  (SETQ *RECURSIVE-EDIT-COMTAB*
	(SET-COMTAB NIL '(#/ COM-EXIT-CONTROL-R
			  #\END COM-EXIT-CONTROL-R
			  #/G COM-RECURSIVE-EDIT-BEEP)))
  (SET-COMTAB-INDIRECTION *RECURSIVE-EDIT-COMTAB* *STANDARD-COMTAB*)
  (SETQ *STANDALONE-COMTAB*
	(SET-COMTAB NIL '(#/ COM-QUIT)))
  (SET-COMTAB-INDIRECTION *STANDALONE-COMTAB* *STANDARD-COMTAB*)
  )

;;; This takes a list of commands (symbols), and returns an alist associating
;;; their names with the commands.  The ordering is reversed.
(DEFUN MAKE-COMMAND-ALIST (COMMAND-LIST)
  (DO ((CL COMMAND-LIST (CDR CL))
       (RET NIL (LET ((NAME (GET (CAR CL) 'COMMAND-NAME)))
		  (OR NAME (FERROR NIL "~S is not a defined command." (CAR CL)))
		  (CONS (CONS NAME (CAR CL))
			RET))))
      ((NULL CL) (NREVERSE RET))))

;;; This makes WINDOW edit INTERVAL.
(DEFMETHOD (EDITOR :SET-WINDOW-INTERVAL) (WINDOW INTERVAL)
  (SET-WINDOW-INTERVAL WINDOW INTERVAL))

(DEFUN SET-WINDOW-INTERVAL (WINDOW INTERVAL)
  (SETF (WINDOW-INTERVAL WINDOW) INTERVAL)
  (LET ((FIRST-BP (INTERVAL-FIRST-BP INTERVAL)))
    (SETF (WINDOW-POINT WINDOW) (COPY-BP FIRST-BP ':NORMAL))
    (SETF (WINDOW-MARK WINDOW) (COPY-BP FIRST-BP ':NORMAL))
    (SETF (WINDOW-START-BP WINDOW) (COPY-BP FIRST-BP ':NORMAL))))

;;; This changes the current window, as called by the mouse
(DEFUN MAKE-WINDOW-CURRENT (WINDOW &OPTIONAL (SELECT-P T) &AUX INTERVAL)
  (SETQ *WINDOW-LIST* (CONS WINDOW (DELQ WINDOW *WINDOW-LIST*)))
  (COND ((AND (NEQ WINDOW *WINDOW*) (NEQ *WINDOW* *MINI-BUFFER-WINDOW*)
	      (OR (NEQ WINDOW *MINI-BUFFER-WINDOW*) *MINI-BUFFER-COMMAND-IN-PROGRESS*))
	 (SETQ *WINDOW* WINDOW
	       INTERVAL (WINDOW-INTERVAL WINDOW))
	 (FUNCALL-SELF ':SET-INTERVAL INTERVAL)
	 (SETQ *TYPEOUT-WINDOW* (WINDOW-TYPEOUT-WINDOW WINDOW)
	       TERMINAL-IO *TYPEOUT-WINDOW*)
	 (MULTIPLE-VALUE (*MODE-LINE-WINDOW* *TYPEIN-WINDOW* *MINI-BUFFER-WINDOW*)
	   (WINDOW-MODE-LINE-WINDOWS WINDOW))
	 (AND SELECT-P (SELECT-WINDOW WINDOW)))))

;;; This is here so that ZMACS can redefine it
(DEFMETHOD (EDITOR :SET-INTERVAL) (INTERVAL)
  (OR (EQ (WINDOW-INTERVAL *WINDOW*) INTERVAL)
      (SET-WINDOW-INTERVAL *WINDOW* INTERVAL))
  (SETQ *INTERVAL* INTERVAL))

;;; Syntax table stuff.

(DEFUN CHAR-SYNTAX (CHAR SYNTAX-TABLE)
  (SETQ CHAR (LDB %%CH-CHAR CHAR))
  (COND ((ARRAYP SYNTAX-TABLE)
	 (AREF SYNTAX-TABLE CHAR))
	((CDR (ASSQ CHAR (CDR SYNTAX-TABLE))))
	((CHAR-SYNTAX CHAR (CAR SYNTAX-TABLE)))))

(DEFUN SET-CHAR-SYNTAX (SYNTAX SYNTAX-TABLE CHAR &AUX TEM)
  (COND ((ARRAYP SYNTAX-TABLE)
	 (ASET SYNTAX SYNTAX-TABLE CHAR))
	((SETQ TEM (ASSQ CHAR (CDR SYNTAX-TABLE)))
	 (RPLACD TEM SYNTAX))
	(T
	 (PUSH (CONS CHAR SYNTAX) (CDR SYNTAX-TABLE)))))

(DEFUN MAKE-SPARSE-SYNTAX-TABLE (INDIRECT-TO)
  (NCONS INDIRECT-TO))

(DEFUN MAKE-SYNTAX-TABLE (SPECS)
  (DO ((SPECS SPECS (CDR SPECS))
       (SPEC)
       (I 0)
       (TABLE (MAKE-ARRAY NIL 'ART-4B 400)))
      ((NULL SPECS)
       (IF (NOT (= I 400))
	   (FERROR NIL "Wrong number (~S) of elements in the specs" I))
       TABLE)
    (SETQ SPEC (CAR SPECS))
    (COND ((SYMBOLP SPEC)
	   (ASET (SYMEVAL SPEC) TABLE I)
	   (SETQ I (1+ I)))
	  (T (DO ((J 0 (1+ J))
		  (VALUE (SYMEVAL (SECOND SPEC)))
		  (LIMIT (FIRST SPEC)))
		 (( J LIMIT))
	       (ASET VALUE TABLE I)
	       (SETQ I (1+ I)))))))

(DEFUN INITIALIZE-SYNTAX-TABLES ()
  (SETQ *WORD-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE
			      '((40 WORD-ALPHABETIC)
040 space
041 !
042 " "
043 #
044 $
045 %
046 &
047 '
050 (
051 )
052 *
053 +
054 ,
055 -
056 .
057 /
				(10. WORD-ALPHABETIC)	;DIGITS
072 :
073 ;
074 <
075 =
076 >
077 ?
100 @
				(26. WORD-ALPHABETIC)	;LETTERS
133 [
134 \
135 ]
136 ^
137 _
140 `
				(26. WORD-ALPHABETIC)	;LETTERS
				(205 WORD-DELIMITER)))
	*LIST-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE
			      '((40 LIST-ALPHABETIC)
040 space
041 !
042 "      "
043 #
044 $
045 %
046 &
047 '
050 (
051 )
052 *
053 +
054 ,
055 -
056 .
057 /
				(10. LIST-ALPHABETIC)	;DIGITS
072 :
073 ;
074 <
075 =
076 >
077 ?
100 @
				(26. LIST-ALPHABETIC)	;LETTERS
133 [
134 \
135 ]
136 ^
137 _
140 ` STANDARD MACRO
				(26. LIST-ALPHABETIC)	;MORE LETTERS
173 {
174 |             |
175 }
176 ~
177 integral ? ? ?
				
200 null character
201 break
202 clear
203 call
204 escape ( NOT altmode ! )
205 backnext
206 help
207 rubout
210 bs
211 tab
212 line
213 vt
214 form = newpage
215 return = newline
				(162 LIST-ALPHABETIC)))
	*ATOM-WORD-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE
				   '((40 LIST-ALPHABETIC)
040 space
041 !
042 "      "
043 #
044 $
045 %
046 &
047 '
050 (
051 )
052 *
053 +
054 ,
055 -
056 .
057 /
				     (10. WORD-ALPHABETIC)	;DIGITS
072 :
073 ;
074 <
075 =
076 >
077 ?
100 @
				     (26. WORD-ALPHABETIC)	;LETTERS
133 [
134 \
135 ]
136 ^
137 _
140 `
				     (31. WORD-ALPHABETIC)	;LETTERS
				     (200 WORD-DELIMITER)))))

;;; Initialization stuff

;;; This initializes all ZWEI globals.  This hacks the ones common to all
  ZWEI , but not the ZMACS ones .   It first sets some unusual things , then
  initializes the ZWEI variables ( the ones defined with DEFVAR in the  file ) ,
;;; then sets up the incremental search command (which has some magic globals).
;;; Finally it sets up the comtabs and syntax tables, and the minibuffer window.
(DEFUN INITIALIZE-ZWEI-GLOBALS ()
  (SETQ *UTILITY-PACKAGE* (SI:PKG-CREATE-PACKAGE "ZWEI Utility Package" NIL))
Reset other variables defined by DEFGLOBAL
    (SET (CAR VAR) (CDR VAR)))
  (SETQ-ZWEI-VARIABLES)
  (INITIALIZE-WORD-ABBREV-TABLE)
  (INITIALIZE-INCREMENTAL-SEARCH-GLOBALS)
  (INITIALIZE-STANDARD-COMTABS)
  (INITIALIZE-SYNTAX-TABLES)
  (INITIALIZE-MINI-BUFFER)
  (INITIALIZE-TAB-STOP-BUFFER)
  (INITIALIZE-MOUSE)
  )

(DEFVAR *MINI-BUFFER-MULTI-LINE-COMTAB*)
(DEFVAR *MINI-BUFFER-COMTAB*)
(DEFVAR *MINI-BUFFER-RING*)
(DEFVAR *MINI-BUFFER-REPEATED-COMMAND*)

(DEFUN INITIALIZE-MINI-BUFFER ()
  (SETQ *MINI-BUFFER-RING* NIL *MINI-BUFFER-REPEATED-COMMAND* NIL)
  (SETQ *MINI-BUFFER-MULTI-LINE-COMTAB*
	(SET-COMTAB NIL '(#\HELP COM-DOCUMENT-CONTAINING-COMMAND
			  #\CR COM-END-OF-MINI-BUFFER
			  #\END COM-END-OF-MINI-BUFFER
			  #/G COM-MINI-BUFFER-BEEP
			  #/Z :UNDEFINED
			  #/Z :UNDEFINED
			  #/Z :UNDEFINED
			  #/Y COM-POP-MINI-BUFFER-RING
			  #\MOUSE-1-2 COM-MOUSE-END-OF-MINI-BUFFER
			  )))
  (SET-COMTAB-INDIRECTION *MINI-BUFFER-MULTI-LINE-COMTAB* *STANDARD-COMTAB*)
  (SETQ *MINI-BUFFER-COMTAB* (SET-COMTAB NIL '(#\CR COM-END-OF-MINI-BUFFER)))
  (SET-COMTAB-INDIRECTION *MINI-BUFFER-COMTAB* *MINI-BUFFER-MULTI-LINE-COMTAB*)
  (INITIALIZE-MINI-BUFFER-WINDOW))

 Command dispatch table functions for ZWEI.   -*- Mode:LISP; Package:ZWEI -*-
 The functions in this file implement COMTABs.
 This file also contains the basic editor command loop.
 (a keystroke may also be a mouse push or anything else like that), and contains
 a COMMAND for each one.  A COMMAND may be any of:
   NIL    -- The keystroke is unassigned.  If there is a COMTAB-INDIRECT-TO,
             of a keystroke on the keyboard.
Commands gotten by typing on the keyboard.
Commands gotten by pushing mouse buttons.
 Needed by COM-LIST-COMMANDS, among others.
 This should be given the CHAR as well as the COMMAND, for error message reporting.
 from a prefix command.  The elements of the hook-list are applied
 to the char before the comand is run, AFTER the error checks are made.
 Push a hook onto the COMMAND-HOOK with the right priority, returning the undo form
 Create a comtab for just storing mode changes in
 if it is NIL , a new COMTAB is created .

 The specified character and that many contiguous slots after it are specified.
 or a function to be applied to the char whose slot is under consideration,
 in which case what it returns is stored.
 extended command alist.
 are set to indirect through the corresponding upper-case characters.
 corresponding upper-case characters.
 But only store over undefined commands
Indirect all meta things through the corresponding non-meta thing
Indirect controls other than atsign through underscore to non-controls
 Set the indirection of OF to TO.
 This takes a string specification of a command char (the numeric code for
 a keystroke), and returns the command char.  Specifications may look like:
   "A", "B", "V", "", etc., referring to keyboard characters.
   "MOUSE-n-m", where n and m are numbers relating which button and how many clicks.
 Note: this function is semi-obselete, since the reader allows specification of all
 characters.
 This is the Meta-X command.
 Note that numeric arg is transmitted via dynamic scoping etc.
Put in alist indirections
Impossible is not OK.
Don't do initial completion (it won't work anyway)
Have to wait for it, so prompt
 The command loop.
 to edit by looking in the window.  This binds all of the standard per-invocation
 globals, except PACKAGE, which the caller must bind.
 The *COMMAND-LOOP-CLOSURE-LIST* is used to prevent consing new closures for the
 anything.
 This is the function that does the actual work
Non top-level editors are only called from inside a top-level
editor.  Therefore the instance variable TV:IO-BUFFER will always be accessible.
Catch C-Z in error handlers.
Handle mouse, etc
Keyboard or mouse character
 If there is typeout (window-typeout-stream style) that the user
 hasn't finished reading, wait for a character, and if it's space,
 ignore it and redisplay.
 Ignore requests to select current window
 If it's not a space, unread it.  That will
 prevent redisplay.
 If we Z from BREAK or an error, make the typeout go away.
 This is also executed after every real command, but not after
 mouse signals and keystrokes that just set the arguments for
 following commands.
 Handle a normal command character, either a keyboard or mouse
 Look up the command in the table.
 Execute the command.
 This command is creating the argument to a subsequent command.
 If the mark is not being preserved, make it go away.
 Report the returned value of the command to the window.
 Call the post-command hooks
 This handles special commands from the window system
 returns non-NIL if the typeout window should be flushed like normal commands.
The window is presumably on our list of windows and will get redisplayed
in the normal course of events when buffered input had been processed.
Given in another window,
dont confuse mouse mark thing, and
temporarily act there (mini-buffer)
Not needed
 Recursive edit on the same buffer
 Recursive edit with a temporary window on the given interval
 Reports an error.  Takes a FORMAT control string and args.  If the string
 is not given, no message is reported.
 so run the full redisplay algorithm
 The actual command tables used by the implemented ZWEI subsystems.
	    #\FF COM-RECENTER-WINDOW
	    #/G COM-FORMAT-CODE
 COM-INDENT-FOR-COMMENT
 COM-INDENT-FOR-COMMENT
 COM-KILL-COMMENT
 COM*:
 FILES:
 MODES:
 COM-SET-COMMENT-COL
 This takes a list of commands (symbols), and returns an alist associating
 their names with the commands.  The ordering is reversed.
 This makes WINDOW edit INTERVAL.
 This changes the current window, as called by the mouse
 This is here so that ZMACS can redefine it
 Syntax table stuff.
DIGITS

LETTERS
LETTERS
DIGITS

LETTERS
MORE LETTERS
DIGITS

LETTERS
LETTERS
 Initialization stuff
 This initializes all ZWEI globals.  This hacks the ones common to all
 then sets up the incremental search command (which has some magic globals).
 Finally it sets up the comtabs and syntax tables, and the minibuffer window.
  * * ( c ) Copyright 1980 Massachusetts Institute of Technology * *

  A COMTAB is a command table .   It conceptually is indexed by possible user " keystrokes "
              look in that COMTAB .
    : UNDEFINED -- The keystroke is REALLY unassigned , regardless of indirecting .
    A list -- The command is a synonym , pointing at some other slot in the COMTAB .
              the list should have two elements , the control - meta and the char parts
    Some other symbol -- A command as defined by DEFCOM ,  .
(DEFSTRUCT (COMTAB)
Alist of long - named commands .
A COMTAB to try when you find NIL in this COMTAB .

(DEFUN EXTENDED-COMMAND-ALIST (COMTAB) (COMTAB-EXTENDED-COMMANDS COMTAB))

  Given a COMTAB and a character like those from the command stream ,
  return the corresponding command .   If the third arg is non - NIL ,
  do not chase down when you find a list in the COMTAB .
(DEFUN COMMAND-LOOKUP (CHAR COMTAB &OPTIONAL NO-INDIRECTION-P)
  (DO ((CTB COMTAB) (CH CHAR)
       (KEYBOARD-ARRAY) (COMMAND))
      (NIL)
    (SETQ KEYBOARD-ARRAY (COMTAB-KEYBOARD-ARRAY CTB)
	  COMMAND (COND ((NOT (ARRAYP KEYBOARD-ARRAY))
			 (CDR (ASSQ CH KEYBOARD-ARRAY)))
			((LDB-TEST %%KBD-MOUSE CH)
			 (AREF (COMTAB-MOUSE-ARRAY CTB)
			       (MIN (LDB %%KBD-MOUSE-N-CLICKS CH) 1)
			       (LDB %%KBD-MOUSE-BUTTON CH)))
			(T
			 (AREF KEYBOARD-ARRAY
			       (LDB %%KBD-CHAR CH)
			       (LDB %%KBD-CONTROL-META CH)))))
    (IF (OR (NOT (LISTP COMMAND)) NO-INDIRECTION-P)
	(AND (OR COMMAND (NULL (SETQ CTB (COMTAB-INDIRECT-TO CTB))))
	     (RETURN COMMAND))
	(SETQ CTB COMTAB
	      CH (DPB (FIRST COMMAND) %%KBD-CONTROL-META (SECOND COMMAND))))))

  Store COMMAND in the slot of COMTAB denoted by  .
(DEFUN COMMAND-STORE (COMMAND CHAR COMTAB &AUX KEYBOARD-ARRAY)
  (SETQ KEYBOARD-ARRAY (COMTAB-KEYBOARD-ARRAY COMTAB))
  (COND ((NOT (ARRAYP KEYBOARD-ARRAY))
	 (LET ((ELEMENT (ASSQ CHAR KEYBOARD-ARRAY)))
	   (IF ELEMENT (RPLACD ELEMENT COMMAND)
	       (PUSH (CONS CHAR COMMAND) (COMTAB-KEYBOARD-ARRAY COMTAB)))))
	((LDB-TEST %%KBD-MOUSE CHAR)
	 (ASET COMMAND
	       (COMTAB-MOUSE-ARRAY COMTAB)
	       (MIN (LDB %%KBD-MOUSE-N-CLICKS CHAR) 1)
	       (LDB %%KBD-MOUSE-BUTTON CHAR)))
	(T
	 (ASET COMMAND
	       KEYBOARD-ARRAY
	       (LDB %%KBD-CHAR CHAR)
	       (LDB %%KBD-CONTROL-META CHAR)))))

  Execute the result of calling COMMAND - LOOKUP ( without the third argument ) .
  The third arg is also for error reporting , and is used if this COMTAB was gotten
(DEFUN COMMAND-EXECUTE (COMMAND CHAR &OPTIONAL PREFIX-CHAR HOOK-LIST)
  (COND ((MEMQ COMMAND '(NIL :UNDEFINED))
	 (BARF "~:[~:@C ~;~*~]~:@C is not a defined key.~:[  (Do Dah, Do Dah)~]"
	       (NOT PREFIX-CHAR) PREFIX-CHAR CHAR (NOT (= CHAR #/))))
	((AND (SYMBOLP COMMAND)
	      (NOT (FBOUNDP COMMAND)))
	 (BARF "~S is not implemented." COMMAND)))
  (DOLIST (HOOK HOOK-LIST)
    (FUNCALL HOOK CHAR))
  (FUNCALL COMMAND))

(DEFUN COMMAND-HOOK (HOOK HOOK-SYMBOL)
  (LET ((PRI (GET HOOK 'COMMAND-HOOK-PRIORITY)))
    (OR PRI (FERROR NIL "~S is not a valid command hook." HOOK))
    (DO ((L (SYMEVAL HOOK-SYMBOL) (CDR L))
	 (PREV NIL L))
	((OR (NULL L)
	     (> (GET (CAR L) 'COMMAND-HOOK-PRIORITY) PRI))
	 (LET ((X (CONS HOOK L)))
	   (COND (PREV (RPLACD PREV X))
		 (T (SET HOOK-SYMBOL X)))))))
  `(SETQ ,HOOK-SYMBOL (DELQ ',HOOK ,HOOK-SYMBOL)))

  Create a new , empty COMTAB .
(DEFUN CREATE-COMTAB ()
  (MAKE-COMTAB COMTAB-KEYBOARD-ARRAY (MAKE-ARRAY NIL 'ART-Q '(240 16.))
	       COMTAB-MOUSE-ARRAY (MAKE-ARRAY NIL 'ART-Q '(2 3))))

(DEFUN CREATE-SPARSE-COMTAB ()
  (MAKE-COMTAB COMTAB-KEYBOARD-ARRAY NIL))

  Copy a COMTAB .   Copies the arrays , and the list structure of the extended command alist .
  NOTE : this function does n't make the comtab occupy fewer pages , since the array part
  and the alist part ca n't be on the same page anyway , and the alist part is all on one
  page since it was consed up all at once .   Furthermore the new copy is not EQ to the
  old copy , which screws up comtab indirection .
(DEFUN COPY-COMTAB (OLD-COMTAB)
  (LET ((NEW-COMTAB (CREATE-COMTAB)))
    (LET ((OKBD (COMTAB-KEYBOARD-ARRAY OLD-COMTAB))
	  (OMSE (COMTAB-MOUSE-ARRAY OLD-COMTAB))
	  (NKBD (COMTAB-KEYBOARD-ARRAY NEW-COMTAB))
	  (NMSE (COMTAB-MOUSE-ARRAY NEW-COMTAB)))
       (DOTIMES (I (ARRAY-DIMENSION-N 1 OKBD))
	 (DOTIMES (J (ARRAY-DIMENSION-N 2 OKBD))
	   (ASET (AREF OKBD I J) NKBD I J)))
       (DOTIMES (I (ARRAY-DIMENSION-N 1 OMSE))
	 (DOTIMES (J (ARRAY-DIMENSION-N 2 OMSE))
	   (ASET (AREF OMSE I J) NMSE I J))))
    (SETF (COMTAB-INDIRECT-TO NEW-COMTAB) (COMTAB-INDIRECT-TO OLD-COMTAB))
    (SETF (COMTAB-EXTENDED-COMMANDS NEW-COMTAB)
	  (SUBST NIL NIL (COMTAB-EXTENDED-COMMANDS OLD-COMTAB)))
    NEW-COMTAB))

  The second argument is a list of specifications .   The elements are considered in
  pairs .   The first of a pair is a char name ( see COMMAND - CHAR - FROM - NAME below ) .
  The second is indicates the command to store in the slot denoted by that char ,
  and the second is the command to store .
  it should be a two - list of a command name and an iteration count .
  The second is then either a symbol to be stored in all of the slots ,
  The third argument is a list of new entries to be appended to the comtab 's
  If a new COMTAB is created , all entries for lower - case keyboard characters
(DEFUN SET-COMTAB (COMTAB SPECS &OPTIONAL EXTENDED-COMMANDS)
  (COND ((NULL COMTAB)
	 (SETQ COMTAB (CREATE-COMTAB))
	 (SET-COMTAB-UPPERCASE-INDIRECTION COMTAB)))
  (DO L SPECS (CDDR L) (NULL L)
    (COND ((LISTP (CAR L))
	   (DO ((CHAR (COMMAND-CHAR-FROM-NAME (CAAR L)) (1+ CHAR))
		(I 0 (1+ I))
		(TO (CADAR L))
		(COMMAND (CADR L)))
	       (( I TO))
	     (COMMAND-STORE (IF (SYMBOLP COMMAND)
				COMMAND
				(FUNCALL COMMAND CHAR))
			    CHAR
			    COMTAB)))
	(T (COMMAND-STORE (CADR L) (COMMAND-CHAR-FROM-NAME (CAR L)) COMTAB))))
  (SETF (COMTAB-EXTENDED-COMMANDS COMTAB)
	(APPEND EXTENDED-COMMANDS (COMTAB-EXTENDED-COMMANDS COMTAB)))
  COMTAB)

  Make lower - case characters in this COMTAB all indirect to the
(DEFUN SET-COMTAB-UPPERCASE-INDIRECTION (COMTAB)
  (LET ((ARRAY (COMTAB-KEYBOARD-ARRAY COMTAB)))
    (DOTIMES (I (ARRAY-DIMENSION-N 2 ARRAY))
       (DO CHAR #/a (1+ CHAR) (> CHAR #/z)
	 (ASET (LIST I (- CHAR 40)) ARRAY CHAR I)))))

  Simulate the effect of the Teco 7 - bit character set
(DEFUN SET-COMTAB-CONTROL-INDIRECTION (COMTAB)
  (LET ((ARRAY (COMTAB-KEYBOARD-ARRAY COMTAB)))
Indirect things like  to things like control - I
    (DOLIST (CHAR '(#\CR #\LF #\TAB #\BS #\FF #\VT))
      (AND (NULL (AREF ARRAY CHAR 0))
	   (ASET (LIST 1 (- CHAR 100)) ARRAY CHAR 0)))
    (DO I 2 (1+ I) (= I 4)
      (DOTIMES (CHAR (ARRAY-DIMENSION-N 1 ARRAY))
	(AND (NULL (AREF ARRAY CHAR I))
	     (ASET (LIST (- I 2) CHAR) ARRAY CHAR I))))
    (DOTIMES (CHAR (ARRAY-DIMENSION-N 1 ARRAY))
      (AND (NOT (AND ( CHAR #/@) ( CHAR #/_)))
	   (NULL (AREF ARRAY CHAR 1))
	   (ASET (LIST 0 CHAR) ARRAY CHAR 1)))))

  Take a SET - COMTAB form , and make a second form that will undo what the first does .
(DEFUN MAKE-SET-COMTAB-UNDO-LIST (FORM)
  (LET ((COMTAB (EVAL (SECOND FORM)))
	(UN-SPECS))
    (COND ((NULL COMTAB)
	   (FERROR NIL "A (SET-COMTAB NIL ...) form cannot be undone.")))
    (DO S (EVAL (THIRD FORM)) (CDDR S) (NULL S)
      (LET ((CHAR-NAME (FIRST S)))
	(COND ((LISTP CHAR-NAME)
	       (FERROR NIL "A SET-COMTAB with a List character name cannot be undone.")))
	(PUSH (COMMAND-LOOKUP (COMMAND-CHAR-FROM-NAME CHAR-NAME) COMTAB) UN-SPECS)
	(PUSH CHAR-NAME UN-SPECS)))
    `(PROGN (REMOVE-EXTENDED-COMMANDS ',(EVAL (FOURTH FORM)) ',COMTAB)
	    (SET-COMTAB ',COMTAB ',UN-SPECS))))

(DEFUN SET-COMTAB-RETURN-UNDO (&REST &QUOTE FORM &AUX UNDO)
  (SETQ FORM (CONS 'SET-COMTAB FORM)
	UNDO (MAKE-SET-COMTAB-UNDO-LIST FORM))
  (EVAL FORM)
  UNDO)

(DEFUN REMOVE-EXTENDED-COMMANDS (COMMAND-LIST COMTAB)
  (LET ((EC (COMTAB-EXTENDED-COMMANDS COMTAB)))
    (DOLIST (COMMAND COMMAND-LIST)
	(SETQ EC (DELQ (ASSQ COMMAND EC) EC)))
    (SETF (COMTAB-EXTENDED-COMMANDS COMTAB) EC)))

(DEFUN SET-COMTAB-INDIRECTION (OF TO)
  (SETF (COMTAB-INDIRECT-TO OF) TO))

(DEFUN COMMAND-CHAR-FROM-NAME (NAME)
  (IF (NUMBERP NAME) NAME
      (LET ((I (STRING-MATCH "MOUSE" NAME)))
	(COND ((NULL I)
  The name does not start with MOUSE .
	       (LET ((CHAR1 (AREF NAME 0)))
		 (LET ((X (ASSQ CHAR1 '((#/ . 0) (#/ . 1) (#/ . 2) (#/ . 3)))))
		   (COND ((NULL X) CHAR1)
			 (T (DPB (CDR X) %%KBD-CONTROL-META (AREF NAME 1)))))))
	      (T
	       (MULTIPLE-VALUE-BIND (BUTTON J)
		 (PARSE-NUMBER NAME (1+ I))
		 (LET ((N-CLICKS (PARSE-NUMBER NAME (1+ J))))
		   (COND ((OR (GREATERP 1 BUTTON 3)
			      (GREATERP 1 N-CLICKS 2))
			  (FERROR NIL "Invalid mouse specification ~A" NAME))
			 (T (DPB 1 %%KBD-MOUSE
				 (DPB (1- BUTTON) %%KBD-MOUSE-BUTTON
				      (DPB (1- N-CLICKS) %%KBD-MOUSE-N-CLICKS 0))))))))))))

(DEFUN KEY-EXECUTE (KEY &OPTIONAL (*NUMERIC-ARG-P* NIL) (*NUMERIC-ARG* 1))
  (COMMAND-EXECUTE (COMMAND-LOOKUP KEY *COMTAB*) KEY))

(DEFCOM COM-EXTENDED-COMMAND "" ()
  (LET ((ANS (GET-EXTENDED-COMMAND (FORMAT NIL "Extended command:~:[  (Arg = ~A.)~]"
					    (NOT *NUMERIC-ARG-P*)
					    (FORMAT-ARGUMENT *NUMERIC-ARG-P* *NUMERIC-ARG*))
				   *COMTAB*)))
    (COND ((EQUAL ANS "")
	   (BEEP)
	   DIS-NONE)
	  (T
	   (LET ((*CURRENT-COMMAND* (CDR ANS)))
	     (FUNCALL *CURRENT-COMMAND*))))))

(DEFUN FORMAT-ARGUMENT (ARG-P ARG)
  (SELECTQ ARG-P
    (NIL "")
    (:SIGN (IF (MINUSP ARG) "-" "+"))
    (:DIGITS (FORMAT NIL "~D" ARG))
    (:CONTROL-U
      (DO ((STR "Control-U" (STRING-APPEND "Control-U" #\SP STR))
	   (A (ABS ARG) (// A 4)))
	  ((= A 4) (IF (MINUSP ARG) (STRING-APPEND "-" #\SP STR) STR))))))

(DEFPROP COM-EXTENDED-COMMAND DOCUMENT-EXTENDED-COMMAND DOCUMENTATION-FUNCTION)
(DEFUN DOCUMENT-EXTENDED-COMMAND (COMMAND CHAR OP)
  (COND ((EQ OP ':NAME) "a prefix for extended commands")
	((MEMQ OP '(:FULL :SHORT))
	 (FORMAT T "Completing reads and executes a command from the mini buffer")
	 (COND ((EQ OP ':FULL)
		(SETQ COMMAND (GET-EXTENDED-COMMAND "Type a command to document:" *COMTAB*))
		(OR (EQUAL COMMAND "")
		    (PRINT-DOC OP (CDR COMMAND) CHAR)))))))

(DEFUN GET-EXTENDED-COMMAND (PROMPT COMTAB)
  (DO ((CI (COMTAB-INDIRECT-TO COMTAB) (COMTAB-INDIRECT-TO CI))
       (C *COMTAB* CI)
       (EC))
      ((NULL CI))
    (COND ((LISTP (SETQ EC (COMTAB-EXTENDED-COMMANDS C)))
		   (LOCF (COMTAB-EXTENDED-COMMANDS CI))))
	  ((OR (NULL EC) (LOCATIVEP EC))
	   (SETF (COMTAB-EXTENDED-COMMANDS C)
		 (LOCF (COMTAB-EXTENDED-COMMANDS CI))))))
  (COMPLETING-READ-FROM-MINI-BUFFER PROMPT
				    (COMTAB-EXTENDED-COMMANDS *COMTAB*)
				    "You are typing an extended command."
				    #'(LAMBDA (X)
					      (LET ((STANDARD-OUTPUT *TYPEOUT-WINDOW*))
						(PRINT-DOC ':FULL (CDR X))))))

(DEFCOM COM-ANY-EXTENDED-COMMAND "Execute any loaded zwei command, even if not assigned" ()
  (LET ((ANS (COMPLETING-READ-FROM-MINI-BUFFER
	       (FORMAT NIL "Command:~:[  (Arg = ~A)~]"
		       (NOT *NUMERIC-ARG-P*) (FORMAT-ARGUMENT *NUMERIC-ARG-P* *NUMERIC-ARG*))
	       *COMMAND-ALIST* NIL NIL
	       "You are typing the name of a ZWEI command."
	       #'(LAMBDA (X)
		   (LET ((STANDARD-OUTPUT *TYPEOUT-WINDOW*))
		     (PRINT-DOC ':FULL (CDR X)))))))
    (COND ((EQUAL ANS "")
	   (BEEP)
	   DIS-NONE)
	  (T
	   (LET ((*CURRENT-COMMAND* (CDR ANS)))
	     (FUNCALL *CURRENT-COMMAND*))))))

(LOCAL-DECLARE ((SPECIAL COMTAB))
(DEFUN MAKE-EXTENDED-COMMAND (THE-COMTAB)
  (LET-CLOSED ((COMTAB THE-COMTAB))
    'MAKE-EXTENDED-COMMAND-INTERNAL))

(DEFUN MAKE-EXTENDED-COMMAND-INTERNAL (&AUX (PREFIX-CHAR *LAST-COMMAND-CHAR*))
  (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
    (LET ((CHAR (FUNCALL STANDARD-INPUT ':MOUSE-OR-KBD-TYI-NO-HANG)))
	     (PROMPT-LINE "~:[~*~;~A ~]~:@C: "
			  *NUMERIC-ARG-P* (FORMAT-ARGUMENT *NUMERIC-ARG-P* *NUMERIC-ARG*)
			  PREFIX-CHAR)
	     (SETQ CHAR (PROMPT-LINE-ACTIVATE
			  (FUNCALL STANDARD-INPUT ':MOUSE-OR-KBD-TYI)))
	     (PROMPT-LINE-MORE "~:@C" CHAR)
	     (FUNCALL *MODE-LINE-WINDOW* ':DONE-WITH-MODE-LINE-WINDOW)))
      (AND (LDB-TEST %%KBD-MOUSE CHAR) (BARF))
      (SETQ *LAST-COMMAND-CHAR* CHAR)))
  (SETQ *CURRENT-COMMAND* (COMMAND-LOOKUP *LAST-COMMAND-CHAR* COMTAB))
  (COMMAND-EXECUTE *CURRENT-COMMAND* *LAST-COMMAND-CHAR* PREFIX-CHAR))
)

(DEFUN GET-PREFIX-COMMAND-COMTAB (X)
  (SYMEVAL-IN-CLOSURE X 'COMTAB))

(DEFUN PREFIX-COMMAND-P (X &AUX TEM)
  (AND (CLOSUREP X)
       (SETQ TEM (CADR (%MAKE-POINTER DTP-LIST X)))
       (EQ (%FIND-STRUCTURE-HEADER TEM) 'COMTAB)))

(DEFUN MACRO-COMMAND-P (X &AUX TEM)
  (AND (CLOSUREP X)
       (SETQ TEM (CADR (%MAKE-POINTER DTP-LIST X)))
       (EQ (%FIND-STRUCTURE-HEADER TEM) 'SYMBOL)))

(DEFUN MAKE-MACRO-COMMAND (THE-SYMBOL)
  (LET-CLOSED ((SYMBOL THE-SYMBOL))
    #'(LAMBDA ()
	(LET ((MAC (GET SYMBOL 'MACRO-STREAM-MACRO)))
	  (OR MAC (BARF "The macro ~A is not defined." SYMBOL))
	  (OR (MEMQ ':MACRO-EXECUTE (FUNCALL STANDARD-INPUT ':WHICH-OPERATIONS))
	      (BARF "The input stream does not support macros."))
	  (FUNCALL STANDARD-INPUT ':MACRO-EXECUTE MAC
		   (AND *NUMERIC-ARG-P* *NUMERIC-ARG*))
	  DIS-NONE))))

(DEFUN KEY-FOR-COMMAND (COMMAND &OPTIONAL (COMTAB *COMTAB*))
  (DO-NAMED FOUND
      ((I 0 (1+ I)))
      (( I 4))
    (DOTIMES (J 220)
      (LET ((CH (DPB I %%KBD-CONTROL-META J))
	    TEM)
	(AND (EQ COMMAND (SETQ TEM (COMMAND-LOOKUP CH COMTAB)))
	     (RETURN-FROM FOUND (FORMAT NIL "~:C" CH)))
	(AND (PREFIX-COMMAND-P TEM)
	     (SETQ TEM (KEY-FOR-COMMAND COMMAND (GET-PREFIX-COMMAND-COMTAB TEM)))
	     (RETURN-FROM FOUND (FORMAT NIL "~:C ~A" CH TEM)))))))


  This is the fundamental ZWEI command loop .   It takes a COMTAB and a window ,
  and lets the user edit the window using the COMTAB .   It finds the interval
  same set of COMTAB WINDOW NOT - TOP - LEVEL parameters , hopefully this wo nt screw
(DEFVAR *COMMAND-LOOP-INSTANCE-LIST* NIL)
(DEFUN COMMAND-LOOP (COMTAB WINDOW &OPTIONAL (TYPE 'EDITOR) &AUX INSTANCE)
  (DOLIST (CLL *COMMAND-LOOP-INSTANCE-LIST*)
    (COND ((AND (EQ COMTAB (FIRST CLL))
		(EQ WINDOW (SECOND CLL))
		(EQ TYPE (THIRD CLL)))
	   (SETQ INSTANCE (FOURTH CLL))
	   (RETURN NIL))))
  (COND ((NULL INSTANCE)
	 (SETQ INSTANCE (MAKE-COMMAND-LOOP COMTAB WINDOW TYPE))
	 (PUSH (LIST COMTAB WINDOW TYPE INSTANCE) *COMMAND-LOOP-INSTANCE-LIST*)))
  (FUNCALL INSTANCE ':EDIT))

(DEFUN MAKE-COMMAND-LOOP (COMTAB WINDOW &OPTIONAL (TYPE 'EDITOR) &REST OPTIONS &AUX PLIST)
  (SETQ OPTIONS (COPYLIST OPTIONS)
	PLIST (LOCF OPTIONS))
  (PUTPROP PLIST COMTAB ':*COMTAB*)
  (PUTPROP PLIST WINDOW ':*WINDOW*)
  (INSTANTIATE-FLAVOR TYPE PLIST T))

(DEFMETHOD (EDITOR :AFTER :INIT) (IGNORE)
  (SETQ *INTERVAL* (WINDOW-INTERVAL *WINDOW*)))

(DEFMETHOD (TOP-LEVEL-EDITOR :AFTER :INIT) (IGNORE)
  (SETQ *MODE-COMTAB* (CREATE-SPARSE-COMTAB))
  (SET-COMTAB-INDIRECTION *MODE-COMTAB* *COMTAB*)
  (SETQ *COMTAB* *MODE-COMTAB*)
  (SETQ *MODE-WORD-SYNTAX-TABLE* (MAKE-SPARSE-SYNTAX-TABLE *WORD-SYNTAX-TABLE*))
  (TURN-ON-MODE *MAJOR-MODE*)
  (SETQ TV:IO-BUFFER (WINDOW-IO-BUFFER *WINDOW*))
  (SETQ *TYPEOUT-WINDOW* (WINDOW-TYPEOUT-WINDOW *WINDOW*))
  (MULTIPLE-VALUE (*MODE-LINE-WINDOW* *TYPEIN-WINDOW* *MINI-BUFFER-WINDOW*)
    (WINDOW-MODE-LINE-WINDOWS *WINDOW*)))

(LOCAL-DECLARE ((SPECIAL TV:IO-BUFFER))
(DEFMETHOD (EDITOR :EDIT) (&OPTIONAL (TOP-LEVEL-P (FUNCALL-SELF ':TOP-LEVEL-P)))
  (TV:PROCESS-TYPEAHEAD TV:IO-BUFFER
			#'(LAMBDA (CH)
			    (COND ((NLISTP CH) CH)
				  ((EQ (CAR CH) 'SELECT-WINDOW)
				   (APPLY #'PROCESS-SPECIAL-COMMAND CH)
				   NIL)
				  ((EQ (CAR CH) 'REDISPLAY)
				   NIL)
				  (T CH))))
  (UNWIND-PROTECT
Do n't expose yet , but on first redisplay
		    ':START-DELAYED-SELECT)
	   (*CATCH 'RETURN-FROM-COMMAND-LOOP
	     (*CATCH (IF TOP-LEVEL-P 'EXIT-TOP-LEVEL 'EXIT-CONTROL-R)
Make things like BREAK , TRACE , errors use typeout window
		   ((TERMINAL-IO *TYPEOUT-WINDOW*)
		    (STANDARD-OUTPUT 'SI:TERMINAL-IO-SYN-STREAM))
		   (NIL)
		   (*CATCH 'ZWEI-COMMAND-LOOP
		     (*CATCH (IF TOP-LEVEL-P 'TOP-LEVEL 'DUMMY-TAG)
		       (PROG (CH)
			 (SETQ *LAST-COMMAND-TYPE* *CURRENT-COMMAND-TYPE*
			       *CURRENT-COMMAND-TYPE* NIL
			       *NUMERIC-ARG* 1
			       *NUMERIC-ARG-P* NIL
			       *NUMERIC-ARG-N-DIGITS* 0
			       *MARK-STAYS* NIL
			       *MINI-BUFFER-COMMAND* NIL)
			 (REDISPLAY-ALL-WINDOWS)
			 (SETQ *CENTERING-FRACTION* *CENTER-FRACTION*)
			UNREAL-COMMAND
			 (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
			   (SETQ CH (FUNCALL STANDARD-INPUT ':ANY-TYI)))
If EOF , return
				(RETURN NIL))
				(SETQ *LAST-COMMAND-CHAR* CH)
				(COND ((NOT (APPLY #'PROCESS-SPECIAL-COMMAND CH))
				       (REDISPLAY-ALL-WINDOWS NIL NIL)
				       (GO UNREAL-COMMAND))))
				(COND ((EQ ':ARGUMENT (PROCESS-COMMAND-CHAR CH))
				       (SETQ *NUMERIC-ARG-N-DIGITS*
					     (1+ *NUMERIC-ARG-N-DIGITS*))
				       (REDISPLAY-ALL-WINDOWS NIL NIL)
				       (GO UNREAL-COMMAND)))))
			 (COND ((TV:BASIC-TYPEOUT-WINDOW-INCOMPLETE-P *TYPEOUT-WINDOW*)
				(FUNCALL *TYPEOUT-WINDOW* ':MAKE-COMPLETE)
				(WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
				  (DO ((CHAR (FUNCALL STANDARD-INPUT ':ANY-TYI)
					     (FUNCALL STANDARD-INPUT ':ANY-TYI)))
				      ((NOT (AND (LISTP CHAR)
						 (EQ (FIRST CHAR) 'SELECT-WINDOW)
						 (EQ (SECOND CHAR) *WINDOW*)))
				       (OR (EQ CHAR #\SP)
					   (FUNCALL STANDARD-INPUT ':UNTYI CHAR)))))))))))
		 (FUNCALL *TYPEOUT-WINDOW* ':MAKE-COMPLETE)))))
    (FUNCALL (WINDOW-SHEET *WINDOW*) ':FLUSH-DELAYED-SELECT))))

(DEFMETHOD (EDITOR :TOP-LEVEL-P) () NIL)
(DEFMETHOD (TOP-LEVEL-EDITOR :TOP-LEVEL-P) () T)
(DEFMETHOD (EDITOR :EXPOSE-MODE-LINE-WINDOW) (&OPTIONAL IGNORE))

(DEFUN PROCESS-COMMAND-CHAR (CH &AUX VALUE LINE INDEX)
  (SETQ *LAST-COMMAND-CHAR* CH)
  (LET ((*CURRENT-COMMAND* (COMMAND-LOOKUP *LAST-COMMAND-CHAR* *COMTAB*)))
    (MULTIPLE-VALUE (VALUE LINE INDEX)
      (COMMAND-EXECUTE *CURRENT-COMMAND* *LAST-COMMAND-CHAR* NIL *COMMAND-HOOK*))
    (COND ((EQ VALUE ':ARGUMENT)
	   VALUE)
	  (T
	   (COND ((AND (NOT *MARK-STAYS*) (WINDOW-MARK-P *WINDOW*))
		  (SETF (WINDOW-MARK-P *WINDOW*) NIL)
		  (MUST-REDISPLAY *WINDOW* DIS-MARK-GOES)))
	   (MUST-REDISPLAY *WINDOW* VALUE LINE INDEX)
	   (DOLIST (HOOK *POST-COMMAND-HOOK*) (FUNCALL HOOK *LAST-COMMAND-CHAR*))))))

(DEFSELECT (PROCESS-SPECIAL-COMMAND UNKNOWN-SPECIAL-COMMAND)
  (REDISPLAY ()
    NIL)
  (SELECT-WINDOW (WINDOW)
    (MAKE-WINDOW-CURRENT WINDOW)
    T)
  (CONFIGURATION-CHANGED ()
   (AND (NOT (WINDOW-EXPOSED-P *WINDOW*))
	(DOLIST (W *WINDOW-LIST*)
	  (AND (WINDOW-EXPOSED-P W)
	       (MAKE-WINDOW-CURRENT W NIL))))
   NIL)
  (SCROLL (WINDOW NLINES TYPE)
    (OR (EQ TYPE ':RELATIVE)
	(SETQ TYPE ':START
	      NLINES (FORWARD-LINE (INTERVAL-FIRST-BP (WINDOW-INTERVAL WINDOW)) NLINES T)))
    (REDISPLAY WINDOW TYPE NLINES)
    T)
  (:MOUSE (WINDOW CH *MOUSE-X* *MOUSE-Y*)
    (AND (MEMQ ':RECORD (FUNCALL STANDARD-INPUT ':WHICH-OPERATIONS))
	 (FUNCALL STANDARD-INPUT ':RECORD CH))
	(LET ((*COMTAB* *STANDARD-COMTAB*)
	      *CURRENT-COMMAND-TYPE*
	  (PROCESS-COMMAND-CHAR CH))
	(PROCESS-COMMAND-CHAR CH))
    T)
  ((:TYPEOUT-EXECUTE :EXECUTE) (FUNCTION &REST ARGS)
   (NOT (APPLY FUNCTION ARGS))))

(DEFUN UNKNOWN-SPECIAL-COMMAND (TYPE &REST REST)
  (CERROR T NIL 'UNKNOWN-SPECIAL-COMMAND "~S is not a valid special editor command" TYPE))

(DEFUN TYI-WITH-SCROLLING (&OPTIONAL MOUSE-OR-KBD-TYI-P)
  (DO ((CH)) (NIL)
    (COND ((NUMBERP (SETQ CH (FUNCALL STANDARD-INPUT ':ANY-TYI)))
	   (RETURN CH CH))
	  ((NLISTP CH))
	  ((EQ (CAR CH) 'SCROLL)
	   (APPLY #'PROCESS-SPECIAL-COMMAND CH))
	  ((AND MOUSE-OR-KBD-TYI-P (EQ (CAR CH) ':MOUSE))
	   (RETURN (THIRD CH) CH)))))

(DEFUN CONTROL-R (&AUX (COMTAB *COMTAB*))
  (COND ((NEQ COMTAB *CONTROL-R-COMTAB*)
	 (SET-COMTAB-INDIRECTION *CONTROL-R-COMTAB* COMTAB)
	 (SETQ COMTAB *CONTROL-R-COMTAB*)))
  (LET ((*COMTAB* COMTAB)
	(*MODE-LINE-LIST* `("[" ,@*MODE-LINE-LIST* " R]")))
    (FUNCALL-SELF ':EDIT NIL)))

(DEFUN RECURSIVE-EDIT (INTERVAL MODE &OPTIONAL POINT
				     &AUX (WINDOW (CREATE-OVERLYING-WINDOW *WINDOW*))
				     (SHEET (WINDOW-SHEET WINDOW)))
  (SET-WINDOW-INTERVAL WINDOW INTERVAL)
  (AND POINT (MOVE-BP (WINDOW-POINT WINDOW) POINT))
  (LET ((*EDITOR-ALREADY-KNOWS* T))
    (TV:WINDOW-CALL (SHEET :DEACTIVATE)
      (LET ((*MODE-LINE-LIST* `("[" ,MODE " R]")))
	(COMMAND-LOOP *RECURSIVE-EDIT-COMTAB* WINDOW)))))

(DEFUN BARF (&OPTIONAL CTL-STRING &REST ARGS)
  (OR (AND (MEMQ ':MACRO-ERROR (FUNCALL STANDARD-INPUT ':WHICH-OPERATIONS))
	   (FUNCALL STANDARD-INPUT ':MACRO-ERROR))
      (BEEP))
  (AND CTL-STRING
       (LEXPR-FUNCALL #'TYPEIN-LINE CTL-STRING ARGS))
May have altered the text before erring


(DEFUN INITIALIZE-STANDARD-COMTABS ()
  (SETQ *STANDARD-COMTAB*
         (SET-COMTAB NIL
	  '((0 200) COM-STANDARD
	    #\BS COM-STANDARD
	    #/F COM-FORWARD
	    #/B COM-BACKWARD
	    #/N COM-DOWN-REAL-LINE
	    #/P COM-UP-REAL-LINE
	    #/V COM-NEXT-SCREEN
	    #/V COM-PREVIOUS-SCREEN
	    #/V COM-SCROLL-OTHER-WINDOW
	    #/A COM-BEGINNING-OF-LINE
	    #/E COM-END-OF-LINE
	    #/R COM-MOVE-TO-SCREEN-EDGE
	    #/< COM-GOTO-BEGINNING
	    #/> COM-GOTO-END
	    #/< COM-MARK-BEGINNING
	    #/> COM-MARK-END
	    #\SP COM-SET-POP-MARK
	    #/@ COM-SET-POP-MARK
	    #\SP COM-PUSH-POP-POINT-EXPLICIT
	    #\SP COM-MOVE-TO-PREVIOUS-POINT
	    #\CR COM-INSERT-CRS
	    #/O COM-MAKE-ROOM
	    #/O COM-SPLIT-LINE
	    #/O COM-THIS-INDENTATION
	    #/^ COM-DELETE-INDENTATION
	    #/^ COM-DELETE-INDENTATION
	    #/D COM-DELETE-FORWARD
	    #\RUBOUT COM-RUBOUT
	    #\RUBOUT COM-TAB-HACKING-RUBOUT
	    #/K COM-KILL-LINE
	    #\CLEAR COM-CLEAR
	    #\BREAK COM-BREAK
	    #/W COM-SAVE-REGION
	    #/W COM-KILL-REGION
	    #/W COM-APPEND-NEXT-KILL
	    #/Y COM-YANK
	    #/Y COM-YANK-POP
	    #/L COM-RECENTER-WINDOW
	    #\FF COM-COMPLETE-REDISPLAY
	    #/! COM-COMPLETE-REDISPLAY
	    #/U COM-QUADRUPLE-NUMERIC-ARG
	    #/- COM-NEGATE-NUMERIC-ARG
	    #/- COM-NEGATE-NUMERIC-ARG
	    #/- COM-NEGATE-NUMERIC-ARG
	    (#/0 10.) COM-NUMBERS
	    (#/0 10.) COM-NUMBERS
	    (#/0 10.) COM-NUMBERS
	    #/T COM-EXCHANGE-CHARACTERS
	    #/T COM-EXCHANGE-WORDS
	    #/T COM-EXCHANGE-SEXPS
	    #/F COM-FORWARD-WORD
	    #/B COM-BACKWARD-WORD
	    #/K COM-KILL-SENTENCE
	    #/D COM-KILL-WORD
	    #\RUBOUT COM-BACKWARD-KILL-WORD
	    #/@ COM-MARK-WORD
	    #/F COM-FORWARD-SEXP
	    #/N COM-FORWARD-LIST
	    #/B COM-BACKWARD-SEXP
	    #/P COM-BACKWARD-LIST
	    #/K COM-KILL-SEXP
	    #\RUBOUT COM-BACKWARD-KILL-SEXP
	    #/@ COM-MARK-SEXP
	    #/) COM-FORWARD-UP-LIST
	    #/( COM-BACKWARD-UP-LIST
	    #/U COM-BACKWARD-UP-LIST
	    #/[ COM-BEGINNING-OF-DEFUN
	    #/] COM-END-OF-DEFUN
	    #/A COM-BEGINNING-OF-DEFUN
	    #/E COM-END-OF-DEFUN
	    #/D COM-DOWN-LIST
	    #/( COM-MAKE-/(/)
	    #/) COM-MOVE-OVER-/)
	    #/] COM-FORWARD-PARAGRAPH
	    #/[ COM-BACKWARD-PARAGRAPH
	    #/H COM-MARK-PARAGRAPH
	    #/E COM-FORWARD-SENTENCE
	    #/A COM-BACKWARD-SENTENCE
	    #/G COM-BEEP
	    #\TAB COM-INSERT-TAB
	    #\TAB COM-INDENT-FOR-LISP
	    #\TAB COM-INDENT-DIFFERENTLY
	    #\LF COM-INDENT-NEW-LINE
	    #/Q COM-INDENT-SEXP
	    #/N COM-DOWN-COMMENT-LINE
	    #/P COM-UP-COMMENT-LINE
	    #/Q COM-FILL-PARAGRAPH
	    #/G COM-FILL-REGION
	    #/\ COM-DELETE-HORIZONTAL-SPACE
	    #\CR COM-BACK-TO-INDENTATION
	    #/M COM-BACK-TO-INDENTATION
	    #\CR COM-BACK-TO-INDENTATION
	    #/M COM-BACK-TO-INDENTATION
	    #/U COM-UPPERCASE-WORD
	    #/L COM-LOWERCASE-WORD
	    #/C COM-UPPERCASE-INITIAL
	    #/\ COM-INDENT-REGION
	    #\FF COM-INSERT-FF
	    #\TAB COM-INSERT-TAB
	    #/S COM-CENTER-LINE
	    #/= COM-COUNT-LINES-REGION
	    #/= COM-FAST-WHERE-AM-I
	    #/S COM-INCREMENTAL-SEARCH
	    #/R COM-REVERSE-INCREMENTAL-SEARCH
	    #/ COM-EVALUATE-MINI-BUFFER
	    #/ COM-COMPILE-DEFUN
	    #/ COM-EVALUATE-DEFUN
	    #/ COM-EVALUATE-DEFUN-VERBOSE
	    #/ COM-EVALUATE-DEFUN-HACK
	    #/? COM-SELF-DOCUMENT
	    #/? COM-SELF-DOCUMENT
	    #/? COM-DOCUMENTATION
	    #\HELP COM-DOCUMENTATION
	    #/Q COM-VARIOUS-QUANTITIES
	    #/X COM-EXTENDED-COMMAND
	    #/X COM-ANY-EXTENDED-COMMAND
	    #/< COM-MARK-BEGINNING
	    #/> COM-MARK-END
	    #\LF COM-INDENT-NEW-COMMENT-LINE
	    #/% COM-REPLACE-STRING
	    #/% COM-QUERY-REPLACE
	    #/H COM-MARK-DEFUN
	    #/R COM-REPOSITION-WINDOW
	    #/' COM-UPCASE-DIGIT
	    #/ COM-FIND-PATTERN
	    #/Z COM-QUIT
	    #\END COM-QUIT
	    #/~ COM-NOT-MODIFIED
	    #/& COM-FROB-LISP-CONDITIONAL
	    #/$ COM-FROB-DO
	    #/ COM-QUICK-ARGLIST
	    #/ COM-BRIEF-DOCUMENTATION
	    #/ COM-LONG-DOCUMENTATION
	    #/J COM-CHANGE-FONT-CHAR
	    #/J COM-CHANGE-FONT-WORD
	    #/J COM-CHANGE-DEFAULT-FONT
	    #/# COM-TEXT-JUSTIFIER-CHANGE-FONT-WORD
	    #/_ COM-TEXT-JUSTIFIER-UNDERLINE-WORD
	    #/# COM-GOTO-CHARACTER
	    #\MOUSE-1-1 COM-MOUSE-MARK-REGION
	    #\MOUSE-1-2 COM-MOUSE-MOVE-REGION
	    #\MOUSE-2-1 COM-MOUSE-MARK-THING
	    #\MOUSE-2-2 COM-MOUSE-KILL-YANK
	    )
	  (MAKE-COMMAND-ALIST
	     COM-INSTALL-COMMAND COM-ARGLIST COM-KEEP-LINES COM-FLUSH-LINES
	     COM-HOW-MANY COM-COUNT-LINES COM-QUERY-REPLACE COM-REPLACE-STRING
	     COM-OCCUR COM-LIST-ALL-DIRECTORY-NAMES COM-VIEW-DIRECTORY
	     COM-COMPILE-REGION COM-COMPILE-BUFFER COM-EVALUATE-REGION COM-EVALUATE-BUFFER
	     COM-VIEW-Q-REGISTER COM-LIST-Q-REGISTERS COM-KILL-Q-REGISTER
	     COM-LIST-VARIABLES COM-VARIABLE-APROPOS COM-VARIABLE-DOCUMENT COM-VARIABLE-SET
	     COM-GRIND-DEFINITION COM-GRIND-S-EXPRESSION COM-EVALUATE-INTO-BUFFER COM-TRACE
	     COM-VIEW-LOGIN-DIRECTORY COM-VIEW-XGP-QUEUE COM-VIEW-TTY-USERS COM-VIEW-MAIL
	     COM-ATOM-QUERY-REPLACE COM-FORMAT-CODE COM-MULTIPLE-QUERY-REPLACE
	     COM-MULTIPLE-QUERY-REPLACE-FROM-BUFFER COM-QUERY-EXCHANGE
	     COM-QUERY-REPLACE-LAST-KILL COM-QUERY-REPLACE-LET-BINDING
	     COM-FIND-UNBALANCED-PARENTHESES COM-MACRO-EXPAND-SEXP
	     COM-UNDO COM-FILL-LONG-COMMENT COM-UNCOMMENT-REGION
	     COM-SORT-LINES COM-SORT-PARAGRAPHS COM-SORT-VIA-KEYBOARD-MACROS
  DOC :
	     COM-LIST-COMMANDS COM-APROPOS COM-WHERE-IS COM-DESCRIBE-COMMAND
	     COM-INSERT-FILE COM-WRITE-REGION COM-APPEND-TO-FILE COM-PREPEND-TO-FILE
	     COM-VIEW-FILE COM-LIST-FILES COM-RENAME-FILE COM-COPY-FILE COM-DELETE-FILE
	     COM-LISP-MODE COM-TEXT-MODE COM-FUNDAMENTAL-MODE COM-PL1-MODE COM-BOLIO-MODE
	     COM-ELECTRIC-PL1-MODE COM-ATOM-WORD-MODE COM-EMACS-MODE COM-OVERWRITE-MODE
	     COM-TECO-MODE COM-MACSYMA-MODE COM-AUTO-FILL-MODE COM-WORD-ABBREV-MODE
	     COM-INSERT-WORD-ABBREVS COM-KILL-ALL-WORD-ABBREVS COM-LIST-WORD-ABBREVS
	     COM-DEFINE-WORD-ABBREVS COM-EDIT-WORD-ABBREVS COM-LIST-SOME-WORD-ABBREVS
	     COM-WRITE-WORD-ABBREV-FILE COM-READ-WORD-ABBREV-FILE COM-MAKE-WORD-ABBREV
	     COM-EDIT-TAB-STOPS COM-MIDAS-MODE COM-ELECTRIC-SHIFT-LOCK-MODE
  FONT , KBDMAC , DIRED
	     COM-SET-FONTS COM-INSTALL-MACRO COM-VIEW-KBD-MACRO
	     ))))
  (SETQ *STANDARD-CONTROL-X-COMTAB*
	(SET-COMTAB NIL '(#/G COM-PREFIX-BEEP
			  #/D COM-DISPLAY-DIRECTORY
			  #/N COM-SET-GOAL-COLUMN
			  #/P COM-MARK-PAGE
			  #/X COM-SWAP-POINT-AND-MARK
			  #/G COM-OPEN-GET-Q-REG
			  #/X COM-PUT-Q-REG
			  #/L COM-COUNT-LINES-PAGE
			  #\RUBOUT COM-BACKWARD-KILL-SENTENCE
			  #/. COM-SET-FILL-PREFIX
			  #/F COM-SET-FILL-COLUMN
			  #/U COM-UPPERCASE-REGION
			  #/L COM-LOWERCASE-REGION
			  #/O COM-DELETE-BLANK-LINES
			  #/I COM-INDENT-RIGIDLY
			  #/= COM-WHERE-AM-I
			  #/[ COM-PREVIOUS-PAGE
			  #/] COM-NEXT-PAGE
			  #/H COM-MARK-WHOLE
			  #/C COM-QUIT
			  #/J COM-CHANGE-FONT-REGION
			  #/( COM-START-KBD-MACRO
			  #/) COM-END-KBD-MACRO
			  #/E COM-CALL-LAST-KBD-MACRO
			  #/Q COM-KBD-MACRO-QUERY
			  #/ COM-REPEAT-LAST-MINI-BUFFER-COMMAND
			  #/T COM-EXCHANGE-LINES
			  #/T COM-EXCHANGE-REGIONS
			  #/# COM-TEXT-JUSTIFIER-CHANGE-FONT-REGION
			  #/_ COM-TEXT-JUSTIFIER-UNDERLINE-REGION
			  #\SP COM-MOVE-TO-DEFAULT-PREVIOUS-POINT
			  )))
  (SET-COMTAB-CONTROL-INDIRECTION *STANDARD-CONTROL-X-COMTAB*)
  (SET-COMTAB *STANDARD-COMTAB*
              (LIST #/X (MAKE-EXTENDED-COMMAND *STANDARD-CONTROL-X-COMTAB*)))
  (SETQ *COMPLETING-READER-COMTAB*
	(SET-COMTAB NIL '(#/ COM-COMPLETE
			  #\SP COM-SELF-INSERT-AND-COMPLETE
			  #/) COM-SELF-INSERT-AND-COMPLETE
			  #/? COM-LIST-COMPLETIONS
			  #/Q COM-QUOTED-INSERT
			  #\HELP COM-DOCUMENT-COMPLETING-READ
			  #// COM-COMPLETION-APROPOS
			  #\CR COM-COMPLETE-AND-EXIT
			  #/G COM-MINI-BUFFER-BEEP
			  #\CR COM-COMPLETE-AND-EXIT
			  #\END COM-COMPLETE-AND-EXIT
			  #\MOUSE-1-1 COM-MOUSE-END-OF-MINI-BUFFER
                          #\MOUSE-3-1 COM-MOUSE-LIST-COMPLETIONS
                          #/Z :UNDEFINED
			  #/Z :UNDEFINED
			  #/Z :UNDEFINED)))
  (SET-COMTAB-INDIRECTION *COMPLETING-READER-COMTAB* *STANDARD-COMTAB*)
  (SETQ *CONTROL-R-COMTAB*
	(SET-COMTAB NIL '(#/ COM-EXIT-CONTROL-R
			  #\END COM-EXIT-CONTROL-R)))
  (SET-COMTAB-INDIRECTION *CONTROL-R-COMTAB* *STANDARD-COMTAB*)
  (SETQ *RECURSIVE-EDIT-COMTAB*
	(SET-COMTAB NIL '(#/ COM-EXIT-CONTROL-R
			  #\END COM-EXIT-CONTROL-R
			  #/G COM-RECURSIVE-EDIT-BEEP)))
  (SET-COMTAB-INDIRECTION *RECURSIVE-EDIT-COMTAB* *STANDARD-COMTAB*)
  (SETQ *STANDALONE-COMTAB*
	(SET-COMTAB NIL '(#/ COM-QUIT)))
  (SET-COMTAB-INDIRECTION *STANDALONE-COMTAB* *STANDARD-COMTAB*)
  )

(DEFUN MAKE-COMMAND-ALIST (COMMAND-LIST)
  (DO ((CL COMMAND-LIST (CDR CL))
       (RET NIL (LET ((NAME (GET (CAR CL) 'COMMAND-NAME)))
		  (OR NAME (FERROR NIL "~S is not a defined command." (CAR CL)))
		  (CONS (CONS NAME (CAR CL))
			RET))))
      ((NULL CL) (NREVERSE RET))))

(DEFMETHOD (EDITOR :SET-WINDOW-INTERVAL) (WINDOW INTERVAL)
  (SET-WINDOW-INTERVAL WINDOW INTERVAL))

(DEFUN SET-WINDOW-INTERVAL (WINDOW INTERVAL)
  (SETF (WINDOW-INTERVAL WINDOW) INTERVAL)
  (LET ((FIRST-BP (INTERVAL-FIRST-BP INTERVAL)))
    (SETF (WINDOW-POINT WINDOW) (COPY-BP FIRST-BP ':NORMAL))
    (SETF (WINDOW-MARK WINDOW) (COPY-BP FIRST-BP ':NORMAL))
    (SETF (WINDOW-START-BP WINDOW) (COPY-BP FIRST-BP ':NORMAL))))

(DEFUN MAKE-WINDOW-CURRENT (WINDOW &OPTIONAL (SELECT-P T) &AUX INTERVAL)
  (SETQ *WINDOW-LIST* (CONS WINDOW (DELQ WINDOW *WINDOW-LIST*)))
  (COND ((AND (NEQ WINDOW *WINDOW*) (NEQ *WINDOW* *MINI-BUFFER-WINDOW*)
	      (OR (NEQ WINDOW *MINI-BUFFER-WINDOW*) *MINI-BUFFER-COMMAND-IN-PROGRESS*))
	 (SETQ *WINDOW* WINDOW
	       INTERVAL (WINDOW-INTERVAL WINDOW))
	 (FUNCALL-SELF ':SET-INTERVAL INTERVAL)
	 (SETQ *TYPEOUT-WINDOW* (WINDOW-TYPEOUT-WINDOW WINDOW)
	       TERMINAL-IO *TYPEOUT-WINDOW*)
	 (MULTIPLE-VALUE (*MODE-LINE-WINDOW* *TYPEIN-WINDOW* *MINI-BUFFER-WINDOW*)
	   (WINDOW-MODE-LINE-WINDOWS WINDOW))
	 (AND SELECT-P (SELECT-WINDOW WINDOW)))))

(DEFMETHOD (EDITOR :SET-INTERVAL) (INTERVAL)
  (OR (EQ (WINDOW-INTERVAL *WINDOW*) INTERVAL)
      (SET-WINDOW-INTERVAL *WINDOW* INTERVAL))
  (SETQ *INTERVAL* INTERVAL))


(DEFUN CHAR-SYNTAX (CHAR SYNTAX-TABLE)
  (SETQ CHAR (LDB %%CH-CHAR CHAR))
  (COND ((ARRAYP SYNTAX-TABLE)
	 (AREF SYNTAX-TABLE CHAR))
	((CDR (ASSQ CHAR (CDR SYNTAX-TABLE))))
	((CHAR-SYNTAX CHAR (CAR SYNTAX-TABLE)))))

(DEFUN SET-CHAR-SYNTAX (SYNTAX SYNTAX-TABLE CHAR &AUX TEM)
  (COND ((ARRAYP SYNTAX-TABLE)
	 (ASET SYNTAX SYNTAX-TABLE CHAR))
	((SETQ TEM (ASSQ CHAR (CDR SYNTAX-TABLE)))
	 (RPLACD TEM SYNTAX))
	(T
	 (PUSH (CONS CHAR SYNTAX) (CDR SYNTAX-TABLE)))))

(DEFUN MAKE-SPARSE-SYNTAX-TABLE (INDIRECT-TO)
  (NCONS INDIRECT-TO))

(DEFUN MAKE-SYNTAX-TABLE (SPECS)
  (DO ((SPECS SPECS (CDR SPECS))
       (SPEC)
       (I 0)
       (TABLE (MAKE-ARRAY NIL 'ART-4B 400)))
      ((NULL SPECS)
       (IF (NOT (= I 400))
	   (FERROR NIL "Wrong number (~S) of elements in the specs" I))
       TABLE)
    (SETQ SPEC (CAR SPECS))
    (COND ((SYMBOLP SPEC)
	   (ASET (SYMEVAL SPEC) TABLE I)
	   (SETQ I (1+ I)))
	  (T (DO ((J 0 (1+ J))
		  (VALUE (SYMEVAL (SECOND SPEC)))
		  (LIMIT (FIRST SPEC)))
		 (( J LIMIT))
	       (ASET VALUE TABLE I)
	       (SETQ I (1+ I)))))))

(DEFUN INITIALIZE-SYNTAX-TABLES ()
  (SETQ *WORD-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE
			      '((40 WORD-ALPHABETIC)
040 space
041 !
042 " "
043 #
044 $
045 %
046 &
047 '
050 (
051 )
052 *
053 +
054 ,
055 -
056 .
057 /
072 :
074 <
075 =
076 >
077 ?
100 @
133 [
134 \
135 ]
136 ^
137 _
140 `
				(205 WORD-DELIMITER)))
	*LIST-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE
			      '((40 LIST-ALPHABETIC)
040 space
041 !
042 "      "
043 #
044 $
045 %
046 &
047 '
050 (
051 )
052 *
053 +
054 ,
055 -
056 .
057 /
072 :
074 <
075 =
076 >
077 ?
100 @
133 [
134 \
135 ]
136 ^
137 _
140 ` STANDARD MACRO
173 {
174 |             |
175 }
176 ~
177 integral ? ? ?
				
200 null character
201 break
202 clear
203 call
204 escape ( NOT altmode ! )
205 backnext
206 help
207 rubout
210 bs
211 tab
212 line
213 vt
214 form = newpage
215 return = newline
				(162 LIST-ALPHABETIC)))
	*ATOM-WORD-SYNTAX-TABLE* (MAKE-SYNTAX-TABLE
				   '((40 LIST-ALPHABETIC)
040 space
041 !
042 "      "
043 #
044 $
045 %
046 &
047 '
050 (
051 )
052 *
053 +
054 ,
055 -
056 .
057 /
072 :
074 <
075 =
076 >
077 ?
100 @
133 [
134 \
135 ]
136 ^
137 _
140 `
				     (200 WORD-DELIMITER)))))


  ZWEI , but not the ZMACS ones .   It first sets some unusual things , then
  initializes the ZWEI variables ( the ones defined with DEFVAR in the  file ) ,
(DEFUN INITIALIZE-ZWEI-GLOBALS ()
  (SETQ *UTILITY-PACKAGE* (SI:PKG-CREATE-PACKAGE "ZWEI Utility Package" NIL))
Reset other variables defined by DEFGLOBAL
    (SET (CAR VAR) (CDR VAR)))
  (SETQ-ZWEI-VARIABLES)
  (INITIALIZE-WORD-ABBREV-TABLE)
  (INITIALIZE-INCREMENTAL-SEARCH-GLOBALS)
  (INITIALIZE-STANDARD-COMTABS)
  (INITIALIZE-SYNTAX-TABLES)
  (INITIALIZE-MINI-BUFFER)
  (INITIALIZE-TAB-STOP-BUFFER)
  (INITIALIZE-MOUSE)
  )

(DEFVAR *MINI-BUFFER-MULTI-LINE-COMTAB*)
(DEFVAR *MINI-BUFFER-COMTAB*)
(DEFVAR *MINI-BUFFER-RING*)
(DEFVAR *MINI-BUFFER-REPEATED-COMMAND*)

(DEFUN INITIALIZE-MINI-BUFFER ()
  (SETQ *MINI-BUFFER-RING* NIL *MINI-BUFFER-REPEATED-COMMAND* NIL)
  (SETQ *MINI-BUFFER-MULTI-LINE-COMTAB*
	(SET-COMTAB NIL '(#\HELP COM-DOCUMENT-CONTAINING-COMMAND
			  #\CR COM-END-OF-MINI-BUFFER
			  #\END COM-END-OF-MINI-BUFFER
			  #/G COM-MINI-BUFFER-BEEP
			  #/Z :UNDEFINED
			  #/Z :UNDEFINED
			  #/Z :UNDEFINED
			  #/Y COM-POP-MINI-BUFFER-RING
			  #\MOUSE-1-2 COM-MOUSE-END-OF-MINI-BUFFER
			  )))
  (SET-COMTAB-INDIRECTION *MINI-BUFFER-MULTI-LINE-COMTAB* *STANDARD-COMTAB*)
  (SETQ *MINI-BUFFER-COMTAB* (SET-COMTAB NIL '(#\CR COM-END-OF-MINI-BUFFER)))
  (SET-COMTAB-INDIRECTION *MINI-BUFFER-COMTAB* *MINI-BUFFER-MULTI-LINE-COMTAB*)
  (INITIALIZE-MINI-BUFFER-WINDOW))
