MailboxView

A mailbox implemented in Scheme.

mail

(let ((obj (fetch (me (current-node))))) (if (node-list-empty? obj) (literal "no subject") (select-elements (children obj) 'subject)))
(let ((from (or (string->number (data ((sxpath '(from) (current-node))))) 1)) (to (or (string->number (data ((sxpath '(to) (current-node))))) (string->number (data (xsl-variable "sequence")))))) (make element gi: 'messages (node-list-map (lambda (node) (let ((msgno (string->number (attribute-string "number" node)))) (if (and (>= msgno from) (< msgno to)) (make element gi: message attributes: (copy-attributes node) (children node) (fetch (attributes-string 'id node))) (empty-node-list)))) ((sxpath '(messages *)) (xsl-variable "model"))))) (let* ((msgs ((sxpath '(messages *)) (xsl-variable "model"))) (nmsgs (node-list-length msgs))) (make element gi: 'messages msgs (make element gi: 'message attributes: `((id ,(data (xsl-variable "sequence"))) (number (+ 1 nmsgs))) (make element gi: 'flags (make element gi: 'flag attributes: '((value "\\Recent")))) (make element gi: 'date (literal (date->string (msg 'dc-date) "~4"))) (make element gi: 'size (literal (msg 'content-length)))))) (node-list-filter (lambda (x) (not (equal? "\\Deleted" ((sxpath '(flags flag @ value)) x)))) ((sxpath '(messages *) (xsl-variable "model"))))

Source code:

<!--

The commands are taken from the imap rfc 2060.
(Mostly only commands in the "selected state" apply.  This is only a
single mailbox, not an imap server.)

Commands: 'status', 'append', 'check' (impl. delayed), 'expunge',
'search' (impl. restricted), 'fetch' (impl. restricted), 'store',
'copy' (sends 'append' commands to the destination malibox), 'uid'.

For imap url's see rfc 2192.

Character encodings remarks of rfc 2060 don't apply.  This is xml.
such encoding questions belong to the protocol adaptor.

further notes:

- For [uidvalidity] we use the place oid for that.  Should be unique
enough.

- The imap unique identifier is a strictly ascending number as per
rfc.  Messages are linked under that name.

- Message sequence numbers are matter of model, which is linked under
the name "model".

- The place's body is left unchanged.  No reflexive changes made here.

<model>
 <sequence>357</sequence>
 <messages>
  <message
    id="356"    unique identifier 2.3.1.1
    number="1"  message seuence number 2.3.1.2
  >
   The following id is to be ignored for now.  There is no clear idea
   how it should be found.
   <mind:id>Axxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx</mind:id>
   <flags>      flags 2.3.2
    <flag value="\Seen"/>
   </flags>
   date (see 2.3.3) is taken from the dumped message object
   size is taken from the message object
   
  </message>
 </messages>
</model>

-->
<mind:form xmlns:mind="mind">
 <mind:link name="view"></mind:link>
 <xsl:stylesheet xmlns:dsssl="dsssl" xmlns:imap="urn:rfc:imap" xmlns:mind="mind" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
  <xsl:variable name="model">
   <dsssl:copy-of select="(fetch &quot;model&quot;)"></dsssl:copy-of>
  </xsl:variable>
  <xsl:variable name="sequence">
   <dsssl:copy-of select="
(number-&gt;string
  (+ 1 (string-&gt;number (data (fetch &quot;sequence&quot;)))))"></dsssl:copy-of>
  </xsl:variable>
  <xsl:template match="list">
   <html>
    <head>
     <title>A mailbox implemented in Scheme.</title>
    </head>
    <body bgcolor="white">
     <h3>mail</h3>
     <table>
      <dsssl:for-each select="(children (current-node))"></dsssl:for-each>
      <tr>
       <td>
        <dsssl:copy-of select="(current-node)"></dsssl:copy-of>
       </td>
       <td>
        <dsssl:copy-of select="#CONTENT">
(let ((obj (fetch (me (current-node)))))
  (if (node-list-empty? obj)
      (literal "no subject")
      (select-elements (children obj) 'subject)))
           </dsssl:copy-of>
       </td>
      </tr>
     </table>
    </body>
   </html>
  </xsl:template>
  <xsl:template match="request[&apos;read&apos;]">
   <xsl:appy-templates></xsl:appy-templates>
  </xsl:template>
  <xsl:template match="request[&apos;write&apos;]">
   <xsl:appy-templates></xsl:appy-templates>
  </xsl:template>
  <xsl:template match="imap:fetch">
   <dsssl:copy-of select="#CONTENT">
(let ((from (or (string-&gt;number (data ((sxpath '(from) (current-node))))) 1))
      (to (or (string-&gt;number (data ((sxpath '(to) (current-node)))))
              (string-&gt;number (data (xsl-variable "sequence"))))))
  (make element
    gi: 'messages
    (node-list-map
     (lambda (node)
       (let ((msgno (string-&gt;number (attribute-string "number" node))))
         (if (and (&gt;= msgno from) (&lt; msgno to))
             (make element
               gi: message
               attributes: (copy-attributes node)
               (children node)
               (fetch (attributes-string 'id node)))
             (empty-node-list))))
     ((sxpath '(messages *)) (xsl-variable "model")))))
   </dsssl:copy-of>
  </xsl:template>
  <xsl:template match="imap:append">
   <mind:link name="sequence"></mind:link>
   <mind:new action="public">
    <dsssl:copy-of select="(xsl-variable &quot;sequence&quot;)"></dsssl:copy-of>
   </mind:new>
   <dsssl:link dsssl:xmlns="mind" dsssl:name="(data (xsl-variable &quot;sequence&quot;))"></dsssl:link>
   <dsssl:new dsssl:xmlns="mind" action="public" dsssl:protection="
(right-&gt;string (me &apos;protection))
"></dsssl:new>
   <dsssl:new dsssl:xmlns="mind" action="public" dsssl:protection="(right-&gt;string (me &apos;protection))">
    <dsssl:copy-of select="(msg &apos;body/parsed-xml)"></dsssl:copy-of>
   </dsssl:new>
   <mind:link name="model">
    <dsssl:new dsssl:xmlns="mind" action="public" dsssl:protection="
(right-&gt;string (me &apos;protection))
">
     <model>
      <dsssl:copy-of select="#CONTENT">
(let* ((msgs ((sxpath '(messages *)) (xsl-variable "model")))
       (nmsgs (node-list-length msgs)))
 (make element gi: 'messages
       msgs
       (make
        element gi: 'message
        attributes: `((id ,(data (xsl-variable "sequence")))
                      (number (+ 1 nmsgs)))
        (make element gi: 'flags
              (make element gi: 'flag attributes: '((value "\\Recent"))))
              (make element gi: 'date
                    (literal (date-&gt;string (msg 'dc-date) "~4")))
              (make element gi: 'size (literal (msg 'content-length))))))
       </dsssl:copy-of>
     </model>
    </dsssl:new>
   </mind:link>
  </xsl:template>
  <xsl:template match="imap:expunge">
   <mind:link name="model">
    <dsssl:new dsssl:xmlns="mind" action="public" dsssl:protection="
(right-&gt;string (me &apos;protection))
">
     <model>
      <dsssl:copy-of select="#CONTENT">
(node-list-filter
  (lambda (x) (not (equal? "\\Deleted" ((sxpath '(flags flag @ value)) x))))
  ((sxpath '(messages *) (xsl-variable "model"))))
   </dsssl:copy-of>
     </model>
    </dsssl:new>
   </mind:link>
  </xsl:template>
 </xsl:stylesheet>
</mind:form>

Diese Seite findet man von: overview, .




Letzte Modifikation: Tue, 28 May 2002 12:59:31 CEST

Autor(en): jfw,

Dokument Nummer A67bb0753e1676f81983e0ecf3a15b391 geliefert an public um Thu, 20 Nov 2008 13:37:47 +0100