(load (string-append laml-dir "laml.scm"))

(style "simple-html4.0-loose")

; ----------------------------------------------------------------------------------------
; Read bookmarks from data file

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

 
(define bookmarks (file-read (string-append (startup-directory) "bookmarks-1.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 *))

 
;;  Write the index file

(write-text-file   
 (html
  (con
   (head  ; 
    (title "Bookmark Browser") ; 
    )
   (frameset
    
    (con ; 
     (frame 'name "bookmark-categories" 'src "categories.html" 'scrolling "auto")
     (frame 'name "bookmark-main" 'src "bookmarks.html" 'scrolling "auto")
     )

    'cols (list-to-string (map as-string frame-width-list) ",") ; 
   )))

 (full-source-path-with-extension "html") ; 
)


; A procedure that makes an empty x page.
 
(define (make-empty-page! x)
  (write-text-file (page x (h3 x)) (string-append x "." "html")))

(make-empty-page! "categories")
(make-empty-page! "bookmarks")

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

 
(define (present-categories bml)
 (let* ((cat-list (map bookmark-category-of bml)) ; 
        (cat-list-unique (remove-duplicates cat-list)) ; 
       )
  (list-to-string  ; 
    (map ; 
      (lambda (cat) 
        (a-tag-target
         (string-append "bookmarks.html" "#" cat) cat "bookmark-main")
      )
      (sort-list (map downcase-string cat-list-unique) string<=?))
    (br))))

 
;;  Write the left frame.
(write-text-file
 (page
  "Bookmark Categories"
  (con 
    (font-1 4 red (b "Bookmark categories")) (p)
    (present-categories bookmarks)
    (p)
    (font-1 1 red (when-generated))
  )
  white black blue blue)
 "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)
  (list-to-string
   (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)
   (br)))

 
(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)))))
 


 
;;  Write the right frame.

(write-text-file
 (page
  "Bookmarks"
  (con 
    (font-1 6 red (b page-title)) (p)
    (present-bookmarks bookmarks)
    (vertical-space 25))
  white black blue blue)
  "bookmarks.html"
)