Update of /cvsroot/emacs-jabber/emacs-jabber
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv12519
Modified Files:
jabber-conn.el jabber-core.el
Log Message:
Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-529
Creator: Magnus Henoch <ma...@fr...>
Implement `virtual' connection type, for introspective testing
Index: jabber-core.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-core.el,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -d -r1.90 -r1.91
--- jabber-core.el 30 May 2008 20:43:29 -0000 1.90
+++ jabber-core.el 17 Jun 2008 14:47:01 -0000 1.91
@@ -313,16 +313,17 @@
(:connected
(let ((connection (cadr event))
(registerp (plist-get state-data :registerp)))
-
- ;; TLS connections leave data in the process buffer, which
- ;; the XML parser will choke on.
- (with-current-buffer (process-buffer connection)
- (erase-buffer))
(setq state-data (plist-put state-data :connection connection))
- (set-process-filter connection (fsm-make-filter fsm))
- (set-process-sentinel connection (fsm-make-sentinel fsm))
+ (when (processp connection)
+ ;; TLS connections leave data in the process buffer, which
+ ;; the XML parser will choke on.
+ (with-current-buffer (process-buffer connection)
+ (erase-buffer))
+
+ (set-process-filter connection (fsm-make-filter fsm))
+ (set-process-sentinel connection (fsm-make-sentinel fsm)))
(list :connected state-data)))
@@ -990,8 +991,8 @@
"")
">
")))
- (jabber-send-string jc stream-header)
- (jabber-log-xml jc "sending" stream-header)))
+ (jabber-log-xml jc "sending" stream-header)
+ (jabber-send-string jc stream-header)))
(defun jabber-send-string (jc string)
"Send STRING to the connection JC."
Index: jabber-conn.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-conn.el,v
retrieving revision 2.14
retrieving revision 2.15
diff -u -d -r2.14 -r2.15
--- jabber-conn.el 17 Jun 2008 14:45:36 -0000 2.14
+++ jabber-conn.el 17 Jun 2008 14:47:01 -0000 2.15
@@ -75,7 +75,8 @@
(defvar jabber-connect-methods
'((network jabber-network-connect jabber-network-send)
(starttls jabber-starttls-connect jabber-ssl-send)
- (ssl jabber-ssl-connect jabber-ssl-send))
+ (ssl jabber-ssl-connect jabber-ssl-send)
+ (virtual jabber-virtual-connect jabber-virtual-send))
"Alist of connection methods and functions.
First item is the symbol naming the method.
Second item is the connect function.
@@ -229,5 +230,22 @@
((eq (car xml-data) 'failure)
nil)))
+(defvar *jabber-virtual-server-function* nil
+ "Function to use for sending stanzas on a virtual connection.
+The function should accept two arguments, the connection object
+and a string that the connection wants to send.")
+
+(defun jabber-virtual-connect (fsm server network-server port)
+ "Connect to a virtual \"server\".
+Use `*jabber-virtual-server-function*' as send function."
+ (unless (functionp *jabber-virtual-server-function*)
+ (error "No virtual server function specified"))
+ ;; We pass the fsm itself as "connection object", as that is what a
+ ;; virtual server needs to send stanzas.
+ (fsm-send fsm (list :connected fsm)))
+
+(defun jabber-virtual-send (connection string)
+ (funcall *jabber-virtual-server-function* connection string))
+
(provide 'jabber-conn)
;; arch-tag: f95ec240-8cd3-11d9-9dbf-000a95c2fcd0
|
