(require 'html-lite)
(require 'rss-lite)

(add-webpage "blog")

(defvar *blog-entries* nil)

(defun blog-fun ()
  ;; Basically takes a list of entries and outputs them as
  ;; both rss and html.  Could also output a calendar and title lists.
  ;; Should probably only do the last 10 entries or something.
  ;; This function can only return the html.
  (let ((blog-entries-list (blog-get-entries)))
    (blog-output-rss blog-entries-list)
    (blog-output-html blog-entries-list)))

(defun blog-get-entries ()
  (blog-unserialize-entries))

(defun blog-add-blog-entry (blog-entry)
  ;; Gets an alist that has a title and a body and adds some other data 
  ;; (like date, etc.) if it's not already there.  Then adds it to the 
  ;; `*blog-entries*' list.
  (blog-get-entries)
  (let ((title (cdr (assoc 'title blog-entry)))
        (body (cdr (assoc 'body blog-entry)))
        (date (cdr (assoc 'date blog-entry)))
        (author (cdr (assoc 'author blog-entry)))
        (link (cdr (assoc 'link blog-entry)))
        (category (cdr (assoc 'category blog-entry)))
        (enclosure (cdr (assoc 'enclosure blog-entry)))
        (trackback-url (cdr (assoc 'trackback-url blog-entry)))
        (guid (cdr (assoc 'guid blog-entry))))
    (add-to-list '*blog-entries* 
                 (list (cons 'title title) (cons 'body body)
                       (if date
                           (cons 'date date)
                         (cons 'date (format-time-string "%a, %d %b %G %H:%M:%S %z")))
                       (if author
                           (cons 'author author)
                         (cons 'author (format "%s <%s>" user-full-name user-mail-address)))
                       (if guid
                           (cons 'guid guid)
                         (progn
                           (setq guid (number-to-string (cadr (current-time)))) ; FIXME -- I still don't like this
                           (cons 'guid guid)))
                       (if link
                           (cons 'link link)
                         (cons 'link (concat *website-base-absolute-address* "archives/" (format-time-string "%Y/%m/%d") ".html#" guid)))
                       (if category
                           (cons 'category category)
                         (cons 'category "nil"))
                       (if enclosure
                           (cons 'enclosure enclosure)
                         (cons 'enclosure nil))))
    (blog-serialize-entries)
    (publish-blog-fun)))

(defun add-blog-entry (title body &optional image)
  "Adds the blog entry with the title given as a string and the body given as an
HTML tree."
  (blog-add-blog-entry (list (cons 'title title)
                             (cons 'body (if image
                                             (append (html-img :src image :style "float:right" :width "20%") body)
                                             body)))))

(defun blog-serialize-entries ()
  (let ((buf (find-file-noselect "~/.blog-entries.el")))
    (with-current-buffer buf
      (erase-buffer)
      (pp *blog-entries* buf)
      (save-buffer)
      (kill-buffer nil))))

(defun blog-unserialize-entries ()
  (let ((buf (find-file-noselect "~/.blog-entries.el")))
    (with-current-buffer buf
      (let ((output (read buf)))
        (kill-buffer nil)
        (setq *blog-entries* output)))))

(defvar *my-blog-title* "Proof: obvious"
  "The title given to the blog.  I haven't completely settled on a good one yet, which is why this is a variable.")
        
(defun blog-output-rss (entries-list) 
  (let ((sorted-list (sort (copy-sequence entries-list) (lambda (x y) (not (time-less-p (date-to-time (cdr (assoc 'date x))) (date-to-time (cdr (assoc 'date y))))))))
        (buf (find-file-noselect (concat *website-base* "/blog.xml") t)))
    (with-current-buffer buf
      (unwind-protect 
          (progn (erase-buffer)
           (rss-lite-write-tree
            (rss-rss :version "2.0"
             (rss-channel 
              (rss-title *my-blog-title*)
              (rss-link (concat *website-base-absolute-address* "/blog.html"))
              (rss-description "Resolutely unhip since 2004.  The blog, not the person.")
              (rss-language "en-us")
              (rss-generator "rss-lite.el")
              (rss-lastBuildDate (format-time-string "%a, %d %b %G %H:%M:%S %z"))
              (mapcar (lambda (item)
                        (rss-item 
                         (rss-title (cdr (assoc 'title item)))
                         (rss-link (cdr (assoc 'link item)))
                         (rss-description (with-output-to-string 
                                            (with-current-buffer standard-output 
                                              (html-lite-write-tree (cdr (assoc 'body item)))))) ; note difference between alist entry and rss tag
                         (rss-author (cdr (assoc 'author item)))
                         (rss-category (cdr (assoc 'category item)))
                         (rss-guid :isPermaLink "true" (cdr (assoc 'link item))) ; why you would call a guid a link is beyond me.
                         (rss-pubDate (cdr (assoc 'date item))) ; note difference between alist entry and rss tag
                         )) sorted-list)))))
        (progn 
          (save-buffer)
          (kill-buffer nil))))))

(defun blog-output-calendar (entries-list) ;; FIXME: fix this calendar
  ;; Output the calendar from this month
  (append
   (html-table :width "95%"
               (html-tr
                (html-td (format-time-string "%b"))
                (html-tr
                 )))))

(defun blog-sort-entries-by-date (entries)
  (sort (copy-sequence entries) (lambda (x y) (when y (not (time-less-p (date-to-time (cdr (assoc 'date x))) (date-to-time (cdr (assoc 'date y)))))))))

(defun blog-output-todays-archive ()
  (let* ((entries (blog-get-entries))
         (todays-entries (remove-if-not (lambda (x) (equal (days-between (cdr (assoc 'date x)) (format-time-string "%a, %d %b %G %H:%M:%S %z")) 0)) entries))
         (sorted-entries (blog-sort-entries-by-date todays-entries)))
    (append 
     (html-h1 (concat "Archive for " (format-time-string "%a, %d %b %G")))
     (mapcar (lambda (item)
               (html-div :class "blog-entry"
                         (html-div :class "blog-entry-title"
                                   (html-a :href (cdr (assoc 'link item)) :name (cdr (assoc 'guid item)) (cdr (assoc 'title item))))
                         (cdr (assoc 'body item))))
             sorted-entries))))

(defun blog-output-html (entries-list)
  (publish-page (list "Archive" (concat "archives/" (format-time-string "%Y/%m/%d") ".html") 'blog-output-todays-archive "blog.el"))
  (let ((sorted-list (blog-sort-entries-by-date (subseq entries-list 0 9))))
    (append 
     ;; output calendar
     ;; output summary list
     (html-div :class "front-matter"
               (html-h3 "Syndicate")
               (html-p 
                (html-a :href "blog.xml" "RSS 2.0"))
               (html-h3 "Recent articles")
               (mapcar (lambda (item)
                         (html-p (html-a :href (cdr (assoc 'link item)) (cdr (assoc 'title item)))))
                       (subseq sorted-list 0 5)))
     ;; output html representations
     (html-div :class "content"
               (html-h1 *my-blog-title*)
               (mapcar (lambda (item)
                         (html-div :class "blog-entry"
                                   (html-div :class "blog-entry-title" 
                                             (html-a :href (cdr (assoc 'link item)) :name (cdr (assoc 'guid item)) (cdr (assoc 'title item))))
                                   (cdr (assoc 'body item))))
                       sorted-list)))))