(require 'html-lite)
(require 'cl)

(defmacro with-my-header (title &rest body)
  "Basically the same as `with-html-lite-header', but with some local modifications."
  `(append 
    (html-doctype)
    (html-html
     (html-head (html-stylesheet-stuff) 
                (html-title ,title)
                (html-meta :http-equiv "Content-Type" :content "text/html; charset=utf-8"))
     (html-body 
      (html-front-matter ,title)
      (if (not (string= "Blog" title)) ; this is a big bad hack
          (html-div :class "content" ,@body)
          ,@body)
      (html-back-matter ,title)))))

(defun resolve-relative-link (link)
  (concat *website-base-absolute-address* link))

(defun html-stylesheet-stuff ()
  (append 
   (html-link :rel "stylesheet" :href (resolve-relative-link "style.css") :type "text/css")))

(defun html-front-matter (title)
  (html-div :class "front-matter"
            (random-picture)
            (html-h3 "Internal Links")
            (my-internal-links title)
            (html-h3 "Friends with webpages")
            (my-external-links)
            (html-h3 "Cool sites")
            (my-cool-sites)
            (html-h3 "Cool software")
            (my-cool-software)))

(defun html-back-matter (title)
  (let ((page (find-if (lambda (y) (string-equal title (car y))) website-pages)))
    (html-div :class "front-matter"
              (html-p (html-a :href "mailto:christopher.gray@mail.mcgill.ca" "mail") "me"
                      (html-a :href "http://jigsaw.w3.org/css-validator/check/referer" (html-img :src (resolve-relative-link "vcss.png") :alt "Valid CSS!"))
                      (html-a :href "http://validator.w3.org/check/referer" (html-img :src (resolve-relative-link "valid-xhtml10.png") :alt "Valid XHTML 1.0!")))
              (html-p (html-a :href (resolve-relative-link (concat (cadddr page) ".html")) "View source")))))

(defun random-picture ()
  (let* ((dir-list (directory-files (concat *website-base* "images/")))
        (relevant-files (cddr dir-list))
        (len (length relevant-files))
        (file-name (nth (random len) relevant-files)))
    (html-img :src (resolve-relative-link (concat "images/" file-name)) :alt "Random image" :width "40%")))

(defvar *website-base* "/cgray@www.win.tue.nl:public_html/" 
  "Base of the website")

(defvar *website-base-absolute-address* "http://www.win.tue.nl/~cgray/")

(defvar *website-el-base* "/home/cgray/website-el/")
(defvar website-pages nil)

(defvar my-internal-links-list '("Home" "Publications" "About" "Images" "Ipelets"))

(defvar my-friends-list '(("http://ze-dinosaur.livejournal.com" "Eric Dorland")
                          ("http://www.cs.nyu.edu/~wu" "Chris Wu")
                          ("http://www.cs.ubc.ca/~backer" "Jon Backer")))

(defvar my-cool-sites-list '(("http://salon.com" "Salon")
                             ("http://imdb.com" "IMDb")
                             ("http://lwn.net" "LWN")))


(defvar my-cool-software-list '(("http://www.emacswiki.org" "Emacs")
                                ("http://www.linux.org" "Linux")
                                ("http://www.nongnu.org/ratpoison" "Ratpoison")
                                ("http://ipe.compgeom.org" "Ipe")))

(defun my-internal-links (title)
  (mapcar (lambda (x) 
            (let ((page (find-if (lambda (y) (string-equal x (car y))) website-pages)))
              (if (not (string-equal (car page) title))
                  (html-p (html-a :href (resolve-relative-link (cadr page)) (car page)))
                (html-p (car page)))))
          my-internal-links-list))


(defun my-external-links ()
  (mapcar (lambda (x) (html-p (html-a :href (car x) (cdr x)))) my-friends-list))

(defun my-cool-sites ()
  (mapcar (lambda (x) (html-p (html-a :href (car x) (cdr x)))) my-cool-sites-list))

(defun my-cool-software ()
  (mapcar (lambda (x) (html-p (html-a :href (car x) (cdr x)))) my-cool-software-list))

(defmacro for-each-relevant-file (sym &rest body)
  `(loop for ,sym in (cddr (directory-files *website-el-base* t))
      when (and (not (string= (concat *website-el-base* "..") ,sym)) (not (string= (concat *website-el-base* ".") ,sym)) (not (backup-file-name-p ,sym)))
      collect (progn
                ,@body)))

(defun website-load-files ()
  (for-each-relevant-file file
                          (load file)))

(defun publish-website ()
  (let* ((dir-list (directory-files *website-el-base* t))
         (relevant-files (remove-if 'backup-file-name-p (cddr dir-list))))
    (mapc 'load relevant-files)
    (mapc 'publish-page website-pages)
    (mapc (lambda (x) (htmlize-file x *website-base*)) relevant-files)
    (htmlize-file "~/my-website.el" *website-base*)))

(defmacro add-webpage (&optional name)
  (let* ((nam (or name (substring (buffer-name) 0 (- (length (buffer-name)) 3))))
         (page (list (capitalize nam) (concat nam ".html") (intern (concat nam "-fun")) (concat nam ".el"))))
     (add-to-list 'website-pages page)
     `(defun ,(intern (concat "publish-" nam "-fun")) ()
        (interactive)
        (publish-page ',page))))

(defun publish-page (page)
  ;; a page is a list with elements
  ;; (title page-name page-function page-file)
  (add-to-list 'website-pages page)
  (let* ((title (car page))
        (page-name (cadr page))
        (page-function (caddr page))
        (dir (file-name-directory (concat *website-base* page-name))))
    (make-directory dir t)
    (let ((buf (find-file-noselect (concat *website-base* page-name) t)))
      (with-current-buffer buf
        (unwind-protect 
            (progn (erase-buffer)
             (html-lite-write-tree
              (with-my-header title
                              (funcall page-function)))
             (save-buffer)
             (kill-buffer nil)))))))

(website-load-files)