cl-xmpp-cvs

cl-xmpp-cvs@common-lisp.net

104 discussions

[cl-xmpp-cvs] CVS update: public_html/index.html
by eenge＠common-lisp.net 18 Jan '06

18 Jan '06

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp:/tmp/cvs-serv14477 Modified Files: index.html Log Message: fixing broken link to jabber.org Date: Wed Jan 18 09:19:39 2006 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.27 public_html/index.html:1.28 --- public_html/index.html:1.27 Mon Nov 21 13:01:16 2005 +++ public_html/index.html Wed Jan 18 09:19:39 2006 @@ -13,7 +13,7 @@ <p>cl-xmpp is a Common Lisp client implementation of the <a href="http://www.xmpp.org/">XMPP</a> RFCs. These are the -RFCs which <a href="http://jabber.org">Jabber</a> clients and +RFCs which <a href="http://www.jabber.org">Jabber</a> clients and servers use to communicate with eachother (including <a href="http://talk.google.com/">Google Talk</a>). In addition cl-xmpp implements JEPs 0078, 0086, 0030 and 0070 which are

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp.lisp cl-xmpp/cxml.lisp cl-xmpp/result.lisp
by eenge＠common-lisp.net 31 Dec '05

31 Dec '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv23722 Modified Files: cl-xmpp.lisp cxml.lisp result.lisp Log Message: Applying patches from David Lichteblau Adam Thorsen Julian Stecklina Date: Sat Dec 31 21:15:06 2005 Author: eenge Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.23 cl-xmpp/cl-xmpp.lisp:1.24 --- cl-xmpp/cl-xmpp.lisp:1.23 Mon Nov 21 19:58:03 2005 +++ cl-xmpp/cl-xmpp.lisp Sat Dec 31 21:15:06 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.23 2005/11/21 18:58:03 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.24 2005/12/31 20:15:06 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -66,7 +66,8 @@ ;;; or begin-xml-stream you must update that value in cl-xmpp-tls.lisp's ;;; connect-tls to be the same. (defun connect (&key (hostname *default-hostname*) (port *default-port*) - (receive-stanzas t) (begin-xml-stream t) jid-domain-part) + (receive-stanzas t) (begin-xml-stream t) jid-domain-part + (class 'connection)) "Open TCP connection to hostname. By default this will set up the complete XML stream and receive the initial @@ -85,7 +86,7 @@ after you've connected." (let* ((stream (trivial-sockets:open-stream hostname port :element-type '(unsigned-byte 8))) - (connection (make-instance 'connection + (connection (make-instance class :jid-domain-part jid-domain-part :server-stream stream :hostname hostname @@ -158,14 +159,14 @@ (defmethod parse-result ((connection connection) (objects list)) (map 'list #'(lambda (x) (parse-result connection x)) objects)) -(defmethod parse-result ((connection connection) (document dom-impl::document)) +(defmethod parse-result ((connection connection) (document cxml-dom::document)) (let (objects) (dom:map-node-list #'(lambda (node) (push (parse-result connection node) objects)) (dom:child-nodes document)) objects)) -(defmethod parse-result ((connection connection) (attribute dom-impl::attribute)) +(defmethod parse-result ((connection connection) (attribute cxml-dom::attribute)) (let* ((name (ensure-keyword (dom:node-name attribute))) (value (dom:value attribute)) (xml-attribute @@ -173,41 +174,49 @@ :name name :value value :node attribute))) xml-attribute)) -(defmethod parse-result ((connection connection) (node dom-impl::character-data)) +(defmethod parse-result ((connection connection) (node cxml-dom::character-data)) (let* ((name (ensure-keyword (dom:node-name node))) (data (dom:data node)) (xml-element (make-instance 'xml-element :name name :data data :node node))) xml-element)) -(defmethod parse-result ((connection connection) (node dom-impl::node)) +(defmethod parse-result ((connection connection) (node cxml-dom::node)) (let* ((name (ensure-keyword (dom:node-name node))) (xml-element (make-instance 'xml-element :name name :node node))) - (dom:do-node-list (attribute (dom:attributes node)) - (push (parse-result connection attribute) (attributes xml-element))) (dom:do-node-list (child (dom:child-nodes node)) (push (parse-result connection child) (elements xml-element))) xml-element)) +(defmethod parse-result ((connection connection) (node cxml-dom::element)) + (let ((xml-element (call-next-method))) + (dom:do-node-map (attribute (dom:attributes node)) + (push (parse-result connection attribute) (attributes xml-element))) + xml-element)) (defmethod xml-element-to-event ((connection connection) (object xml-element) (name (eql :iq))) - (let ((id (ensure-keyword (value (get-attribute object :id))))) - (if (not (eq (ensure-keyword (value (get-attribute object :type))) :result)) - (make-error (get-element object :error)) - (case id - (:error (make-error (get-element object :error))) - (:roster_1 (make-roster object)) - (:reg2 :registration-successful) - (:unreg_1 :registration-cancellation-successful) - (:change1 :password-changed-succesfully) - (:auth2 :authentication-successful) - (:bind_2 :bind-successful) - (:session_1 :session-initiated) - (t (cond - ((member id '(info1 info2 info3)) - (make-disco-info (get-element object :query))) - ((member id '(items1 items2 items3 items4)) - (make-disco-items (get-element object :query))))))))) + (let ((id (ensure-keyword (value (get-attribute object :id)))) + (type (ensure-keyword (value (get-attribute object :type))))) + (case id + (:error (make-error (get-element object :error))) + (:roster_1 (make-roster object)) + (:reg2 :registration-successful) + (:unreg_1 :registration-cancellation-successful) + (:change1 :password-changed-successfully) + (:auth2 :authentication-successful) + (:bind_2 :bind-successful) + (:session_1 :session-initiated) + (t + (case type + (:get (warn "Don't know how to handle IQ get yet.")) + (t + (cond + ((member id '(info1 info2 info3)) + (make-disco-info (get-element object :query))) + ((member id '(items1 items2 items3 items4)) + (make-disco-items (get-element object :query))) + (t ;; Assuming an error + (make-error (get-element object :error)))))))))) (defmethod xml-element-to-event ((connection connection) (object xml-element) (name (eql :error))) @@ -270,6 +279,8 @@ :xml-element object :from (value (get-attribute object :from)) :to (value (get-attribute object :to)) + :id (value (get-attribute object :id)) + :type (value (get-attribute object :type)) :body (data (get-element (get-element object :body) :\#text)))) ;; @@ -305,13 +316,13 @@ (defun read-stanza (connection) (unless (server-xstream connection) (setf (server-xstream connection) - (cxml:make-xstream (server-stream connection)))) + (cxml:make-xstream (make-slow-stream (server-stream connection))))) (force-output (server-stream connection)) (catch 'stanza - (let ((cxml::*default-namespace-bindings* - (acons "stream" - "http://etherx.jabber.org/streams" - cxml::*default-namespace-bindings*))) + (let ((cxml::*namespace-bindings* + (acons #"stream" + #"http://etherx.jabber.org/streams" + cxml::*namespace-bindings*))) (cxml::parse-xstream (server-xstream connection) (make-instance 'stanza-handler)) (runes::write-xstream-buffer (server-xstream connection))))) @@ -378,7 +389,7 @@ (defmacro with-iq-query ((connection &key xmlns id to node (type "get")) &body body) "Macro to make it easier to write QUERYs." - `(with-iq (connection :id ,id :type ,type :to ,to) + `(with-iq (,connection :id ,id :type ,type :to ,to) (cxml:with-element "query" (cxml:attribute "xmlns" ,xmlns) (when ,node @@ -476,10 +487,12 @@ (when to (cxml:attribute "to" to))))) -(defmethod message ((connection connection) to body) +(defmethod message ((connection connection) to body &key id (type :chat)) (with-xml-output (connection) (cxml:with-element "message" (cxml:attribute "to" to) + (when id (cxml:attribute "id" id)) + (when type (cxml:attribute "type" (string-downcase (string type)))) (cxml:with-element "body" (cxml:text body))))) (defmethod bind ((connection connection) resource) Index: cl-xmpp/cxml.lisp diff -u cl-xmpp/cxml.lisp:1.9 cl-xmpp/cxml.lisp:1.10 --- cl-xmpp/cxml.lisp:1.9 Sat Nov 19 00:14:35 2005 +++ cl-xmpp/cxml.lisp Sat Dec 31 21:15:06 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cxml.lisp,v 1.9 2005/11/18 23:14:35 eenge Exp $ +;;;; $Id: cxml.lisp,v 1.10 2005/12/31 20:15:06 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cxml.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -11,7 +11,7 @@ :accessor depth))) (defun start-sax-document (handler) - (let ((dom-builder (dom:make-dom-builder))) + (let ((dom-builder (cxml-dom:make-dom-builder))) (setf (cxml:proxy-chained-handler handler) dom-builder) (sax:start-document dom-builder) dom-builder)) @@ -22,7 +22,7 @@ (if (eq :stream\:stream (ensure-keyword qname)) ;; Create an element for DOM-TO-EVENT so we don't have to have ;; any specialized code just to handle stream:stream. - (let* ((document (dom:create-document)) + (let* ((document (cxml-dom:create-document)) (element (dom:create-element document qname))) (dom:append-child document element) (dolist (attribute attrs) @@ -45,37 +45,26 @@ (call-next-method) (when (eql (depth handler) 0) (throw 'stanza - (dom-impl::document (cxml:proxy-chained-handler handler))))) + (cxml-dom::document (cxml:proxy-chained-handler handler))))) -;;; The default implementation of this function in CXML does not -;;; check whether or not the nodelist is NIL and dom:length et al -;;; assumes it will be a vector. This will result in problems -;;; because I wanted to use this with return value of DOM:ATTRIBUTES -;;; which may be NIL. David Lichteblau said a specialized map -;;; function for namednodelists (which is what the return value of -;;; DOM:ATTRIBUTES) is could be added he just hadn't needed one -;;; yet. So, if you want to you can write one and send him a -;;; patch. -(defun dom:map-node-list (fn nodelist) - (when nodelist - (dotimes (i (dom:length nodelist)) - (funcall fn (dom:item nodelist i))))) - -;;; XXX: because of READ-SEQUENCE's blocking on the stream -;;; (in RUNES::READ-OCTETS) we do not call SET-TO-FULL-SPEED -;;; so that we avoid the CXML buffering layer. I think perhaps -;;; this would work if READ-N-BYTES worked properly but I -;;; don't really know at this point. -;;; -;;; Should probably email the SBCL list about this. -(defun cxml::set-full-speed (input) - (declare (ignore input)) - nil) +;;; Perform single-byte reads to avoid blocking on the socket. +(defstruct (slow-stream (:constructor make-slow-stream (target))) + (target nil :type stream)) + +(defmethod runes::figure-encoding ((stream slow-stream)) + (runes::figure-encoding (slow-stream-target stream))) + +(defmethod runes::read-octets (seq (stream slow-stream) start end) + (when (< start end) + (let ((byte (read-byte (slow-stream-target stream) nil))) + (when byte + (setf (elt seq start) byte) + (incf start)))) + start) ;; I'd like to see what CXML is reading from the stream ;; and this code helps us in that regard by printing it ;; to the *debug-stream* - (defun runes::write-xstream-buffer (xstream &optional (stream *debug-stream*)) (when stream (write-string (map 'string @@ -86,49 +75,5 @@ stream) (force-output stream))) -(defun runes::xstream-underflow (input) - (declare (type runes::xstream input)) - ;; we are about to fill new data into the buffer, so we need to - ;; adjust buffer-start. - (runes::write-xstream-buffer input) - (incf (runes::xstream-buffer-start input) - (- (runes::xstream-fill-ptr input) 0)) - (let (n m) - ;; when there is something left in the os-buffer, we move it to - ;; the start of the buffer. - (setf m (- (runes::xstream-os-left-end input) (runes::xstream-os-left-start input))) - (unless (zerop m) - (replace (runes::xstream-os-buffer input) (runes::xstream-os-buffer input) - :start1 0 :end1 m - :start2 (runes::xstream-os-left-start input) - :end2 (runes::xstream-os-left-end input)) - ;; then we take care that the buffer is large enough to carry at - ;; least 100 bytes (a random number) - (unless (>= (length (runes::xstream-os-buffer input)) 100) - (error "You lost") - ;; todo: enlarge buffer - )) - (setf n - (runes::read-octets (runes::xstream-os-buffer input) (runes::xstream-os-stream input) - m (min (1- (length (runes::xstream-os-buffer input))) - (+ m (runes::xstream-speed input))))) - (cond ((runes::%= n 0) - (setf (runes::xstream-read-ptr input) 0 - (runes::xstream-fill-ptr input) n) - (setf (aref (runes::xstream-buffer input) - (runes::xstream-fill-ptr input)) runes::+end+) - :eof) - (t - (multiple-value-bind (fnw fnr) - (encoding:decode-sequence - (runes::xstream-encoding input) - (runes::xstream-os-buffer input) 0 n - (runes::xstream-buffer input) 0 (1- (length (runes::xstream-buffer input))) - (= n m)) - (setf (runes::xstream-os-left-start input) fnr - (runes::xstream-os-left-end input) n - (runes::xstream-read-ptr input) 0 - (runes::xstream-fill-ptr input) fnw) - (setf (aref (runes::xstream-buffer input) - (runes::xstream-fill-ptr input)) runes::+end+) - (runes:read-rune input)))))) +(defmethod runes::xstream-underflow :before ((input runes:xstream)) + (runes::write-xstream-buffer input)) \ No newline at end of file Index: cl-xmpp/result.lisp diff -u cl-xmpp/result.lisp:1.12 cl-xmpp/result.lisp:1.13 --- cl-xmpp/result.lisp:1.12 Thu Nov 17 22:51:16 2005 +++ cl-xmpp/result.lisp Sat Dec 31 21:15:06 2005 @@ -1,4 +1,4 @@ -;;;; $Id: result.lisp,v 1.12 2005/11/17 21:51:16 eenge Exp $ +;;;; $Id: result.lisp,v 1.13 2005/12/31 20:15:06 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/result.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -125,12 +125,24 @@ (body :accessor body :initarg :body - :initform ""))) + :initform "") + (id + :accessor id + :initarg :id + :initform nil) + (type + :accessor type- + :initarg :type + :initform nil))) (defmethod print-object ((object message) stream) "Print the object for the Lisp reader." (print-unreadable-object (object stream :type t :identity t) - (format stream "to:~a from:~a" (to object) (from object)))) + (format stream "to:~a from:~a id:~a type:~a" + (to object) + (from object) + (id object) + (type- object)))) (defclass presence (event) ((to

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/test/cl-xmpp-test.asd
by eenge＠common-lisp.net 14 Dec '05

14 Dec '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp/test In directory common-lisp.net:/tmp/cvs-serv13432/test Modified Files: cl-xmpp-test.asd Log Message: adding a test-op on cl-xmpp to run do-tests from cl-xmpp-test Date: Wed Dec 14 20:04:08 2005 Author: eenge Index: cl-xmpp/test/cl-xmpp-test.asd diff -u cl-xmpp/test/cl-xmpp-test.asd:1.3 cl-xmpp/test/cl-xmpp-test.asd:1.4 --- cl-xmpp/test/cl-xmpp-test.asd:1.3 Mon Nov 21 19:58:04 2005 +++ cl-xmpp/test/cl-xmpp-test.asd Wed Dec 14 20:04:07 2005 @@ -1,5 +1,5 @@ -;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp-test.asd,v 1.3 2005/11/21 18:58:04 eenge Exp $ +-;;;; -*- mode: lisp -*- +;;;; $Id: cl-xmpp-test.asd,v 1.4 2005/12/14 19:04:07 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/test/cl-xmpp-test.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -25,3 +25,5 @@ (:file "cl-xmpp-test" :depends-on ("package")))) +(defmethod perform ((operation test-op) (component (eql (find-system 'cl-xmpp-test)))) + (cl-xmpp-test:do-tests))

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp.asd
by eenge＠common-lisp.net 14 Dec '05

14 Dec '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv13432 Modified Files: cl-xmpp.asd Log Message: adding a test-op on cl-xmpp to run do-tests from cl-xmpp-test Date: Wed Dec 14 20:03:49 2005 Author: eenge Index: cl-xmpp/cl-xmpp.asd diff -u cl-xmpp/cl-xmpp.asd:1.6 cl-xmpp/cl-xmpp.asd:1.7 --- cl-xmpp/cl-xmpp.asd:1.6 Sun Nov 13 03:36:10 2005 +++ cl-xmpp/cl-xmpp.asd Wed Dec 14 20:03:48 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp.asd,v 1.6 2005/11/13 02:36:10 eenge Exp $ +;;;; $Id: cl-xmpp.asd,v 1.7 2005/12/14 19:03:48 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -28,4 +28,8 @@ :depends-on ("cxml")) (:file "cl-xmpp" :depends-on ("result")))) + +(defmethod perform ((operation test-op) (component (eql (find-system 'cl-xmpp)))) + (operate 'load-op 'cl-xmpp-test) + (operate 'test-op 'cl-xmpp-test :force t))

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp-tls.lisp
by eenge＠common-lisp.net 28 Nov '05

