; =>man/xhtml10-convenience.sdoc

; The LAML library and programs are written by Kurt Normark, Aalborg University, Denmark.
; Copyright (C) 2002  Kurt Normark, normark@s.auc.dk.
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with this program; if not, write to the Free Software
; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;;;; This library contains a number of convenient functions on top of the XHTML mirrors.
;;;; The functions in this library are intended to be common for XHTML mirrors in LAML.
;;;; Notice, however, that some of the functions will only work with HTML1.0 transitional.<p>
;;;;
;;;;
;;;; The collection in this library can be regarded as personal convenience stuff. You can use it
;;;; if you find it useful - or you can develop your own convenience stuff on top of the XHTML mirror library.<p>
;;;;
;;;;
;;;; The collection also serves as backward compatibility functions in relation to older LAML software. Many
;;;; functions in this library originally served as ad hoc Scheme markup functions. As of this library, the
;;;; functions have been reimplemented on top of the XHTML libraries.
;;;; .title Reference Manual of the XHTML convenience library

;;; Basic HTML extension stuff. 
;;; In this section we implement mirrors of HTML stuff such as comment and character entities.
;;; Also there are a number of convenient white space functions (horizontal and vertical).
;;; As a special, but very useful function, we include an html-protect function which provides for presentation
;;; of verbatim HTML documents in a browser. There is also some basic javascript support in this section.
; Backward compatibility only
(define con list)
; (define con-space list)

; The HTML4.01 loose document type clause. Just a backward compatibility alias.
(define doctype-clause document-type-declaration)

 
(define (character-entity x)
 (char-ref x))

 
(define copyright (character-entity "copy"))


 
(define (space n)
  (make-list n (character-entity "nbsp")))

 
(define horizontal-space space)

 
(define (vertical-space n)
  (if (= n 0) '()
      (cons (space 1) (cons (p) (vertical-space (- n 1))))))

 
