;;; -*- Mode:LISP; Package:(KMC USE (LISP GLOBAL)); Base:10; Readtable:CL -*-

(in-package 'kmc :use '(LISP GLOBAL OBJ USER))

;;; macros for generating window/menu routines

(defun l-name (x)
  (intern (string-append "L-" x)))

(defmacro ask-have(var val)
  `(ask (current-obj) (have ',var ,val)))

(defun ask-have (var val)
  (list 'ask '(current-obj)
	(list 'have
	      (list 'quote var)
	      val)))

(defmacro defobj-editvars (obj label &rest alist)
  (let* ((vars (mapcar #'car alist))
	 (lvars (mapcar #'l-name vars)))
    `(defobfun (editvars ,obj) ()
       (ask (current-obj) (show-own-vals))
       (let ((abort nil)
	     ,@(mapcar #'(lambda(x) (list (l-name x) x)) vars))
	 (declare(special abort ,@lvars))
	 (catch 'abort
	   (tv:choose-variable-values
	     ',(loop for old in vars
		     for new in lvars
		     with l = alist
		     do (setf l (subst new old l))
		     finally (return l))
	     :extra-width 30
	     :margin-choices '("Exit/Save"
			       ("Abort" (throw 'abort (values nil :abort))))
	     :near-mode '(:point 400 400)
	     :label ,label)
	   ,@(mapcar #'ask-have vars lvars)
	   (ask (current-obj) (show-own-vals)))
	 ;;changes saved
	 ))))

;;; A SYSTEM is a hardware entity (the chassis)

(defkind system)

(definstancevars system
  (sys-name nil)
  (maker nil))

;;; A HOST is a software entity (the workstation)

(defkind host)

(definstancevars host
  (host-name nil)
  (nicknames nil)
  (host-type nil)
  (files-type nil)
  (my-sys-host nil)
  (mail-server nil))

;;; Unix

(defkind unix-host host)

(defclassvars unix-host
  (host-type 'unix)
  (files-type 'unix))

(defobj-editvars unix-host
	  "--- Edit UNIX host ---"
	  (host-name  "Host name"
		      :documentation "Enter the name of this host.")
	  (nicknames "Nicknames (list)"))

(defkind vax system)

(defclassvars vax
  (maker 'digital-equipment-corp))

(defkind vax-host)

(defkind vax42-host vax-host unix-host)

(defkind vaxvms-host vax-host)

(defclassvars vaxvms-host
  (host-type 'vax)
  (files-type 'vms))

;;; Lisp machines

(defkind lispm-host host)

(defclassvars lispm-host
  (host-type  'lispm)
  (files-type 'lispm))

(defobj-editvars lispm-host
	  "Edit Lisp Machine host"
	  (host-name  "Host name"
		      :documentation "Enter the name of this host.")
	  (nicknames "Nicknames (list)")
	  (my-sys-host "Remote sys host")
	  (mail-server "Remote mail server host"))

(defkind lisp-machine system)

(defkind explorer lisp-machine lispm-host)

(defclassvars explorer
  (maker 'ti))

(defkind symbolics lisp-machine lispm-host)

(defclassvars symbolics
  (files-type :lmfs))

;;; LMI machines

(defkind lambda-host lispm-host)

(defkind lambda lisp-machine)

(defclassvars lambda
  (maker 'lmi))

(definstancevars lambda
  (chassis-type 'regular)
  (excelan-p nil)
  (3com-p t)
 )

(defconst valid-lambda-chassis '(regular heavy-duty))

(defobj-editvars lambda
		 "Edit LAMBDA system info"
  (chassis-type "Chassis type" :choose #.valid-lambda-chassis)
  (excelan-p "Contains TCP/IP Interface" :boolean)
  (3com-p "Contains Chaosnet Interface"  :boolean))

(defkind lambda1 lambda)

(definstancevars lambda1
  (lisp-1 (oneof lambda-host)))

(defkind lambda2 lambda1)

(definstancevars lambda2
  (lisp-2 (oneof lambda-host)))

(defkind lambda+ lambda)

(definstancevars lambda+
  (unix-a (oneof unix-host)))

(defkind lambda2+ lambda2 lambda+)

(defkind lambda3 lambda2)

(definstancevars lambda3
  (lisp-3 (oneof lambda-host)))