Error

d:copy-of bad argument type (bad argument type (#<<srfi:date>>) car) car in "
 (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->julian-day mon1st))
  (define lml (julian-day->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->date (- (date->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)
    (string-append (read-locator (msg 'location-format) 
                                 (msg 'location)
     							 )
									 "?date="
									 (pem-encode (date->string (julian-day->date daynr (date-zone-offset month))
									             							 "~a, ~d ~b ~Y ~H:~M:~S ~z")									            
									 )
    )
  )

  (define (make-week-number month daynr)
    `(td (@ (class "wkno"))
         ,(literal (date-week-number
         (julian-day->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)
						   '()
						   `(,(let* ((fetchDate (guard (ex (else ""))																						          
																					 (fetch (list "webdav" "dates"
																						                         (date->string (julian-day->date daynr (date-zone-offset month)) "~Y")
																						                         (date->string (julian-day->date daynr (date-zone-offset month)) "~j")))
																					 ))
						             (hasDate (if (equal? (data fetchDate) "")
        														  			#f
        														  			#t	
        												   )
        							   )
          							 (usedClass (if hasDate
          							                "on-month portlet_calendar_hasDate"
          							                "on-month"
          							            )
          							 )
          							)
								        `(td ,@( if class '((@ (class "off-month"))) `((@ (class ,usedClass))))
														 ,(if class
												          (literal day)
												          (if hasDate
												             `(a (@ (href ,(data ((sxpath '(href)) fetchDate))))
														         		,(literal day))
														         	(literal day)
														      )
														   )
														 )
										)																         
						     . ,(if (eqv? day end)
							    			(loop 1 #t (- wd 1) (+ daynr 1))
							    			(loop (+ day 1) class (- wd 1) (+ daynr 1)))
							  )
					 )
	    )
	  )
	)

  (sxml
   `(table (@ (class "portlet_calendar"))
     (tr 
       (td (@ (class "portlet_calendar_head"))
         "Kalendar"
       ) 	
     )      
     (tr (td (@ (class "portlet_calendar_month"))
           (table (@ (width "100%"))
             (tr 
         			 (td (a (@ (href ,(string-append (data (form-field 'location (current-node))) (make-date-ref mon1st (- mon1stj 1))))
         			           (class "portlet_calendar_month_font")
         			        ) "<"))
         			 (td (@ (align "center")
         			        (class "portlet_calendar_month_font")),(date->string mon1st "~B ~Y" (local)))
         			 (td (a (@ (href ,(string-append (data (form-field 'location (current-node)))  (make-date-ref nm1st (date->julian-day nm1st))))
         			           (class "portlet_calendar_month_font")) ">"))
         		 )
         	 )
         )
     )
    (tr
     (@ (border "0"))
     (td (@ (colspan "3")
            (align "center")
            (class "portlet_calendar_week")
         ) 
         (table
			     (@ (border "0") (cellpadding "2px")
							(style "border-collapse:collapse; text-align:center;")
							(class "portlet_calendar")
					 )
     (tr (@ (class "portlet_calendar_week_head"))
         (td "")
         . ,(let loop ((n 7)
		       						 (day (+ (date->julian-day lml)
			       									 (- offset (date-week-day lml))))
			       					)
	      		  (if (eqv? n 0) 
	      		  		'()
		  						`((th ,(date->string (julian-day->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 (<= run 0)
					      (let loop ((day 1) (jday mon1stj))
													(if (< wk1 day)
													     '()
													    `(,(let* ((fetchDate (guard (ex (else ""))																						          
																						            (fetch (list "webdav" "dates"
																						                         (date->string (julian-day->date jday (date-zone-offset month)) "~Y")
																						                         (date->string (julian-day->date jday (date-zone-offset month)) "~j")))
																						        ))
													              (hasDate (if (equal? (data fetchDate) "")
                      														  			#f
                      														  			#t	
                      												   )
                      							   )
	                      							 (usedClass (if hasDate
	                      							                "on-month portlet_calendar_hasDate"
	                      							                "on-month"
	                      							            )
	                      							 )
	                      							)
															        `(td (@ (class ,usedClass))
																         ,(if hasDate
																              `(a (@ (href ,(data ((sxpath '(href)) fetchDate)))
																                     
																                  )
																               		,(literal day))
																               (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 (>= (date-day tml) start)
	     (list (week start (date-day tml) (+ wk1 mon1stj 21)))
	     '()))
     . ,(let ((start (+ wk1 29)))
	  (if (>= (date-day tml) start)
	      (list (week start (date-day tml) (+ wk1 mon1stj 28)))
	      '()))
     )) ; table td
    )) ;table 
 ) ; sxml
)

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

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

)
"