;;;-*- Mode:Common-Lisp; Package:SI; Cold-load:T; Base:10. -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.

;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151

;;; Copyright (C) 1984-1989 Texas Instruments Incorporated. All rights reserved.

;;; This file contains the new mechanism for switching between Common Lisp and Zetalisp.

;;; Maintenance Note:  Notice that this is written in Common Lisp/Zetalisp compatible code 
;;; so that the exact interpretation of Mode:LISP in the file attribute line is unimportant.

;;; For this initial implementation, MODE:LISP will be interpreted as MODE:ZETALISP when
;;; it occurs in the MODE-LINE of a file.  It is an error elsewhere.

;;;Record of changes:
;;03/03/89 clm - modified WITH-COMMON-LISP-ON so that *readtable* is changed 
;;               only if you're definitely in Zetalisp mode, otherwise someone 
;;               may have bound *readtable*.  Made a comparable change to WITH-ZETALISP-ON.
;; 4/22/89 DNG - Change LISP-MODE-KEYWORD-P to use new variable 
;;		*VALID-LISP-MODES* so that additional modes (such as Scheme) can
;;		be easily added.

;;; *LISP-MODE* is set to :ZETALISP when loaded during build.
;;; LISP-REINITIALIZE changes it to :COMMON-LISP during a cold boot.
(DEFVAR *LISP-MODE* :ZETALISP
 "This variable reflects the current Lisp Mode. This is an internal symbol and for the use of
the Lisp Mode control functions only.  Changing its value will NOT change the Lisp Mode.  Use
SET-LISP-MODE, TURN-COMMON-LISP-ON or TURN-ZETALISP-ON for that purpose.  Its legal values are
:ZETALISP and :COMMON-LISP.")

(DEFVAR *VALID-LISP-MODES* '(:COMMON-LISP :ZETALISP))

(DEFSUBST LISP-MODE-KEYWORD-P (LISP-MODE-KEYWORD)
 "Returns T if LISP-MODE-KEYWORD is a valid value for *LISP-MODE*. Otherwise, it returns NIL."
  (AND (MEMBER LISP-MODE-KEYWORD *VALID-LISP-MODES* :TEST #'EQ) T))

;;; Rjf - 8/26/87 *default-major-mode* is defined in sys:zmacs;macros
(proclaim '(special ZWEI:*DEFAULT-MAJOR-MODE*))

;;;This must be redefined later using ZWEI:DEFVARIABLE in ZWEI;MACROS,
;;;but must also be defined here for the cold load.
;;;(DEFVAR ZWEI:*DEFAULT-MAJOR-MODE* :ZETALISP
;;;  "The major mode in which new buffers are placed by default.")

(DEFMACRO CHANGE-ZWEI-DEFAULT (LISP-MODE-KEYWORD)
  "Sets ZWEI:*DEFAULT-MAJOR-MODE* to LISP-MODE-KEYWORD as long as current value is
:LISP, :COMMON-LISP or :ZETALISP"
   `(IF (OR (EQ ZWEI:*DEFAULT-MAJOR-MODE* :LISP)
	    (SI:LISP-MODE-KEYWORD-P ZWEI:*DEFAULT-MAJOR-MODE*))
      ,LISP-MODE-KEYWORD
      ZWEI:*DEFAULT-MAJOR-MODE*))

(DEFUN (:PROPERTY :MODE FS:FILE-ATTRIBUTE-BINDINGS) (IGNORE IGNORE MODE-KEYWORD)
  "If MODE in the file attribute line is a legal Lisp Mode keyword, then this function
will return a set of bindings suitable for use by PROGV which are equivalent to using the
WITH-X special form.  If MODE is not a valid Lisp Mode keyword, this function returns
empty bindings lists."
  (DECLARE (VALUES LISP-MODE-VARIABLES-LIST LISP-MODE-VALUES-LIST))
  (IF (EQ MODE-KEYWORD :LISP) (SETQ MODE-KEYWORD :ZETALISP))      ;Equate :LISP with :ZETALISP
  (IF (NOT (LISP-MODE-KEYWORD-P MODE-KEYWORD))
      ;; then MODE was not anything recognized as a Lisp Mode keyword, so return nothing
      (VALUES NIL NIL)
    ;; else MODE was a recognized Lisp Mode keyword, so return the appropiate bindings
    (VALUES ;; Maintenance Note:  IF this list of bindings is changed, then corresponding
            ;; changes will probably be needed in the other mode switching functions.
            (LIST* '*LISP-MODE*
		   '*READTABLE*
		   'SI:*READER-SYMBOL-SUBSTITUTIONS*
		   'ZWEI:*DEFAULT-MAJOR-MODE*
		   nil)
	    (CASE MODE-KEYWORD
		  (:COMMON-LISP
		   (LIST* :COMMON-LISP                          ;*LISP-MODE*
			  SI:COMMON-LISP-READTABLE	;*READTABLE*
			  SI:*COMMON-LISP-SYMBOL-SUBSTITUTIONS*	;*READER-SYMBOL-SUBSTITUTIONS*
			  :COMMON-LISP		;ZWEI:*DEFAULT-MAJOR-MODE*
			  nil))
		  (:ZETALISP
		   (LIST* :ZETALISP                             ;*LISP-MODE*
			  SI:STANDARD-READTABLE		       ;*READTABLE*
			  si:*ZETALISP-SYMBOL-SUBSTITUTIONS*    ;*READER-SYMBOL-SUBSTITUTIONS*
                          :ZETALISP		               ;ZWEI:*DEFAULT-MAJOR-MODE*
			  nil ))))))                       

(DEFUN TURN-COMMON-LISP-ON (&OPTIONAL GLOBALLY)
  "This function sets the current Lisp Mode to :COMMON-LISP. It returns :COMMON-LISP.
If GLOBALLY is non-NIL, the global bindings, instead of the local bindings, are changed."
  (DECLARE (VALUES :COMMON-LISP))
  (IF GLOBALLY
      (SETQ-GLOBALLY *READTABLE*                      COMMON-LISP-READTABLE
                     *READER-SYMBOL-SUBSTITUTIONS*    *COMMON-LISP-SYMBOL-SUBSTITUTIONS*
		     ZWEI:*DEFAULT-MAJOR-MODE*        (CHANGE-ZWEI-DEFAULT :COMMON-LISP)
		     *LISP-MODE*                      :COMMON-LISP)
      (SETQ *READTABLE*                      COMMON-LISP-READTABLE
	    *READER-SYMBOL-SUBSTITUTIONS*    *COMMON-LISP-SYMBOL-SUBSTITUTIONS*
	    ZWEI:*DEFAULT-MAJOR-MODE*        (CHANGE-ZWEI-DEFAULT :COMMON-LISP)
	    *LISP-MODE*                      :COMMON-LISP)))

(DEFUN TURN-ZETALISP-ON (&OPTIONAL GLOBALLY)
  "This function sets the current Lisp Mode to :ZETALISP.  It returns :ZETALISP.
If GLOBALLY is non-NIL, the global bindings, instead of the local bindings, are changed."
  (DECLARE (VALUES :ZETALISP))
  (IF GLOBALLY
      (SETQ-GLOBALLY *READTABLE*                      STANDARD-READTABLE
		     *READER-SYMBOL-SUBSTITUTIONS*    si:*ZETALISP-SYMBOL-SUBSTITUTIONS*    
		     ZWEI:*DEFAULT-MAJOR-MODE*        (CHANGE-ZWEI-DEFAULT :ZETALISP)
		     *LISP-MODE*                      :ZETALISP)
      (SETQ *READTABLE*                      STANDARD-READTABLE
	    *READER-SYMBOL-SUBSTITUTIONS*    si:*ZETALISP-SYMBOL-SUBSTITUTIONS*    
	    ZWEI:*DEFAULT-MAJOR-MODE*        (CHANGE-ZWEI-DEFAULT :ZETALISP)
	    *LISP-MODE*                      :ZETALISP)))

(DEFUN SET-LISP-MODE (LISP-MODE-KEYWORD &OPTIONAL GLOBALLY)
  "This function sets the current Lisp Mode to LISP-MODE-KEYWORD
which must be either :COMMON-LISP or :ZETALISP.  It returns the current Lisp Mode.
If GLOBALLY is non-NIL, the global bindings, instead of the local bindings, are changed."
  (DECLARE (VALUES CURRENT-LISP-MODE-KEYWORD))
  (CASE LISP-MODE-KEYWORD
	(:ZETALISP
	 (TURN-ZETALISP-ON GLOBALLY))
	(:COMMON-LISP
	 (TURN-COMMON-LISP-ON GLOBALLY))
	(OTHERWISE
	 ;; signal wrong argument type and try again if the user asks to proceed
	 (CHECK-ARG LISP-MODE-KEYWORD (LISP-MODE-KEYWORD-P LISP-MODE-KEYWORD)
		    ":COMMON-LISP or :ZETALISP")
	 (SET-LISP-MODE LISP-MODE-KEYWORD GLOBALLY))))

(DEFSUBST COMMON-LISP-ON-P (&OPTIONAL GLOBALLY)
  "Returns true if the current Lisp Mode is :COMMON-LISP and returns false otherwise.
If GLOBALLY is non-NIL, the global bindings, instead of the local bindings, are checked."
  (IF GLOBALLY
      (EQ (SYMEVAL-GLOBALLY '*LISP-MODE*) :COMMON-LISP)
      (EQ *LISP-MODE* :COMMON-LISP)))
						
(DEFSUBST ZETALISP-ON-P (&OPTIONAL GLOBALLY)
  "Returns true if the current Lisp Mode is :ZETALISP and returns false otherwise.
If GLOBALLY is non-NIL, the global bindings, instead of the local bindings, are checked."
  (IF GLOBALLY
      (EQ (SYMEVAL-GLOBALLY '*LISP-MODE*) :ZETALISP)
      (EQ *LISP-MODE* :ZETALISP)))

(DEFUN LISP-MODE (&OPTIONAL GLOBALLY)
  "This function returns the current Lisp Mode as the keyword :COMMON-LISP or :ZETALISP.
If GLOBALLY is non-NIL, the global bindings, instead of the local bindings, are checked."
  (IF GLOBALLY (SYMEVAL-GLOBALLY '*LISP-MODE*) *LISP-MODE*))

;;;This form ensures that (setf (lisp-mode) :zetalisp) does (turn-zetalisp-on).
(DEFSETF LISP-MODE SET-LISP-MODE)

(DEFMACRO WITH-COMMON-LISP-ON (&BODY BODY)
  "Executes BODY in Common Lisp Mode with the appropiate variables bound such that the 
previous Lisp Mode is restored on exit.  This form is not appropiate for typing into a
Listener because the entire body is read in the current Lisp Mode BEFORE any mode changes have
a chance to take effect."
  `(LET (;; Maintenance Note:  If this list of bindings is changed, change
         ;; the corresponding bindings in (:PROPERTY :MODE FILE-ATTRIBUTE-BINDINGS)
	 (SI:*LISP-MODE*                      :COMMON-LISP)
	 (SI:*READER-SYMBOL-SUBSTITUTIONS*    SI:*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)
	 (ZWEI:*DEFAULT-MAJOR-MODE*           :COMMON-LISP))
     (declare (special SI:*LISP-MODE*
		       SI:*READER-SYMBOL-SUBSTITUTIONS*
		       ZWEI:*DEFAULT-MAJOR-MODE*))
     (let-if (eq si:*readtable* SI:STANDARD-READTABLE)  ;; clm 03/03/89
	     ;;; Only change this if you're definitely in
	     ;;; Zetalisp mode, otherwise you might have
	     ;;; bound *readtable*.
	     ((SI:*READTABLE* SI:COMMON-LISP-READTABLE))
       ;;; Let-If doesn't allow declarations for some reason.
       (locally (declare (special SI:*READTABLE*)) ,@BODY))))

(DEFMACRO WITH-ZETALISP-ON (&BODY BODY)
  "Executes BODY in Zetalisp Mode with the appropiate variables bound such that the
previous Lisp Mode is restored on exit.  This form is not appropiate for typing into a
Listener because the entire body is read in the current Lisp Mode BEFORE any mode changes
have a chance to take effect."
  `(LET (;; Maintenance Note:  If this list of bindings is changed, change
         ;; the corresponding bindings in (:PROPERTY :MODE FILE-ATTRIBUTE-BINDINGS)
	 (SI:*LISP-MODE*                      :ZETALISP)
	 (SI:*READER-SYMBOL-SUBSTITUTIONS*    si:*ZETALISP-SYMBOL-SUBSTITUTIONS*)
	 (ZWEI:*DEFAULT-MAJOR-MODE*           :ZETALISP))
     (declare (special SI:*LISP-MODE*
		       SI:*READER-SYMBOL-SUBSTITUTIONS*
		       ZWEI:*DEFAULT-MAJOR-MODE*))
     (let-if (eq si:*readtable*  SI:COMMON-LISP-READTABLE)  ;; clm 03/03/89
	     ;;; Only change this if you're definitely in
	     ;;; Common-lisp mode, otherwise you might have
	     ;;; bound *readtable*.
	     ((SI:*READTABLE* SI:STANDARD-READTABLE))
       (locally (declare (special SI:*READTABLE*)) ,@BODY))))

(DEFMACRO WITH-LISP-MODE (LISP-MODE-KEYWORD &BODY BODY)
  "Executes BODY in the Lisp Mode specified by the LISP-MODE-KEYWORD argument with the
appropiate variables bound such that the previous Lisp Mode is restored on exit.  This form
is not appropiate for typing into a Listener because the entire body is read in the current
Lisp Mode BEFORE any mode changes have a chance to take effect."
  `(LET (;; Maintenance Note:  If this list of bindings is changed, change
         ;; the corresponding bindings in (:PROPERTY :MODE FILE-ATTRIBUTE-BINDINGS)
	 (SI:*LISP-MODE*                      SI:*LISP-MODE*)
	 (ZWEI:*DEFAULT-MAJOR-MODE*           ZWEI:*DEFAULT-MAJOR-MODE*)
	 (SI:*READTABLE*                      SI:*READTABLE*)
	 (SI:*READER-SYMBOL-SUBSTITUTIONS*    SI:*READER-SYMBOL-SUBSTITUTIONS*))
     (SET-LISP-MODE ,LISP-MODE-KEYWORD)
     ,@BODY))

(DEFMACRO SET-ZETALISP-BINDINGS ()
  "used by APPLY-LAMBDA to turn ZETALISP on when a GLOBAL:LAMBDA is seen and
   the current mode is Common-Lisp"
  `(PROGN
     (BIND (LOCF SI:*LISP-MODE*)                     :ZETALISP)
     (BIND (LOCF SI:*READTABLE*)                     SI:STANDARD-READTABLE)
     (BIND (LOCF ZWEI:*DEFAULT-MAJOR-MODE*)          (SI:CHANGE-ZWEI-DEFAULT :ZETALISP))
     (BIND (LOCF SI:*READER-SYMBOL-SUBSTITUTIONS*)   si:*ZETALISP-SYMBOL-SUBSTITUTIONS*)))

(DEFMACRO SET-COMMON-LISP-BINDINGS ()
  "used by APPLY-LAMBDA to turn on COMMON LISP when a CLI:LAMBDA is seen and
  the current mode is ZETALISP."
  `(PROGN
     (BIND (LOCF SI:*LISP-MODE*)                     :COMMON-LISP)
     (BIND (LOCF SI:*READTABLE*)                      SI:COMMON-LISP-READTABLE)
     (BIND (LOCF ZWEI:*DEFAULT-MAJOR-MODE*)          (SI:CHANGE-ZWEI-DEFAULT :COMMON-LISP))
     (BIND (LOCF SI:*READER-SYMBOL-SUBSTITUTIONS*)    SI:*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)))