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

;;; ;;; Functions to create/edit machine/host objects
;;;

(in-package 'hostobj :use '(lisp global obj))

(eval-when (eval compile load)
  (shadowing-import
    '(
	   user:defobedit
	   user:editlist user:editlabel
	   user:edit
	   user:edit-func
	   user:editable user:shadowed-editable
	   )))

(export '(make-host))

(defconstant *valid-hw-types* '(lambda symbolics vax unix))

(defclassvars *single-host-system*
  (editlist `((system-name "System Name" :sexp)
	      (first-name "Host Name" :sexp)
	      (nicknames "Machine Nicknames" :string-list)
	      (host-hardware "Hardware class" :choose ,*valid-hw-types*)
	      (host-software "Machine type" :sexp)))
  (editlabel "Edit/Verify Host Information"))

(defobedit *single-host-system*)

(defclassvars *multi-host-system*
  (editlist '((system-name "System Name" :sexp)))
  (editlabel "Edit/Verify System Information"))

(defobedit *multi-host-system*)

(defobfun (edit *multi-host-system*) ()
  (funcall edit-func)
  (dolist (host hosts)
    (ask host (edit))))
	  
(defclassvars *network-host*
  (editlist '((file-system-type "File System" :sexp)
	      (networks "Networks" :choose (chaos tcp both)))))

(defobedit *network-host*)

(defclassvars *chaos-host*
  (editlist '((chaos@ "Chaosnet address"
			:documentation "Enter an octal address"
			:number))))

(defobedit *chaos-host*)

(defconstant *lambda-types*
	     `((lambda ,*lam1*)
	       (lambda-plus ,*lam1p*)
	       (lambda-2x2 ,*lam2*)
	       (lambda-2x2-plus ,*lam2p*)
	       (lambda-3x3 ,*lam3*)))

(defclassvars *lambda*
  (editlist `((hw-type "Lambda type"
		       :choose ,(mapcar #'car *lambda-types*))))
  (editlabel "Edit/Verify Lambda System Info"))


(defobedit *lambda*)

(defclassvars *lispm-host*
  (editlist '((host-hardware "Hardware type" :display-only)
	      (host-software "Software type" :display-only)
	      (file-system-type "File System" :display-only)))
  (editlabel "Edit/Verify Lisp Machine Info"))

(defobedit *lispm-host*)

(defclassvars *vax*
  (editlist '((hw-type "Hardware type" :display-only)
	      (host-software :choose (unix vms))))
  (editlabel "Edit/Verify VAX Host Information"))

(defobedit *vax*)


(defun remake-edit-infer(obj newobj)
  (setq obj (remake-obj obj (oneof newobj)))
  (ask obj (infer))
  (ask obj (edit))
  (ask obj (infer))
  obj)
  
(defun make-lambda(obj)
  (let((hw (ask obj hw-type)))
    (setq obj (remake-edit-infer obj
	    (case hw
	      (lambda *lam1*)
	      (lambda-plus *lam1p*)
	      (lambda-2x2 *lam2*)
	      (lambda-2x2-plus *lam2p*)
;	      (lambda-3x3 *lam3*)
	      (t (ferror nil "invalid Lambda hardware type ~s" hw))))))
  obj)

(defun make-symbolics(obj)
  (print 'symbolics)
  (remake-edit-infer obj (oneof *symbolics-host*)))

(defun make-vax(obj)
  (setq obj (remake-edit-infer obj *vax*))
  (ask obj (edit))
  (case (ask obj system-type)
    (unix (setq obj (remake-edit-infer obj *vax-unix*)))
    (vms  (setq obj (remake-edit-infer obj *vax-vms*))))
  obj)

(defun make-host(&optional hw-type &rest args)
  (let((obj (apply #'oneof *single-host-system* args)))
    (if hw-type
	(ask obj (have 'hw-type hw-type))
	(ask obj (edit)))
    (case (ask obj hw-type)
      (lambda (setq obj (make-lambda obj)))
      (symbolics (setq obj (make-symbolics obj)))
      (vax (setq obj (make-vax obj))))
    obj))