;;;  loading-section
(load (string-append laml-dir "laml.scm"))
(lib-load "xml-in-laml/xml-in-laml.scm")
(lib-load "xml-in-laml/mirrors/xhtml10-frameset-mirror.scm")
(lib-load "xml-in-laml/mirrors/xhtml10-transitional-mirror.scm")
(lib-load "xhtml1.0-convenience.scm")
(lib-load "color.scm")
(lib-load "time.scm")


   
;;;  frameset-alias-section
  
(define fr:html (xhtml10-frameset 'html)) 
  
(define fr:head (xhtml10-frameset 'head)) 
  
(define fr:title (xhtml10-frameset 'title))

(set! language-preference 'english)
(set! xml-check-language-overlap? #f)

; ----------------------------------------------------
; Bookmark title and data

  
(define page-title "Part of Kurt Nørmark's Bookmarks")

   
(define bookmarks 
 (file-read 
  (string-append (startup-directory) 
                 "bookmark-sample.lsp")))

; ----------------------------------------------------
; Common functions

  
(define (bookmark-categories bookmark-list)
  (bookmark-categories-iterate bookmark-list '()))

; Selectors
   
(define bookmark-title-of (make-selector-function 2))
   
(define bookmark-url-of (make-selector-function 3))
    
(define bookmark-category-of (make-selector-function 4))
   
(define bookmark-comment-of (make-selector-function 5))

  
(define (bookmark-title-of-non-blank bm)
 (let ((bmt (bookmark-title-of bm)))
   (if (blank-string? bmt) "?" bmt)))

; Constructor
   
(define (make-bookmark ttl url cat com) 
   (list 'bookmark ttl url cat com))


; --------------------------------------------------------

; The list of frame widths
   
(define frame-width-list '(200 *))

   
;;  frameset-page Write the index file
(write-html '(prolog pp) ;  @e
 (fr:html
  
   (fr:head  ;  
    (fr:title "Bookmark Browser") ;  
   )
   (frameset ;  
     (frame 'name "bookmark-categories" 
            'src "bookmark-categories.html" 
            'scrolling "auto")
     (frame 'name "bookmark-main" 
            'src "bookmark-contents.html"
             'scrolling "auto")
     
    'cols (list-to-string 
           (map as-string frame-width-list) ",") ;  
   ))
)

   
;;  empty-pages Write the index file
; A procedure that makes an empty x page.
   
(define (make-empty-page! x)
 (write-html '(prolog pp)
  (html (head (title x)) (body (h3 x)))
  (in-startup-directory (string-append x ".html"))))

(make-empty-page! "bookmark-categories")
(make-empty-page! "bookmark-contents")




; --------------------------------------------------------------
; THE LEFT HAND PAGE.

   
(define (present-categories bml)
 (let* ((cat-list (map bookmark-category-of bml)) ;  
        (cat-list-unique (remove-duplicates cat-list)) ;  
       )
   (map ;  
      (lambda (cat) 
        (con
         (a 'href (string-append "bookmark-contents.html" "#" cat)
            'target "bookmark-main"
            cat)
         (br))
      )
      (sort-list cat-list-unique 
       (lambda (s t) 
         (string<=? (downcase-string s) (downcase-string t)))))))

   
;;  left-frame-page Write the left frame.
(write-html '(prolog pp)
 (html (head (title "Bookmark Categories"))
  (body 
    (font-1 4 red (b "Bookmark categories")) (p)
    (present-categories bookmarks)
    (p)
    (font-1 1 red (when-generated))))
 (in-startup-directory "bookmark-categories.html")
)

; --------------------------------------------------------------
; THE RIGHT HAND PAGE.

   
(define sentinel-bookmark 
  (make-bookmark "" "" 'empty "")) 

   
(define (present-bookmarks bml)
 (let* ((sorted-bookmarks ;  
         (sort-list bml
          (lambda (bm1 bm2) ;  
            (string<=? 
             (downcase-string (bookmark-category-of bm1))
             (downcase-string (bookmark-category-of bm2)))))))
  (present-bookmarks-1 
   sorted-bookmarks ;  
   (cons sentinel-bookmark 
     (butlast sorted-bookmarks)) ;  
  )
 )
)

   
(define (present-bookmarks-1 bml prev-bml)
 (map2 (lambda (bm bm-prev) ;  
         (if (not ;  
              (equal?
               (bookmark-category-of bm)
               (bookmark-category-of bm-prev))) 
             (con (a-name (bookmark-category-of bm))
                  (h3 (bookmark-category-of bm))
                  (present-a-bookmark bm))
             (present-a-bookmark bm)))
        bml prev-bml))

   
(define (present-a-bookmark bm)
 (let ((comment (bookmark-comment-of bm)))
   (con
    (a 'href (bookmark-url-of bm)
       'title comment ;  
       (bookmark-title-of-non-blank bm))
    (br))))
 


   
;;  right-frame-page Write the right frame.
(write-html '(prolog pp)
 (html (head (title "Bookmarks"))
  (body
   
  (font-1 6 red (b page-title)) (p)
  (present-bookmarks bookmarks)
  (vertical-space 25)))
  (in-startup-directory "bookmark-contents.html")
)