COM-CLASS metaobjects

I’ve updated Doors this morning.

COM-CLASS metaobjects are now COM-OBJECTs themselves, meaning that you can acquire their interfaces and so on.

Therefore, an example described in the previous post could be simplified to this:

(define-interface hello-world
       #xF9210244 #x38D1 #x49C0
       #xA8 #x48 #x68 #x4E #xDD #x3D #xBF #xF0)
  (hello-world (hresult)
      (string (& wstring) :optional "Hello, world!")))

(define-guid clsid-hello-world
  #xDF748DA7 #xBCB9 #x4F67
  #x8D #x32 #xF9 #xAA #x1A #xAA #x3A #xBF)

(defclass hello-world-object (com-object)
  (:metaclass com-class)
  (:clsid . clsid-hello-world))

(defmethod hello-world ((object hello-world-object)
                        &optional (string "Hello, world!"))
  (write-line string)
  (values nil string))

(defmethod lock-server ((class (eql (find-class 'hello-world-object))) lock)
  (if lock
    (add-ref class)
    (release class))
  (values nil lock))

(defmethod create-instance
    ((class (eql (find-class 'hello-world-object))) iid &optional outer)
  (if outer
    (error 'com-error :code error-not-implemented)
      (unless (member (class-name iid)
                      '(unknown hello-world))
        (error 'com-error :code error-no-interface))
      (let ((object (make-instance class)))
        (values nil outer iid (acquire-interface object iid))))))

(defun register-server ()
    ((windows-status #'muffle-warning))
  (register-class-object 'hello-world-object :server :multiple-use))

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: