I'm playing with OpenMCL's Objective C support and OS X's Rendezvous.
I can advertise services, but I think I need to figure out some things about Run Loops before I can get the rest of this to work.
(require :objc-support)
(defmacro with-nsstrs (init-forms &body body)
"Establishes a lexical context with a bunch of stack allocated
NSConstantStrings."
(flet ((gen (s) #'(lambda (sym)
(declare (ignore sym))
(gensym s))))
(let ((cstr-vars (mapcar (gen "CSTR") init-forms))
(string-vars (mapcar (gen "STRING") init-forms)))
`(let ,(mapcar #'(lambda (init-form sv)
`(,sv ,(second init-form)))
init-forms string-vars)
(with-cstrs ,(mapcar #'(lambda (cv sv)
`(,cv ,sv))
cstr-vars string-vars)
(rlet
,(mapcar
#'(lambda (init-form cstr-var string-var)
`(,(first init-form) :<NSC>onstant<S>tring
:isa ccl::*NSConstantString-class*
:bytes ,cstr-var
:num<B>ytes (length ,string-var)))
init-forms cstr-vars string-vars)
,@body))))))
(defmacro @@ (string)
"Creates a persistent, interned NSConstantString."
`(ccl::objc-constant-string-nsstringptr
(ccl::ns-constant-string ,string)))
(defun advertise-service (domain type name port &key properties)
"Publishes the availability of a service via Rendezvous.
The DOMAIN argument must be a string containing the domain name of
the machine hosting the service (pass nil for localhost). The TYPE
argument is a string specifying the type of service being
advertised (e.g., \"_http._tcp\" or \"_daap._tcp\"). NAME is a
string naming the service. PORT is the port associated with the
service. The PROPERTIES argument, if given, should be a property
list containing additional service-specific information that will
be part of the published information about the service. For
example, ((\"path\" \"~/guest/\") (\"screenname\" \"clowny\")).
This function returns a macptr that points to the Cocoa
NetService instance representing the advertised service."
(let ((net-service (ccl::make-objc-instance 'ns-net-service)))
(with-nsstrs ((nsdomain (or domain ""))
(nstype type)
(nsname name))
(ccl::send net-service
:init-with-domain nsdomain
:type nstype
:name nsname
:port port))
#| Something is going wrong here.
(ccl::send net-service
:schedule-in-run-loop
(ccl::send (ccl::@class ns-run-loop) 'current-Run-Loop)
:for-mode (@@ "kCFRunLoopDefaultMode"))
|#
(when properties
;; Hm, kind of odd that we have to use a constant NSString
;; here... (it fails if we use a stack-allocated one).
(ccl::send net-service :set-protocol-specific-information
(@@ (build-text-record properties))))
(ccl::send net-service :set-delegate
(ccl::make-objc-instance 'net-service-delegate))
(ccl::send net-service 'publish)
net-service))
;; Sadly, this doesn't seem to work.
(defun cancel-service (service)
"Stops advertising a service.
SERVICE must be a macptr returned by ADVERTISE-SERVICE."
(ccl::send service 'stop))
(defparameter *record-separator* (code-char 1))
(defun build-text-record (properties)
(reduce
#'(lambda (p1 p2)
(format nil "~A~A~A" p1 *record-separator* p2))
(mapcar #'(lambda (property)
(format nil "~A=~A" (first property) (second property)))
properties)))
;; Here we define an Objective C class that acts as the callback
;; handler for NetService.
(ccl::def-objc-class net-service-delegate ns-object)
(ccl::define-objc-method ((:void :net-service sender
:did-not-publish error-dict)
net-service-delegate)
(format T "~&Did not publish service."))
(ccl::define-objc-method ((:void :net-service-did-stop sender)
net-service-delegate)
(format T "~&Did stop service."))
(ccl::define-objc-method ((:void :net-service-will-publish sender)
net-service-delegate)
(format T "~&Will publish service."))
Posted by jjwiseman at January 22, 2004 07:29 AM