28 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv3568 Modified Files: cl-xmpp-tls.lisp Log Message: patch from david lichteblau Date: Mon Nov 28 16:15:46 2005 Author: eenge Index: cl-xmpp/cl-xmpp-tls.lisp diff -u cl-xmpp/cl-xmpp-tls.lisp:1.7 cl-xmpp/cl-xmpp-tls.lisp:1.8 --- cl-xmpp/cl-xmpp-tls.lisp:1.7 Thu Nov 17 21:56:38 2005 +++ cl-xmpp/cl-xmpp-tls.lisp Mon Nov 28 16:15:46 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp-tls.lisp,v 1.7 2005/11/17 20:56:38 eenge Exp $ +;;;; $Id: cl-xmpp-tls.lisp,v 1.8 2005/11/28 15:15:46 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -46,7 +46,8 @@ Turn off sending XML stream start with :begin-xml-stream nil." (setf (server-stream connection) - (cl+ssl:make-ssl-client-stream (server-stream connection))) + (cl+ssl:make-ssl-client-stream (server-stream connection) + :external-format :iso-8859-1)) (setf (server-xstream connection) nil) (when begin-xml-stream (begin-xml-stream connection))

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/README
by eenge＠common-lisp.net 28 Nov '05

28 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv3006 Modified Files: README Log Message: patch from david lichteblau Date: Mon Nov 28 16:15:03 2005 Author: eenge Index: cl-xmpp/README diff -u cl-xmpp/README:1.10 cl-xmpp/README:1.11 --- cl-xmpp/README:1.10 Fri Nov 18 23:35:50 2005 +++ cl-xmpp/README Mon Nov 28 16:15:03 2005 @@ -14,7 +14,7 @@ ;; (defvar *connection* (xmpp:connect-tls :hostname "talk.google.com" :jid-domain-part "gmail.com")) - * (xmpp:auth connection "password" "resource") + * (xmpp:auth connection "username" "password" "resource") ;; or pass :mechanism :sasl-plain, :digest-md5 or sasl-digest-md5 ;; if you loaded cl-xmpp-sasl or cl-xmpp-tls.

