<?xml version="1.0" encoding="UTF-8" ?>
<xsl:stylesheet xmlns:core="http://www.askemos.org/2000/CoreAPI#" xmlns:d="http://www.askemos.org/2005/NameSpaceDSSSL/" xmlns:editor="urn:editor" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
 <xsl:variable name="view">diary</xsl:variable>
 <xsl:template name="calmth.tpl">
<!-- monthly calendar view -->
<!--
Benutze besser
http://ietf.webdav.org/caldav/homepage/papers.html
http://www.ietf.org/rfc/rfc2445.txt
! -->
  <xsl:param name="date">
   <d:copy-of select="msg &apos;dc-date"></d:copy-of>
  </xsl:param>
  <xsl:param name="entries"></xsl:param>
  <d:copy-of select="#CONTENT">
(begin
 (define (local) "de")
 (define wkstart 1) ; Monday starts the week

(define (calendar month . off)
  (define offset (if (pair? off) (car off) 1))
  (define mon1st (make-date 0 0 0 0  1 (date-month month)
			    (date-year month) (date-zone-offset month)))
  (define mon1stj (date-&gt;julian-day mon1st))
  (define lml (julian-day-&gt;date (- mon1stj 1)
				(date-zone-offset month)))
  (define nm1st
    (if (eqv? (date-month month) 12)
	(make-date 0 0 0 0  1 1
		   (+ (date-year month) 1) (date-zone-offset month))
	(make-date 0 0 0 0  1 (+ 1 (date-month month))
		   (date-year month) (date-zone-offset month))))
  (define tml (julian-day-&gt;date (- (date-&gt;julian-day nm1st) 1)
				(date-zone-offset month)))

  (define wk1 (let ((x (modulo (- offset (date-week-day mon1st)) 7)))
		(if (eqv? x 0) 7 x)))

  (define (make-date-ref month daynr)
    (read-locator
     (msg 'location-format) (msg 'location)
     body: (sxml
            `(form
              (date ,(julian-day-&gt;date daynr (date-zone-offset month)))
              ))))

  (define (make-week-number month daynr)
    `(td (@ (class "wkno"))
         ,(literal (date-week-number
         (julian-day-&gt;date daynr (date-zone-offset month)) wkstart))))

  (define (week start end daynr)
    (cons*
     'tr
     (make-week-number month (+ 1 daynr) )
     (let loop ((day start) (class #f) (wd 7) (daynr daynr))
       (if (eqv? wd 0)
	   '()
	   `((td ,@(if class '((@ (class "off-month"))) '())
		 ,(if class
                      (literal day)
                      `(a (@ (href ,(make-date-ref month daynr)))
		         ,(literal day))))
	     . ,(if (eqv? day end)
		    (loop 1 #t (- wd 1) (+ daynr 1))
		    (loop (+ day 1) class (- wd 1) (+ daynr 1))))))))

  (sxml
   `(table
     (tr (td (@ (colspan "3") (align "center"))
             ,(date-&gt;string mon1st "~B ~Y" (local))))
    (tr
     (@ (border "0"))
     (td (a (@ (href ,(make-date-ref mon1st (- mon1stj 1)))) "&lt;"))
     (td (table
     (@ (border "1") (cellpadding "2px")
	(style "border-collapse:collapse; text-align:center;"))
     (tr (td "#")
         . ,(let loop ((n 7)
		       (day (+ (date-&gt;julian-day lml)
			       (- offset (date-week-day lml)))))
	      (if (eqv? n 0) '()
		  `((th ,(date-&gt;string 
			  (julian-day-&gt;date day (date-zone-offset month))
			  "~a" "de"))
		    . ,(loop (- n 1) (+ day 1))))))
     (tr
      ,(make-week-number month mon1stj)
      . ,(let loop ((run  (- 7 wk1))
		   (day (+ (date-day lml)
			   (- offset (date-week-day lml)))))
	  (if (&lt;= run 0)
	      (let loop ((day 1) (jday mon1stj))
		(if (&lt; wk1 day) '()
		    `((td (a (@ (href ,(make-date-ref month jday)))
			     ,(literal day)))
		      . ,(loop (+ day 1) (+ jday 1)))))
	      `((td (@ (class "off-month")) ,(literal day))
		. ,(loop (- run 1) (+ day 1))))))
     ,(week (+ wk1 1) (+ wk1 7) (+ wk1 mon1stj))
     ,(week (+ wk1 8) (+ wk1 14) (+ wk1 mon1stj 7))
     ,(week (+ wk1 15) (date-day tml) (+ wk1 mon1stj 14))
     ,@(let ((start (+ wk1 22)))
	 (if (&gt;= (date-day tml) start)
	     (list (week start (date-day tml) (+ wk1 mon1stj 21)))
	     '()))
     . ,(let ((start (+ wk1 29)))
	  (if (&gt;= (date-day tml) start)
	      (list (week start (date-day tml) (+ wk1 mon1stj 28)))
	      '()))
     )) ; table td
   (td (a (@ (href ,(make-date-ref nm1st (date-&gt;julian-day nm1st)))) "&gt;"))
    )) ;table 
 ) ; sxml
)

;; (calendar (make-date 0 0 0 0  23 12 1965 0) 1)

(calendar (car (xsl-variable "date")) 1)

)
</d:copy-of>
 </xsl:template>
 <xsl:template name="calday.tpl">
<!-- daily calendar view -->
<!--
Benutze
http://ietf.webdav.org/caldav/homepage/papers.html
! -->
  <xsl:param name="date">
   <d:copy-of select="msg &apos;dc-date"></d:copy-of>
  </xsl:param>
  <xsl:param name="entries"></xsl:param>
  <xsl:choose>
   <d:when test="(service-level)">
    <d:form method="post">
     <d:copy-of select="#CONTENT">begin
 define (local) "de"
 define date
  let ((d (form-field 'date (current-node)) ))
   if (node-list-empty? d)
      msg 'dc-date
      string-&gt;date (data d) "~a, ~d ~b ~Y ~H:~M:~S ~z"
 sxml
  quasiquote
   div
    input (@ (type "hidden") (name "action") (value "diary-save"))
    input (@ (type "hidden") (name "date") (value ,(literal date)))
    p ,(date-&gt;string date "~a ~d. ~m. ~Y (~j)" (local))
     input (@ (type "submit") (value "speichern"))
    textarea (@ (name "text") (cols "30") (rows "10"))
     . ,(guard (ex (else ""))
         ((sxpath '(*any*))
          (fetch (list "webdav" "dates"
                      (date-&gt;string date "~Y")
                      (date-&gt;string date "~j")))
        ))
</d:copy-of>
    </d:form>
   </d:when>
   <xsl:otherwise>
    <p>private entry not shown</p>
   </xsl:otherwise>
  </xsl:choose>
 </xsl:template>
 <xsl:template name="diary-save">
<!-- update calendar entry -->
  <reply>
   <continue>
    <d:copy-of select="(grove-root (current-node))"></d:copy-of>
   </continue>
   <link name="webdav">
    <d:copy-of select="#CONTENT">begin
 define protection (right-&gt;string (me 'protection))
 define date
  string-&gt;date
   (data (form-field 'date (current-node)))
   "~a, ~d ~b ~Y ~H:~M:~S ~z"
 (collection-update-tree
 "webdav"
 (list "dates" (date-&gt;string date "~Y"))
 (date-&gt;string date "~j")
 (let ((text (form-field 'text (current-node)) ))
   (and (not ((pcre "^[[:space:][:cntrl:]]*$") (data text)))
     (sxml `(new (@ (action "public")
               (protection ,protection))
     . ,text))))
 action: "public"
 protection: protection
 context: me
)
</d:copy-of>
   </link>
   <d:output d:location="(read-locator (msg &apos;location-format) (msg &apos;location) body: (make element gi: &apos;form (form-field &apos;date (current-node)))) "></d:output>
  </reply>
 </xsl:template>
 <xsl:variable name="diary">
<!-- UI für Blog -->
  <xsl:variable name="date">
   <d:copy-of select="#CONTENT">let
 ((d (form-field 'date (current-node)) ))
 if (node-list-empty? d)
    msg 'dc-date
    string-&gt;date (data d) "~a, ~d ~b ~Y ~H:~M:~S ~z"
</d:copy-of>
  </xsl:variable>
  <div style="position:relative;left:0;top:0;">
   <xsl:call-template name="calmth.tpl">
    <xsl:with-param name="date">
     <d:copy-of select="xsl-variable &quot;date&quot;"></d:copy-of>
    </xsl:with-param>
   </xsl:call-template>
  </div>
  <div style="position:relative;right:0;top:0;">
   <xsl:call-template name="calday.tpl">
    <xsl:with-param name="date">
     <d:copy-of select="xsl-variable &quot;date&quot;"></d:copy-of>
    </xsl:with-param>
   </xsl:call-template>
  </div>
 </xsl:variable>
 <xsl:template match="*[@type=&quot;read&quot;]">
  <xsl:variable name="view">
   <d:copy-of select="
   (let ((form-selection (form-field &apos;select (current-node))))
     (if (node-list-empty? form-selection)
         &quot;diary&quot;
         (data form-selection)))
"></d:copy-of>
  </xsl:variable>
  <xsl:choose>
   <d:when test="(and (pair? (msg &apos;destination)) (not (equal? (car (msg &apos;destination)) &quot;&quot;)))">
    <d:copy-of select="(fetch (cons &quot;webdav&quot; (msg &apos;destination))
body: (children (current-node))
&apos;location (msg &apos;location)
)"></d:copy-of>
   </d:when>
   <d:when test="(is-metainfo-request? msg)">
    <d:copy-of select="(me (me &apos;get &apos;id) &apos;metainfo)"></d:copy-of>
   </d:when>
   <d:when test="(and (service-level) (is-meta-form? msg))">
    <d:copy-of select="
(if (is-propfind-request? msg)
    (if (me &quot;webdav&quot;)
        (fetch (cons &quot;webdav&quot; (msg &apos;destination))
               &apos;location (msg &apos;location)
               body: (children (current-node)))
        (dav-propfind-reply me msg collection: #t children: &apos;()))
    (message-body (metaview me msg)))
"></d:copy-of>
   </d:when>
   <xsl:otherwise>
    <html xmlns="http://www.w3.org/1999/xhtml">
     <head>
      <title>ABLOG</title>
     </head>
     <body bgcolor="white">
      <d:if test="(service-level)">
       <d:form method="post" style="display:inline" d:action="write-locator (msg &apos;location-format) (msg &apos;location)">
        <select name="view">
         <d:copy-of select="#CONTENT">sxml
 quasiquote
  option "1"
</d:copy-of>
        </select>
        <input type="submit" value="View"></input>
        <input name="action" type="hidden" value="set-view"></input>
       </d:form>
       <a href="?xmlns=mind">debug</a>
       <hr></hr>
      </d:if>
      <d:copy-of select="
(guard (ex (else 
            (sxml `(*TOP*
                    (div (@ (class &quot;errmsg&quot;))
                     (h2 &quot;Error&quot;)
                     (pre ,((if (message-condition? ex) condition-message literal) ex)))
              ,(message-body (metaview me msg))))))
 (xsl-variable (data (xsl-variable &quot;view&quot;))))
"></d:copy-of>
     </body>
    </html>
   </xsl:otherwise>
  </xsl:choose>
 </xsl:template>
 <xsl:template match="request[@type=&quot;write&quot;]">
  <d:if test="(or (service-level)
 (error &quot;Pfoten wech!&quot;))">
   <xsl:choose>
    <d:when test=" (eq? &apos;grant (gi (children (current-node)))) ">
     <core:reply>
      <continue>
       <d:copy-of select="(grove-root (current-node))"></d:copy-of>
      </continue>
      <d:copy-of select="((sxpath &apos;(grant right)) (current-node))"></d:copy-of>
      <core:output method="xml"></core:output>
     </core:reply>
    </d:when>
    <d:when test="(is-meta-form? msg)">
     <d:copy-of select="(message-body (metactrl me msg))"></d:copy-of>
    </d:when>
    <d:when test="(not (equal? (data (form-field &apos;action (current-node))) &quot;&quot;))">
     <d:call-template name="(data (form-field &apos;action (current-node)))"></d:call-template>
    </d:when>
    <xsl:otherwise>
     <core:reply>
      <d:if test="(not (equal? (data (form-field &apos;update (current-node))) &quot;&quot;))">
       <core:update>
        <d:copy-of select="(form-field &apos;update (current-node))"></d:copy-of>
       </core:update>
      </d:if>
      <core:continue>
       <d:copy-of select="#CONTENT">

(root
  (let ((this-root (document-element (grove-root (current-node)))))
    (make element
      gi: (gi this-root) ns: (ns this-root)
      attributes: (copy-attributes this-root)
      (node-list-map
       (lambda (node)
         (cond
          ((match-element? 'state node)
           (make element
               gi: (gi node) ns: (ns node)
               (let ((query (form-field 'query (current-node))))
                 (if (equal? (data query) "")
                     ((sxpath '(query)) node)
                     query))
               (let ((update (form-field 'update (current-node))))
                 (if (equal? (data update) "")
                     ((sxpath '(update)) node)
                     update))))
                      )))))
            ((match-element? 'include node)
             (make element gi: 'include ns: (ns this-root)
               attributes: `((href "A367597ff503cbd42948f9fe705ff3197/Kalender.xml"))))
          (else node)))
       ;; The children of the root of the style sheet.
       (children this-root)))))

 </d:copy-of>
      </core:continue>
     </core:reply>
    </xsl:otherwise>
   </xsl:choose>
  </d:if>
 </xsl:template>
</xsl:stylesheet>