Changeset 15834 in project


Ignore:
Timestamp:
09/12/09 16:42:48 (10 years ago)
Author:
sjamaan
Message:

Separate out the writing of a document in "draft" form

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/estraier-client/estraier-client.scm

    r15833 r15834  
    4444   update-attributes document-attribute document-keywords find-documents
    4545   unregister-user register-admin-user register-guest-user
     46   write-draft ; could be useful by itself
    4647
    4748   master-shutdown master-sync master-backup master-rotate-log
     
    131132               (read-lines in)))))
    132133
     134;; Write out a document in "draft" format to the specified output port.
     135;; If the CONTENTS argument is omitted, only attributes will be written.
     136(define (write-draft outport attributes #!optional contents)
     137  (for-each
     138   (lambda (attrib)
     139     ;; If control commands or the @digest attribute are sent
     140     ;; back, the node will silently ignore the document...
     141     (unless (or (string-prefix? "#" (->string (car attrib)))
     142                 (eq? (car attrib) '@digest))
     143       (fprintf outport "~A=~A\r\n" (car attrib) (cdr attrib))))
     144   attributes)
     145  (when contents
     146    (fprintf outport "\r\n")
     147    ;; What if there's a newline in the text?
     148    (for-each (lambda (line) (fprintf outport "~A\r\n" line)) contents)))
     149
    133150(define (put-document node contents attribs)
    134151  (exec
     
    137154                 headers: (headers '((content-type text/x-estraier-draft))))
    138155   (call-with-output-string ; use string because it wants content-length
    139      (lambda (out)
    140        (for-each
    141         (lambda (attrib)
    142           ;; If control commands or the @digest attribute are sent
    143           ;; back, the node will silently ignore the document...
    144           (unless (or (string-prefix? "#" (->string (car attrib)))
    145                       (eq? (car attrib) '@digest))
    146             (fprintf out "~A=~A\r\n" (car attrib) (cdr attrib))))
    147         attribs)
    148        (fprintf out "\r\n")
    149        ;; What if there's a newline in the text?
    150        (for-each (lambda (line) (fprintf out "~A\r\n" line)) contents)))
     156     (lambda (out) (write-draft out attribs contents)))
    151157   discard-output))
    152158
     
    182188                 headers: (headers '((content-type text/x-estraier-draft))))
    183189   (call-with-output-string ; use string because it wants content-length
    184      (lambda (out)
    185        (for-each
    186         (lambda (attrib)
    187           (fprintf out "~A=~A\r\n" (car attrib) (cdr attrib)))
    188         attribs)))
     190     (lambda (out) (write-draft out attribs)))
    189191   discard-output))
    190192
Note: See TracChangeset for help on using the changeset viewer.