1 0

[cl-xmpp-cvs] CVS update: public_html/index.html
by eenge＠common-lisp.net 21 Nov '05

21 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv13483 Modified Files: index.html Log Message: 0.7.1 Date: Mon Nov 21 20:01:16 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.26 public_html/index.html:1.27 --- public_html/index.html:1.26 Mon Nov 21 20:00:34 2005 +++ public_html/index.html Mon Nov 21 20:01:16 2005 @@ -33,7 +33,7 @@ <h2>News</h2> <div class="level"> <ul> - <li>Version 0.7.1 released (Bugfixes)</li> + <li><em>2005-11-21</em>: Version 0.7.1 released (Bugfixes)</li> <li>Version 0.7.0 released (TLS support)</li> <li>Version 0.6.0 released (SASL support, tiny test suite and many small fixes and tweaks)</li> <li>Version 0.5.0 released (Now depending on <a href="http://cliki.net/ironclad">Ironclad</a> for digest authentication)</li>

1 0

[cl-xmpp-cvs] CVS update: public_html/index.html
by eenge＠common-lisp.net 21 Nov '05

21 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv12992 Modified Files: index.html Log Message: 0.7.1 Date: Mon Nov 21 20:00:34 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.25 public_html/index.html:1.26 --- public_html/index.html:1.25 Fri Nov 18 23:39:55 2005 +++ public_html/index.html Mon Nov 21 20:00:34 2005 @@ -7,7 +7,7 @@ <body> <div class="header"> - <h1>cl-xmpp 0.7.0</h1> + <h1>cl-xmpp 0.7.1</h1> </div> <div class="body"> @@ -33,6 +33,7 @@ <h2>News</h2> <div class="level"> <ul> + <li>Version 0.7.1 released (Bugfixes)</li> <li>Version 0.7.0 released (TLS support)</li> <li>Version 0.6.0 released (SASL support, tiny test suite and many small fixes and tweaks)</li> <li>Version 0.5.0 released (Now depending on <a href="http://cliki.net/ironclad">Ironclad</a> for digest authentication)</li>

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp.lisp
by eenge＠common-lisp.net 21 Nov '05

