Changeset 2752 in project


Ignore:
Timestamp:
12/21/06 17:33:06 (13 years ago)
Author:
felix winkelmann
Message:

hart and xml-rpc fixes

Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed
  • doc-indices/grovel

    r2432 r2752  
    44|#
    55
    6 
    76(use utils regex-case posix)
    8 
    97
    108(set-sharp-read-syntax!
  • hart/hart.scm

    r2751 r2752  
    1 (use srfi-1 hart-support)
    2 
    3 
    41;;;Hart macros.
    52
  • hart/hart.setup

    r2751 r2752  
    44 'hart
    55 '("hart.scm" "hart-support.so")
    6  '((syntax) (require-at-runtime hart)))
     6 '((syntax) (require-at-runtime hart-support)))
    77
  • wiki/Unit extras

    r2646 r2752  
    813813
    814814
     815==== any?
     816
     817 [procedure] (any? X)
     818
     819Ignores it's argument and always returns {{#t}}. This is actually useful sometimes.
     820
    815821
    816822=== Binary searching
     
    826832searched value is equal to the current item, negative if the searched
    827833value is ''less'' than the current item, and positive otherwise.
     834Returns the index of the found value or {{#f}} otherwise.
    828835
    829836Previous: [[Unit eval]]
  • wiki/faq

    r2178 r2752  
    458458{{make-record-instance}}
    459459{{locative-ref}} {{locative-set!}} {{locative?}} {{locative->object}} {{identity}}
    460 {{cpu-time}} {{error}} {{call/cc}}
     460{{cpu-time}} {{error}} {{call/cc}} {{any?}}
    461461
    462462== Garbage collection
  • wiki/fps

    r2748 r2752  
    6363 (import fps)
    6464
     65The same can be achieved with the {{modules}} egg (note that importing {{fps}} at top-level
     66still clobbers some library functions).
     67
    6568
    6669=== Requirements
  • wiki/syntactic-closures

    r2729 r2752  
    22
    33== syntactic-closures
     4
     5An implementation of {{syntax-rules}} and a hygienic low-level
     6macro system.
    47
    58=== Usage
  • xml-rpc/hello-client.scm

    r2552 r2752  
    44(define hello (srv "hello"))
    55
    6 (print "-> " (hello (:optional (command-line-arguments) "you")))
     6(for-each
     7 (lambda (arg)
     8   (print "-> " (hello arg)) )
     9 (let ((args (command-line-arguments)))
     10   (if (null? args)
     11       '("you")
     12       args) ) )
     13
  • xml-rpc/hello.scm

    r2552 r2752  
    44  (sprintf "Hello, ~A!" var) )
    55
    6 ((http:make-server 4242))
     6((http:make-server 4242) #t)
  • xml-rpc/xml-rpc-client.scm

    r64 r2752  
    1515(define-constant fault-response-code 1)
    1616(define-constant invalid-response-format-code 2)
    17 (define-constant version "1.8")
     17(define-constant version "1.13")
    1818
    1919(define xml-rpc:version
  • xml-rpc/xml-rpc-server-support.scm

    r2572 r2752  
    4646                      (with-input-from-string data (cut SSAX:XML->SXML (current-input-port) '()))
    4747                      data) ] )
    48        (handle-exceptions ex
    49            (write-fault-response ex)
     48       (handle-exceptions ex (write-fault-response ex r)
    5049         (match data
    5150           [(or `(*TOP* (*PI* xml . ,_) (|methodCall| ,mname . ,params))
     
    5958                       [`((params (param ,x) ...))
    6059                        (receive results (call-proc m (map xml-rpc:unmarshall-value x))
    61                           (write-result-response results) ) ]
     60                          (write-result-response results r) ) ]
    6261                       [()
    6362                        (receive results (call-proc m '())
    64                           (write-result-response results) ) ]
     63                          (write-result-response results r) ) ]
    6564                       [r (xml-rpc:error invalid-parameter-format-code "invalid parameter format" r)] )
    66                      (write-undefined-method-response name) ) ) ]
     65                     (write-undefined-method-response name r) ) ) ]
    6766              [r (xml-rpc:error invalid-rpc-format-code "invalid rpc format" r)] ) ]
    6867           [r (xml-rpc:error invalid-rpc-format-code "invalid rpc format" r)] ) ) ) ) ) )
     
    8483(define exn-message (condition-property-accessor 'exn 'message))
    8584
    86 (define (write-response s)
    87   (http:write-response-header)
     85(define (write-response s req)
     86  (http:write-response-header
     87   200 "OK" '() (current-output-port)
     88   (http:request-protocol req) )
    8889  (printf "Content-type: text/xml\r\nContent-length: ~A\r\n\r\n~A"
    8990          (string-length s)
    9091          s) )
    9192
    92 (define (write-fault-response ex)
     93(define (write-fault-response ex req)
    9394  (let ([o (open-output-string)])
    9495    (fprintf o #<<EOF
     
    113114          (exn-message ex)
    114115          (->string ex) ) )
    115     (write-response (get-output-string o)) ) )
     116    (write-response (get-output-string o) req) ) )
    116117
    117 (define (write-undefined-method-response name)
     118(define (write-undefined-method-response name req)
    118119  (write-fault-response
    119    (make-property-condition 'exn 'message (sprintf "undefined method ~S" name)) ) )
     120   (make-property-condition 'exn 'message (sprintf "undefined method ~S" name))
     121   req) )
    120122
    121 (define (write-result-response results)
     123(define (write-result-response results req)
    122124  (let ([o (open-output-string)])
    123125    (display "<?xml version=\"1.0\"?><methodResponse>" o)
     
    129131      (display "</params>" o) )
    130132    (display "</methodResponse>\n" o)
    131     (write-response (get-output-string o) ) ) )
     133    (write-response (get-output-string o) req) ) )
    132134
    133135(define (xml-rpc:method-documentation name . url)
  • xml-rpc/xml-rpc.html

    r2572 r2752  
    1616<h3>Version:</h3>
    1717<ul>
     18<li>1.13
     19Server replies with proper protocol [guess who reported it?]
    1820<li>1.12
    1921Fixed another bug, again reported by Daishi
  • xml-rpc/xml-rpc.setup

    r2572 r2752  
    1414 '("xml-rpc-server.scm" "xml-rpc-server-support.so" "xml-rpc-utils.so")
    1515 '((syntax)
    16    (documentation "xml-rpx.html") (version 1.12)
     16   (documentation "xml-rpx.html") (version 1.13)
    1717   (require-at-runtime xml-rpc-server-support)) )
Note: See TracChangeset for help on using the changeset viewer.