;;; -*- Mode:Common-Lisp; Package:SYSTEM; Base:10; Fonts:(CPTFONT HL12B HL12I) -*-


;1;;*
(DEFUN FIND-SYSTEM-INSTANCE (SYSTEM-NAME &OPTIONAL (MAKE-SYSTEM-IF-NEEDED :ASK)
			     &AUX CURRENT ALIAS WINDOW)
  "2Find an instance of the system named SYSTEM-NAME.  If this system is not made,
    then it will be made first.  An instance of it will then be found, or created if none
    exists yet, and selected as specified by the system's DEFSYSTEM.*"
  (LET* ((PLIST   (GET-SYSTEM-ACCESS-LIST SYSTEM-NAME))
	 (TYPE    (GETF PLIST :INSTANCE-TYPE))
	 (FINDER  (GETF PLIST :INSTANCE-FINDER))
	 (CREATOR (GETF PLIST :INSTANCE-CREATOR))
	 (MADE-P  (GETF PLIST :MADE-P)))
    (WHEN (OR MADE-P
	      (COND
		((EQ :ASK MAKE-SYSTEM-IF-NEEDED)
		 (WHEN (W:MOUSE-CONFIRM "This system has not been made!"
					(FORMAT NIL
						"Click mouse or press ” to make system.~%~
				                  Move off window or press <N> to abort."))
		   (MAKE-SYSTEM SYSTEM-NAME :SILENT :NOWARN)))
		(MAKE-SYSTEM-IF-NEEDED
		 (MAKE-SYSTEM SYSTEM-NAME :SILENT :NOWARN))
		(T NIL)))
      (W:DELAYING-SCREEN-MANAGEMENT
	(CASE TYPE
	  (:EVAL   (EVAL FINDER))
	  (:WINDOW (IF (ATOM FINDER)
		       (SEND FINDER :MOUSE-SELECT)
		       (SEND (EVAL FINDER) :MOUSE-SELECT)))
	  (:FLAVOR (SETQ CURRENT W::SELECTED-WINDOW)
		   (WHEN CURRENT
		     (SETQ ALIAS (SEND CURRENT :ALIAS-FOR-SELECTED-WINDOWS)))
		   (COND
		     ;1; There are unselected windows of this flavor to cycle through*
		     ((SETQ WINDOW (W:FIND-WINDOW-OF-FLAVOR FINDER
							    CURRENT))
		      (WHEN CURRENT
			(SEND CURRENT :DESELECT (WHEN (TYPEP ALIAS FINDER)
						  :END)))
		      (SEND WINDOW :MOUSE-SELECT))
		     ;1; The CURRENT window is the only window of this flavor*
		     ((AND CURRENT
			   (TYPEP ALIAS FINDER))
		      (BEEP))
		     ;1; Must create a new window but can't (CREATOR is NIL)*
		     ((NULL CREATOR)
		      (BEEP))
		     ;1; Create a new window on default-screen*
		     ((ATOM CREATOR)
		      (WHEN CURRENT
			(SEND CURRENT :DESELECT (IF (TYPEP ALIAS FINDER)
						    :END)))
		      (SEND (MAKE-INSTANCE (IF (EQ CREATOR T)
					       FINDER
					       CREATOR)
					   :SUPERIOR
					   W::DEFAULT-SCREEN)
			    :MOUSE-SELECT))
		     ;1; Evaluate CREATOR*
		     (T (EVAL CREATOR)))))
	NIL))))

(DEFUN CREATE-SYSTEM-INSTANCE (SYSTEM-NAME &OPTIONAL (MAKE-SYSTEM-IF-NEEDED :ASK)
			       &AUX CURRENT ALIAS)
  "2Create a new instance of the system named SYSTEM-NAME.  If this system is not made,
    then it will be made first.  An instance of it will then be created and selected as
    specified by the system's DEFSYSTEM.*"
  (LET* ((PLIST   (GET-SYSTEM-ACCESS-LIST SYSTEM-NAME))
	 (TYPE    (GETF PLIST :INSTANCE-TYPE))
	 (FINDER  (GETF PLIST :INSTANCE-FINDER))
	 (CREATOR (GETF PLIST :INSTANCE-CREATOR))
	 (MADE-P  (GETF PLIST :MADE-P)))
    (WHEN (OR MADE-P
	      (COND
		((EQ :ASK MAKE-SYSTEM-IF-NEEDED)
		 (WHEN (W:MOUSE-CONFIRM "This system has not been made!"
					(FORMAT NIL
						"Click mouse or press ” to make system.~%~
				                  Move off window or press <N> to abort."))
		   (MAKE-SYSTEM SYSTEM-NAME :SILENT :NOWARN)))
		(MAKE-SYSTEM-IF-NEEDED
		 (MAKE-SYSTEM SYSTEM-NAME :SILENT :NOWARN))
		(T NIL)))
      (W:DELAYING-SCREEN-MANAGEMENT
	(CASE TYPE
	  (:EVAL   (IF (ATOM CREATOR)
		       (IF (NULL CREATOR)
			   (NOTIFY-CANNOT-CREATE SYSTEM-NAME)
			   (EVAL FINDER))
		       (EVAL CREATOR)))
	  (:WINDOW (IF (NULL CREATOR)
		       (NOTIFY-CANNOT-CREATE SYSTEM-NAME)
		       (IF (ATOM CREATOR)
			   (IF (EQ CREATOR T)
			       (SEND FINDER :MOUSE-SELECT)
			       (SEND CREATOR :MOUSE-SELECT))
			   (SEND (EVAL CREATOR) :MOUSE-SELECT))))
	  (:FLAVOR (SETQ CURRENT W::SELECTED-WINDOW)
		   (WHEN CURRENT
		     (SETQ ALIAS (SEND CURRENT :ALIAS-FOR-SELECTED-WINDOWS)))
		   (COND
		     ;1; Must create a new window but can't (CREATOR is NIL)*
		     ((NULL CREATOR)
		      (NOTIFY-CANNOT-CREATE SYSTEM-NAME))
		     ;1; Create a new window on default-screen*
		     ((ATOM CREATOR)
		      (WHEN CURRENT
			(SEND CURRENT :DESELECT (IF (TYPEP ALIAS FINDER)
						    :END)))
		      (SEND (MAKE-INSTANCE (IF (EQ CREATOR T)
					       FINDER
					       CREATOR)
					   :SUPERIOR
					   W::DEFAULT-SCREEN)
			    :MOUSE-SELECT))
		     ;1; Evaluate CREATOR*
		     (T (EVAL CREATOR))))))
      NIL)))


(DEFUN NOTIFY-CANNOT-CREATE (NAME)
  "2Pops up a notification that this system cannot be recreated.*"
  (W:NOTIFY NIL
	    "The system ~A can only have one instance.~%~
              A new version cannot be created."
	    NAME))