Export XML-RPC interface for use by other programs.

diff --git a/v7/src/ssp/ssp.pkg b/v7/src/ssp/ssp.pkg
index c23fe4d0c358fab6cec0e19ab738ca37e2cfbf30..6aef619ac6187cf7116044e26f6f4bdb24958db1 100644 (file)
--- a/v7/src/ssp/ssp.pkg
+++ b/v7/src/ssp/ssp.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: ssp.pkg,v 1.17 2004/11/26 15:14:23 cph Exp $
+$Id: ssp.pkg,v 1.18 2005/02/05 03:44:03 cph Exp $
 
-Copyright 2003,2004 Massachusetts Institute of Technology
+Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -121,43 +121,9 @@ USA.
 (define-package (runtime ssp xml-rpc)
   (files "xmlrpc")
   (parent (runtime ssp))
-  (export (runtime ssp)
-         rpc-elt:array
-         rpc-elt:base64
-         rpc-elt:boolean
-         rpc-elt:data
-         rpc-elt:date-time
-         rpc-elt:double
-         rpc-elt:fault
-         rpc-elt:i4
-         rpc-elt:int
-         rpc-elt:member
-         rpc-elt:method-call
-         rpc-elt:method-name
-         rpc-elt:method-response
-         rpc-elt:name
-         rpc-elt:param
-         rpc-elt:params
-         rpc-elt:string
-         rpc-elt:struct
-         rpc-elt:value)
-  (export (runtime ssp-expander-environment)
-         rpc-elt:array
-         rpc-elt:base64
-         rpc-elt:boolean
-         rpc-elt:data
-         rpc-elt:date-time
-         rpc-elt:double
-         rpc-elt:fault
-         rpc-elt:i4
-         rpc-elt:int
-         rpc-elt:member
-         rpc-elt:method-call
-         rpc-elt:method-name
-         rpc-elt:method-response
-         rpc-elt:name
-         rpc-elt:param
-         rpc-elt:params
-         rpc-elt:string
-         rpc-elt:struct
-         rpc-elt:value))
\ No newline at end of file
+  (export ()
+         xml-rpc:condition-fault
+         xml-rpc:fault
+         xml-rpc:parse-request
+         xml-rpc:response
+         xml-rpc:simple-fault))
\ No newline at end of file

diff --git a/v7/src/ssp/xmlrpc.scm b/v7/src/ssp/xmlrpc.scm
index 6477a7b602a41f5e3d58807ea1aa4fd6c6f2f90d..78b89a9b16a744f801744287e31c145b34b60c11 100644 (file)
--- a/v7/src/ssp/xmlrpc.scm
+++ b/v7/src/ssp/xmlrpc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xmlrpc.scm,v 1.6 2005/01/11 03:43:46 cph Exp $
+$Id: xmlrpc.scm,v 1.7 2005/02/05 03:44:10 cph Exp $
 
 Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
@@ -74,19 +74,24 @@ USA.
     (rpc-elt:param
      (rpc-elt:value (xml-rpc:encode-object object))))))
 
-(define (xml-rpc:fault code message . irritants)
-  (let ((message
-        (call-with-output-string
-         (lambda (port)
-           (format-error-message message irritants port)))))
-    (rpc-elt:method-response
-     (rpc-elt:fault
-      (rpc-elt:value
-       (rpc-elt:struct
-       (rpc-elt:member (rpc-elt:name "faultCode")
-                       (rpc-elt:value (rpc-elt:int (number->string code))))
-       (rpc-elt:member (rpc-elt:name "faultString")
-                       (rpc-elt:value (rpc-elt:string message)))))))))
+(define (xml-rpc:fault code string)
+  (rpc-elt:method-response
+   (rpc-elt:fault
+    (rpc-elt:value
+     (rpc-elt:struct
+      (rpc-elt:member (rpc-elt:name "faultCode")
+                     (rpc-elt:value (rpc-elt:int (number->string code))))
+      (rpc-elt:member (rpc-elt:name "faultString")
+                     (rpc-elt:value (rpc-elt:string string))))))))
+
+(define (xml-rpc:simple-fault code message . irritants)
+  (xml-rpc:fault code
+                (call-with-output-string
+                 (lambda (port)
+                   (format-error-message message irritants port)))))
+
+(define (xml-rpc:condition-fault code condition)
+  (xml-rpc:fault code (condition/report-string condition)))
 \f
 (define (xml-rpc:parse-request document)
   (let ((elt (xml-document-root document))