[noctool-cvs] CVS source

[imattsson]

Update of /project/noctool/cvsroot/source
In directory clnet:/tmp/cvs-serv3321

Added Files:
	network-remote-calls.lisp 
Log Message:
IM

Oops, this didn't get checked in.



--- /project/noctool/cvsroot/source/network-remote-calls.lisp	2008/07/07 15:11:35	NONE
+++ /project/noctool/cvsroot/source/network-remote-calls.lisp	2008/07/07 15:11:35	1.1
(in-package :noctool-network)

(defun list-class (peer-designator class-designator)
  (let ((peer (if (stringp peer-designator)
		  (find-peer peer-designator)
		  peer-designator)))
    (let ((key (cons peer :list-class)))
      (multiple-value-bind (val exists)
	  (gethash key *reply-structure*)
	(identity val)
	(cond (exists (sleep 0.1) (list-class peer class-designator))
	      (t (setf (gethash key *reply-structure*) nil)
		 (send peer "(request-proxy-class ~a)" class-designator)
		 (loop until (gethash key *reply-structure*)
		       do (sleep 1))
		 (prog1
		     (gethash key *reply-structure*)
		   (remhash key *reply-structure*))))))))

(defun subscribe (id peer type)
  (let ((item nil)) 
    (when (eql type :equipment)
      (let ((stuff (get-proxy (conn peer) id)))
	(when (null stuff)
	  (let ((key (cons peer :proxy-equipment)))
	    (setf (gethash key *reply-structure*) nil)
	    (send peer "(request-proxy-equipment ~a)" id)
	    (loop until (gethash key *reply-structure*)
		  do (sleep 1))))
	(setf item (object (get-proxy (conn peer) id)))
	(push item *equipment*)))
    (when (eql type :graph)
      (let ((stuff (get-proxy (conn peer) id)))
	(when (null stuff)
	  (let ((key (cons peer :proxy-graph)))
	    (setf (gethash key *reply-structure*) nil)
	    (send peer "(request-proxy-graph ~a)" id)
	    (loop until (gethash key *reply-structure*)
		  do (sleep 1))))
	(setf item (object (get-proxy (conn peer) id)))))
    item))

(defun graph-update (proxy id value)
  (send (peer proxy) "(graph-update (id ~a) (measure ~a))" id value))

(defgeneric unsubscribe (thing &optional conn))

(defmethod unsubscribe ((proxy noctool::proxy) &optional conn)
  (declare (ignore conn))
  (unsubscribe (object proxy) (peer proxy)))

(defmethod unsubscribe ((e noctool::equipment) &optional conn)
  (when conn
    (send conn "(delete-proxy-equipment ~a)" (id e))))

(defmethod unsubscribe ((g noctool-graphs::base-graph) &optional conn)
  (when conn
    (send conn "(delete-proxy-graph ~a)" (id g))))