(define (html-protect str)
 (transliterate
   (transliterate
     (transliterate 
         str #\& "&amp;")  
     #\> "&gt;")
    #\< "&lt;"))

 
(define (in-danish str)
 (letrec ((in-danish-1 
            (lambda (str letter-numbers)
              (cond ((null? letter-numbers) str)
		    (else (in-danish-1
			   (transliterate str (as-char (car letter-numbers)) (character-entity (car letter-numbers)))
			   (cdr letter-numbers)))))))
  (let ((danish-letter-numbers (list 230 248 229 198 216 197)))
    (in-danish-1 str danish-letter-numbers))))


 
(define (js-call function-name parameters)
  (string-append function-name 
                   "(" 
                      (string-merge (map as-string parameters)
                                    (make-list (- (length parameters) 1) ", "))
                   ")"))



 
(define (js-string-array elements)
  (string-append "[" 
                 (string-merge (map string-it-single (map as-string elements))
                               (make-list (- (length elements) 1) ","))
                 "]")
)



; ---------------------------------------------------------------------------------------------------
;;; Convenience variants of the HTML mirror functions. 
;;; The functions in this section are either quite close to the HTML mirror functions or very simple.
 
(define (a-tag url . optional-parameter-list)
 (let ((anchor (optional-parameter 1 optional-parameter-list url)))
  (a anchor 'href (as-string url))))

 
(define (a-tag-target url anchor target)
  (a
    anchor
    'href (as-string url)
    'target (as-string target)))

 
(define (a-name name)
  (a ""
    'name (as-string name)))

 
(define a-self-ref 
 (xml-in-laml-abstraction 
  (lambda (cont attr)
    (a attr (defaulted-get-prop 'href attr "???")))))

 
(define (mail-link email-adr . optional-parameter-list)
 (let* ((anchor-name (optional-parameter 1 optional-parameter-list email-adr))
        (subject     (optional-parameter 2 optional-parameter-list ""))
        (subject-contribution (if (empty-string? subject) "" (string-append "?" "subject" "=" subject)))
      )
  (a 'href (string-append "mailto:" email-adr subject-contribution) anchor-name)))


 
(define (h i x)
  (cond ((= i 1) (h1 x))
        ((= i 2) (h2 x))
        ((= i 3) (h3 x))
        ((= i 4) (h4 x))
        ((= i 5) (h5 x))
        ((>= i 6) (h6 x))
  ))


 
(define (font-1 size color x)
  (font  x 'size (convert-size size) 'color (rgb-color-encoding color)))

(define (convert-size size)
  (if (and (symbol? size) (eq? size 'normal)) "3" (as-string size)))

 
(define (font-size size x)
  (font  x 'size (convert-size size)))

 
(define (font-color color x)
  (font  x 'color (rgb-color-encoding color)))


 
(define (html-appender element)
  (lambda (existing-stuff)
    (con existing-stuff explicit-space element)))

 
(define (font-rise str base-size)
  (con
     (font-size (+ base-size 1) (substring  str 0 1)) explicit-space
     (font-size base-size (substring  str 1 (string-length str)))))

;;; Lists and trees.
;;; In this section there are various convenient functions which renders lists and trees.

 
(define (br-list lst)
  (map (lambda(el) (con el (br))) lst))

 
(define brl br-list)


 
(define (definition-list lst)
  (dl
   (map (lambda(el) 
	  (let ((dt-data (car el))
		(dd-data (if (= 1 (length el)) "" (cadr el))))
	    (con (dt  dt-data)
		 (if (equal? dd "")
		     ""
		   (dd dd-data)))))
	lst)))


 
(define (ul-tree tree)
  (cond ((or (cdata? tree) (ast? tree)) (ul (li 'type "disc" tree)))
        ((pair? tree) 
	 (ul
  	    (li (car tree) 'type "disc"
  	      (map ul-tree (cdr tree)))))))

 
(define lis
  (xml-in-laml-abstraction 
    (lambda (cont attr)
      (li cont attr 'css:margin-bottom "3mm"))))


; --------------------------------------------------------------------------------------------------------
;;; Table functions.
;;; In this section there is a number of table functions which
;;; maps a list of rows (list of lists) to an HTML table. 
;;; Older LAML software depends on these. I do not recommend use of these functions in new software. 
;;; Instead, use the HTML table mirror function directly.
 
(define (table-0 list-of-list . optional-parameter-list)
  (let ((table-row 
         (lambda (lst) (tr
			(map (lambda (cell)
			       (td cell))
			     lst))))
	(border (optional-parameter 1 optional-parameter-list "1")))
    (table
     (con 
      (tbody
       (map table-row list-of-list)))
     'border (as-string border))))


 
(define (table-1 border cell-width-list cell-color-list-1 list-of-list . optional-parameter-list)
  (let ((va (as-string (optional-parameter 1 optional-parameter-list "top"))))
    (table
     (con
      (tbody
       (map
	(lambda (row)
	  (tr
	   (map (lambda (cell width color-1)
		  (td 
		  cell
		   'width (as-string width) 'valign va 'bgcolor (rgb-color-encoding color-1)
		   )
		  )
		row cell-width-list cell-color-list-1))
	  )
	list-of-list
	)
       ))
     'border (as-string border))))


 
(define (table-2 border cell-width-list cell-color-list-1 header-list list-of-list)
  (table
   (con
    (tbody
     (cons   ; if con then a strange error - research it and try to catch it in AST composition phase
      (tr
       (map (lambda (h)(th h)) header-list))
      (map
       (lambda (row)
	 (tr
	  (map (lambda (cell width color-1)
		 (td 
		  cell
		  'width (as-string width) 'valign "top" 'bgcolor (rgb-color-encoding color-1)
		  )
		 )
	       row cell-width-list cell-color-list-1)
	  ))
       list-of-list
       ))))
  'border (as-string border)))

 
(define (table-3 border cell-width-list  list-of-list . optional-parameter-list)
  (let ((va (as-string (optional-parameter 1 optional-parameter-list "top"))))
    (table
     (con
      (tbody
       (map
	(lambda (row)
	  (tr
	   (map (lambda (cell width)
		  (td 
		   cell
		   'width (as-string width) 'valign va
		   )
		  )
		row cell-width-list))
	  )
	list-of-list
	)
       ))
     'border (as-string border))))

 
(define (table-4 border cell-width-list row-color-list list-of-list . optional-parameter-list)
  (let ((va (as-string (optional-parameter 1 optional-parameter-list "top"))))
    (table
     (con
      (tbody
       (map
	(lambda (row row-color)
	  (tr
	   (map (lambda (cell width)
		  (td 
		   cell
		   'width (as-string width) 'valign va 'bgcolor (rgb-color-encoding row-color)
		   )
		  )
		row cell-width-list)))
	list-of-list row-color-list
	)
       ))
     'border (as-string border))))

 
(define (table-5 border cell-width-list list-of-color-list list-of-list . optional-parameter-list)
  (let ((va (as-string (optional-parameter 1 optional-parameter-list "top"))))
    (table
     (con
      (tbody
       (map
	(lambda (row row-color-list)
	  (tr
	   (map (lambda (cell width row-color)
		  (td 
		   cell
		   'width (as-string width) 'valign va 'bgcolor (rgb-color-encoding row-color)
		   )
		  )
		row cell-width-list row-color-list)
	   ))
	list-of-list list-of-color-list
	)
       ))
     'border (as-string border))))

 
(define (left-middle-right-banner left middle right . optional-parameter-list)
 (let* ((distribution-percentages (optional-parameter 1 optional-parameter-list '(33 34 33)))
        (left-percent (string-append (as-string (first distribution-percentages)) "%"))
        (middle-percent (string-append (as-string (second distribution-percentages)) "%"))
        (right-percent (string-append (as-string (third distribution-percentages)) "%"))
       )
  (table
   (con
   (tbody
    (con
    (tr
     (con
      (td
       (con (font-size 2 left))
       'width left-percent 'align "left" 'valign "top")

      (td
       (con (font-size 2 middle))
       'width middle-percent 'align "center" 'valign "top")

      (td
       (con (font-size 2 right))
       'width right-percent 'align "right" 'valign "top")
      )
     ))))
   'border "0px" 'cellpadding "0" 'cellspacing "0" 'width "100%")))


 
(define (left-right-banner left right . optional-parameter-list)
 (let* ((distribution-percentages (optional-parameter 1 optional-parameter-list '(50 50)))
        (left-percent (string-append (as-string (first distribution-percentages)) "%"))
        (right-percent (string-append (as-string (second distribution-percentages)) "%"))
       )
  (let ((font-size (lambda (x y) y))) ; local redef to circumvent improper use of font-size
    (table
     (con
      (tbody
       (con
        (tr
         (con
          (td
           (con (font-size 2 left))
           'width left-percent 'align "left" 'valign "top")

          (td
           (con (font-size 2 right))
           'width right-percent 'align "right" 'valign "top")
          )
         ))))
     'border "0" 'cellpadding "0" 'cellspacing "0" 'width "100%")))) 



 
(define (laml-top-banner)
 (let ((yr (car (time-decode (current-time)))))
  (left-middle-right-banner
     (when-generated)
     (span "Copyright" copyright  (as-string yr) _ ","  "Kurt Nørmark")
     (laml-home-button 0 "laml-home.gif"))))

 
(define (mini-menu mini-menu-list dark-color)
 (letrec ((mini-menu-entry (lambda (e) 
                             (let ((text (car e))
                                   (url (cadr e)))
                              (con (a (font-1 2 white text) 'href url 'css:text-decoration "none")
                                   ))))
          (lgt (length mini-menu-list)))
   (table-1
     1
     (make-list lgt 160)
     (make-list lgt dark-color)
     (list (map mini-menu-entry mini-menu-list)))))


; ---------------------------------------------------------------------------------------------------
;;; HTML input form functions. 
;;; A number of convenient functions which supports the work with HTML input forms.
 
(define (form-1 cgi-url x)
  (form x 'method "post" 'action cgi-url))

 
(define (multipart-form cgi-url target-directory target-directory-url x)
  (form 
     (con
       (hidden-line "target-directory!!!" target-directory)
       (hidden-line "target-directory-url!!!" target-directory-url)
       x
      )
     'method "post" 'enctype "multipart/form-data" 'action cgi-url))

 
(define (checkbox name . checked)
 (let ((checked1 (if (null? checked) #f (car checked))))
  (if checked1 
    (input 'type "checkbox" 'checked "checked" 'value "true" 'name (as-string name))
    (input 'type "checkbox" 'value "true" 'name (as-string name)))))

 
(define (radio-button value group-name . checked)
 (let ((is-checked (and (not (null? checked)) (boolean? (car checked)) (car checked))))
  (if is-checked
    (input 'type "radio" 'checked "checked" 'value (as-string value) 'name (as-string group-name))
    (input 'type "radio" 'value (as-string value) 'name (as-string group-name))
  )))

 
(define (text-line name size value)
  (input 'type "text" 'name (as-string name) 'size (as-string size) 'value (as-string value)))

 
(define (hidden-line name value)
  (input 'type "hidden" 'name (as-string name) 'value (as-string value)))

 
(define (file-upload name)  
  (input 'type "file" 'name (as-string name) 'size 60))

 
(define (password-line name size value)
  (input 'type "password" 'name (as-string name) 'size (as-string size) 'value (as-string value)))

 
(define (submit value . optional-parameters)
 (let ((name (optional-parameter 1 optional-parameters #f)))
  (if name
      (input 'type "submit" 'value (as-string value) 'name (as-string name))
      (input 'type "submit" 'value (as-string value)))))

 
(define (reset value)
  (input 'type "reset" 'value (as-string value)))

 
(define (select-1 name value-list contents-list . selected-value)
 (let* ((selected (if (null? selected-value) "" (car selected-value)))
        (body (map (lambda (value contents)
                           (if (equal? selected value)
                               (option (as-string contents) 'value (as-string value) 'selected "selected") 
                               (option (as-string contents) 'value (as-string value)))) 
			 value-list contents-list))
       )
   (select body 'name (as-string name))))

 
(define (textarea-1 name rows cols contents)
  (textarea (as-string contents) 'name (as-string name) 'rows (as-string rows) 'cols (as-string cols)))


; ---------------------------------------------------------------------------------------------------
;;; Multi column lists. 
;;; The functions in this section return multi-column lists. Given a list of elements the functions
;;; return a table in which the elements have been arranged in a number of columns. The first function,
;;; multi-column-list, arranges the elements in row major order. The two last functions arrange the
;;; the elements in column major order. These are the most advanced functions due to the way tables
;;; are organized in HTML.

 
(define (multi-column-list columns elements total-width)
 (let* ((lgt (length elements))
        (rem (remainder lgt columns))
        (elements-2 (cond ((= lgt 0) (make-list columns " "))     ; ensure that list length is a multiplum of column, and at least column
                          ((= 0 rem) elements)
                          (else (append elements (make-list (- columns rem) " ")))))
        (rows (sublist-by-rows columns elements-2))
        (column-width (quotient total-width columns))
        (column-widths (make-list columns column-width)))
    (table-3 0 column-widths rows)))


 
(define (two-column-list elements total-width)
 (let* ((lgt (length elements))
        (rem (remainder lgt 2))
 
        ; not used any more
; ensure that list length is a multiplum of column, and at least column
        (elements-2 (cond ((= lgt 0) (make-list 2 " ")) 
                          ((= 0 rem) elements)
                          (else (append elements (make-list (- 2 rem) " ")))))

        (rows (sublist-by-2columns elements " "))
        (column-width (quotient total-width 2))
        (column-widths (make-list 2 column-width)))
    (table-3 0 column-widths rows)))

 
(define (n-column-list n elements total-width)
 (let* ((lgt (length elements))
        (rows (sublist-by-columns n elements " "))
        (column-width (quotient total-width n))
        (column-widths (make-list n column-width)))
    (table-3 0 column-widths rows)))


;;; Images and image file access. 
;;; The functions in this section determine how images are accessed from this
;;; and other libraries.
 
(define kn-internet-image-path "http://www.cs.auc.dk/~normark/images/")

 
(define (image-file-path)
  (cond ((eq? image-file-access 'local) "")
        ((eq? image-file-access 'parent) "../images/")
        ((eq? image-file-access 'sub-directory) "./images/")
        ((eq? image-file-access 'net) kn-internet-image-path)
        ((eq? image-file-access 'fixed) fixed-image-directory)
  ))

 
(define (set-image-file-path! mode)
  (set! image-file-access mode))

 
(define (image-file file-name)
  (string-append (image-file-path) file-name ))


 
(define (img-0 file-name . width)
 (if (not (null? width))
  (img 'alt "" 'src (as-string file-name) 'width (as-string (car width)) 'border "0")
  (img 'alt "" 'src (as-string file-name) 'border "0")))

 
(define (img-with-border file-name . width)
 (if (not (null? width))
  (img 'src (as-string file-name) 'width (as-string (car width)))
  (img 'src (as-string file-name))))


 
(define (laml-home-button extra-level text-or-image . start-dir)
 (let* ((start-dir-1 (if (null? start-dir) (startup-directory) (car start-dir)))
        (url-of-laml (laml-home-url-prefix extra-level start-dir-1))
        (help-text 
           (if (equal? url-of-laml laml-absolute-url-prefix)
               "The LAML software home page at Aalborg University"
               "The local LAML software home page"))
        (image-file 
           (cond ((eq? text-or-image 'text) "")      ; not defined
                 ((eq? text-or-image 'image) "images/blue-house.gif")
                 ((string? text-or-image) (string-append "images/" text-or-image))
                 (else "???")))
       )
   (a
     (cond ((eq? text-or-image 'text) "LAML home")
           ((or (eq? text-or-image 'image) (string? text-or-image))
                    (img 'src (string-append url-of-laml image-file) 'alt help-text 'border "0"))
           (else "LAML home"))
     'href (string-append url-of-laml "index.html")
     'title help-text
     'target "_top")))

;;; Non-standard Media Stuff.
 
(define embed
  (free-single-element "embed"))


; ---------------------------------------------------------------------------------------------------
;;; Indenting, boxing, and framing.
;;; Here is a number of functions of indentation and frame making.

 
(define indent-pixels
  (xml-in-laml-positional-abstraction 1 0
    (lambda (p c a)
       (div 'css:margin-left (string-append (as-string p) "px") a c))))

; (define (indent-pixels p text)
;   (div 'css:margin-left (string-append (as-string p) "px") text))

 
(define (narrow-with-pixels p text)
  (table-3 0 (list p "*" p) 
    (list (list "" text ""))))

 
(define (frame-1 text) 
  (table-3 1 (list "*") 
    (list (list text))))

 
(define (box text . optional-parameter-list) 
 (let ((width (optional-parameter 1 optional-parameter-list "*")))
  (table-3 0 (list width)
    (list (list text)))))

 
(define (narrow separator-fn width . contents-list)
  (let ((separator-list (make-list (- (length contents-list) 1) (separator-fn))))
   (table-3 0 (list width) 
    (list 
      (list (merge-lists-simple contents-list separator-list))))))

 
(define (color-frame text color) 
  (table-1 0 (list "*") (make-list 1 color)
    (list (list text)) "bottom"))

 
(define (color-frame-width text color width) 
  (table-1 0 (list width) (make-list 1 color)
    (list (list text)) "bottom"))

 
(define (frame-width text width) 
  (table-3 1 (list width) ; (make-list 1 slide-background-color)
    (list (list text))))

 
(define (center-frame indentation text)
  (center
   (narrow-with-pixels indentation
     (frame-1 text))))


;;; Alphabetical index arrays. 
;;; The alphabetic index arrays are useful for presentation of alphabets linking to separate pages in a large index.
 
(define (alphabetic-link-array)
 (map 
  (lambda (letter)  (con (a-tag (string-append "#" letter) (capitalize-string-nd letter))  (horizontal-space 1)))
  (list "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" 
	"p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "æ" "ø" "å")))

 
(define (alphabetic-link-array-1 target-file-prefix alphabet . emphasis-letter)
  (let* ((em-let (if (not (null? emphasis-letter)) (as-string (car emphasis-letter)) #f))
         (alphabet-1 (map as-string alphabet)))
    (map 
     (lambda (letter) 
       (con
	(a-tag (string-append target-file-prefix "-" letter ".html")
	       (if (and em-let (equal? em-let letter))
		   (font-1 4 red (b (capitalize-string-nd letter)))
		   (capitalize-string-nd letter)))
	" "
       ))
     alphabet-1)))

; ---------------------------------------------------------------------------------------------------
;;; Substring Coloring.
;;; The function colorize-substring in this section is able to colorize specified substrings
;;; of a given string.
 
(define (colorize-substrings str region-color-list)
  (set! last-coloring-length 0)
  (if (null? region-color-list)
      str
      (let* ((region-color (car region-color-list))
             (from-str (car region-color))
             (to-str (cadr region-color))
             (color (caddr region-color))
             (face (if (>= (length region-color) 4) (cadddr region-color) 'bold))
             (multiplicity (if (>= (length region-color) 5) (fifth region-color) 1))
            )
        (colorize-substrings
          (font-substring str 0 from-str to-str color face multiplicity)
          (cdr region-color-list)))))

; Return a face start tag of a given face symbol. 
; We support the following face symbols: italic, bold, typewriter, underlined, plain
(define (face-start-tag face-symbol)
  (cond ((eq? face-symbol 'italic) (start-tag 'i) )
        ((eq? face-symbol 'bold) (start-tag 'b))
        ((eq? face-symbol 'typerwriter) (start-tag 'kbd))
        ((eq? face-symbol 'underlined) (start-tag 'u))
        ((eq? face-symbol 'plain) "")
        (else (error "face start tag: Unknown face symbol"))
  )
)

; Return a face end tag of a given face symbol.
(define (face-end-tag face-symbol)
  (cond ((eq? face-symbol 'italic) (end-tag 'i))
        ((eq? face-symbol 'bold) (end-tag 'b))
        ((eq? face-symbol 'typerwriter) (end-tag 'kbd))
        ((eq? face-symbol 'underlined) (end-tag 'u))
        ((eq? face-symbol 'plain) "")
        (else (error "face end tag: Unknown face symbol"))
  )
)


; holds the length of font text from last substitution
(define last-coloring-length 0)
                               

(define (repeat-colorizing str start-index from-str to-str color face n)
  (if (> n 0)
      (font-substring str start-index from-str to-str color face n)
      str))
             
; surround a substring, delimited by from-delimiting-string and to-delimiting-string, by a html font tag
; with a color attribute.
; starting looking for delimiting strings at from-index
(define (font-substring str start-index from-delimiting-string to-delimiting-string color face multiplicity)
  (let ((from-index (substring-index str start-index from-delimiting-string)))
   (if from-index
       (let ((to-index (substring-index str 
                           (+ from-index (string-length from-delimiting-string))  ; addition 10.9.98
                           to-delimiting-string)))
          (if to-index
              (repeat-colorizing 
                 (font-substring-by-index str from-index (+ to-index (string-length to-delimiting-string)) color face)
                 (+ to-index last-coloring-length) from-delimiting-string to-delimiting-string color face (- multiplicity 1))
              (error (string-append "Substring fonting/colorizing: Cannot find the to delimiting strings: "
                                       to-delimiting-string " in " (initial-prefix-of-string str 40) ))))
        (error (string-append "Substring fonting/colorizing: Cannot find the from delimiting strings: "
                               from-delimiting-string " in " (initial-prefix-of-string str 40))))))

(define (initial-prefix-of-string str n)
 (let ((lgt (string-length str)))
   (if (> lgt n)
       (substring str 0 n)
       str)))   


; to-index is larger than from-index.
; insert a font tag around index range
(define (font-substring-by-index str from-index to-index color face)
 (let* ((pre (string-append (face-start-tag face) (start-tag 'font 'color (rgb-color-encoding color))))
        (post (string-append (end-tag 'font) (face-end-tag face)))
       )
   (set! last-coloring-length (+ (string-length pre) (string-length post)))
   (put-around-substring
      str from-index pre to-index post)))



; --------------------------------------------------------------------------------------------------------
;;; Miscelaneous
 
(define (copyright-owner x) (span x " " copyright))

 
(define when-modified
  (xml-in-laml-abstraction 
    (lambda (c a)
      (let ((when-updated (defaulted-get-prop 'updated-as-of a #f))
            (when-created (defaulted-get-prop 'new-as-of a #f)))
        (cond  (when-updated 
                  (let* ((updated-date-list (year-month-day-decode-string when-updated))
                         (updated-time (time-encode (first updated-date-list) (second updated-date-list) (third updated-date-list) 0 0 0))
                         (dt (date-time updated-time)))
                    (string-append "Last modified: " (weekday updated-time) ", " (car dt))))
               (when-created
                  (let* ((created-date-list (year-month-day-decode-string when-created))
                         (created-time (time-encode (first created-date-list) (second created-date-list) (third created-date-list) 0 0 0))
                         (dt (date-time created-time)))
                    (string-append "Page created: " (weekday created-time) ", " (car dt))))
               (else ""))))))