21 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv12420 Modified Files: cl-xmpp.lisp Log Message: making my own with-xml-output and fixing a few small bugs Date: Mon Nov 21 19:58:03 2005 Author: eenge Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.22 cl-xmpp/cl-xmpp.lisp:1.23 --- cl-xmpp/cl-xmpp.lisp:1.22 Fri Nov 18 23:53:02 2005 +++ cl-xmpp/cl-xmpp.lisp Mon Nov 21 19:58:03 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.22 2005/11/18 22:53:02 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.23 2005/11/21 18:58:03 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -353,24 +353,28 @@ (with-xml-stream (stream connection) (xml-output stream "</stream:stream>"))) -(defmacro with-iq ((connection &key id to (type "get")) &body body) - "Macro to make it easier to write IQ stanzas." - (let ((stream (gensym "stream")) - (xml (gensym "xml"))) +(defmacro with-xml-output ((connection) &body body) + (let ((xml (gensym "xml")) + (stream (gensym "stream"))) `(let ((,stream (server-stream ,connection))) (prog1 (let ((,xml (cxml:with-xml-output (cxml:make-octet-vector-sink) - (cxml:with-element "iq" - (when ,id - (cxml:attribute "id" ,id)) - (when ,to - (cxml:attribute "to" ,to)) - (cxml:attribute "type" ,type) - ,@body)))) + ,@body))) (write-sequence (vector-to-array ,xml) ,stream) - (when *debug-stream* - (write-sequence (map 'string #'code-char ,xml) *debug-stream*))) - (force-output ,stream))))) + (when *debug-stream* + (write-sequence (map 'string #'code-char ,xml) *debug-stream*))) + (force-output ,stream))))) + +(defmacro with-iq ((connection &key id to (type "get")) &body body) + "Macro to make it easier to write IQ stanzas." + `(with-xml-output (,connection) + (cxml:with-element "iq" + (when ,id + (cxml:attribute "id" ,id)) + (when ,to + (cxml:attribute "to" ,to)) + (cxml:attribute "type" ,type) + ,@body))) (defmacro with-iq-query ((connection &key xmlns id to node (type "get")) &body body) "Macro to make it easier to write QUERYs." @@ -465,22 +469,18 @@ (add-auth-method :digest-md5 '%digest-md5-auth%) (defmethod presence ((connection connection) &key type to) - (cxml:with-xml-output (make-octet+character-debug-stream-sink - (server-stream connection)) + (with-xml-output (connection) (cxml:with-element "presence" (when type (cxml:attribute "type" type)) (when to - (cxml:attribute "to" to)))) - connection) + (cxml:attribute "to" to))))) (defmethod message ((connection connection) to body) - (cxml:with-xml-output (make-octet+character-debug-stream-sink - (server-stream connection)) + (with-xml-output (connection) (cxml:with-element "message" (cxml:attribute "to" to) - (cxml:with-element "body" (cxml:text body)))) - connection) + (cxml:with-element "body" (cxml:text body))))) (defmethod bind ((connection connection) resource) (with-iq (connection :id "bind_2" :type "set")

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/test/cl-xmpp-test.asd
by eenge＠common-lisp.net 21 Nov '05

21 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp/test In directory common-lisp.net:/tmp/cvs-serv12420/test Modified Files: cl-xmpp-test.asd Log Message: making my own with-xml-output and fixing a few small bugs Date: Mon Nov 21 19:58:04 2005 Author: eenge Index: cl-xmpp/test/cl-xmpp-test.asd diff -u cl-xmpp/test/cl-xmpp-test.asd:1.2 cl-xmpp/test/cl-xmpp-test.asd:1.3 --- cl-xmpp/test/cl-xmpp-test.asd:1.2 Sun Nov 13 03:55:47 2005 +++ cl-xmpp/test/cl-xmpp-test.asd Mon Nov 21 19:58:04 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp-test.asd,v 1.2 2005/11/13 02:55:47 eenge Exp $ +;;;; $Id: cl-xmpp-test.asd,v 1.3 2005/11/21 18:58:04 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/test/cl-xmpp-test.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -21,7 +21,7 @@ (:file "utility-test" :depends-on ("package")) (:file "result-test" - :depends-on ("package")))) + :depends-on ("package")) (:file "cl-xmpp-test" - :depends-on ("package")))) + :depends-on ("package"))))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cl-xmpp-cvs