(defvar rss-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(control x) (control s)] 'rss-save)
    map)
  "Keymap for RSS Diary mode.")

(defvar rss-list-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(control m)] 'rss-list-select)
    (define-key map [?q] 'rss-list-quit)
    map)
  "Keymap for RSS Diary List mode.")

(defvar rss-rss-filename
  "/home/chery/public_html/rss2.0.xml"
  "Filename of the RSS feed to publish to.")

(defvar rss-front-filename
  "/home/chery/public_html/index.html"
  "Filename of the RSS Diary front page.")

(defvar rss-front-url
  "http://www.s2.org/~chery/"
  "URL of the front page.")

(defvar rss-history-dirname
  "/home/chery/public_html/blog"
  "Directory name of the RSS Diary history.")

(defvar rss-history-urlbase
  "http://www.s2.org/~chery/blog/"
  "URL base of the RSS Diary history.")

(defvar rss-history-template
  "/home/chery/public_html/blog/template.html"
  "Filename of the RSS Diary history template.")

(defvar rss-mode-hook
  nil
  "RSS Diary mode hook.")

(defvar rss-list-mode-hook
  nil
  "RSS Diary List mode hook.")

(defun rss-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'rss-mode)
  (setq mode-name "RSS Diary")
  (use-local-map rss-mode-map)
  (put 'rss-mode 'mode-class 'special)
  (make-local-variable 'rss-date-string)
  (make-local-variable 'rss-article-id)
  (run-hooks 'rss-mode-hook))

(defun rss-list-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'rss-list-mode)
  (setq mode-name "RSS Diary List")
  (use-local-map rss-list-mode-map)
  (put 'rss-list-mode 'mode-class 'special)
  (run-hooks 'rss-list-mode-hook))

(defun rss-new-entry ()
  (interactive)
  (let ((buffer (generate-new-buffer "*RSS Diary*")))
    (switch-to-buffer buffer)
    (insert-file-contents rss-history-template)
    (goto-char (point-max))
    (search-backward "<p>")
    (narrow-to-region (point) (+ (point) 7))
    (forward-char 3)
    (rss-mode)))

(defun rss-edit-entry (id)
  (let ((buffer (generate-new-buffer "*RSS Diary*")))
    (switch-to-buffer buffer)
    (insert-file-contents (concat rss-history-dirname "/" id ".html"))
    (set-visited-file-name (concat rss-history-dirname "/" id ".html"))
    (set-buffer-modified-p nil)
    (search-forward "<div class=\"main\" id=\"main\">")
    (search-forward "<p>")
    (backward-char 3)
    (let ((start (point)))
      (goto-char (point-max))
      (search-backward "</p>")
      (forward-char 4)
      (narrow-to-region start (point)))
    (goto-char (+ (point-min) 3))
    (rss-mode)
    (setq rss-date-string (substring id 0 10))
    (setq rss-article-id id)))

(defun rss-list ()
  (interactive)
  (let ((buffer (generate-new-buffer "*RSS List*"))
	(files (directory-files rss-history-dirname nil ".*[0-9].html$")))
    (switch-to-buffer buffer)
    (while files
      (insert (car files))
      (insert "\n")
      (setq files (cdr files)))
    (setq buffer-read-only t)
    (set-buffer-modified-p nil)
    (rss-list-mode)))

(defun rss-list-extract-id ()
  (save-excursion
    (beginning-of-line)
    (let ((start (point)))
      (search-forward ".html")
      (buffer-substring start (- (point) 5)))))

(defun rss-list-select ()
  (interactive)
  (rss-edit-entry (rss-list-extract-id)))

(defun rss-list-quit ()
  (interactive)
  (set-buffer-modified-p nil)
  (kill-buffer (current-buffer)))

(defvar rss-month-alist
  '(("Jan" 1) ("Feb" 2) ("Mar" 3) ("Apr" 4) ("May" 5) ("Jun" 6)
    ("Jul" 7) ("Aug" 8) ("Sep" 9) ("Oct" 10) ("Nov" 11) ("Dec" 12))
  "Numbers of named months.")

(defun rss-month-to-number (month-string)
  (cadr (assoc month-string rss-month-alist)))

(defun rss-save ()
  (interactive)
  (let ((update-p (buffer-file-name)))
    (unless update-p
      (rss-set-paths))
    (rss-save-rss update-p)
    (rss-save-history update-p)
    (rss-save-front update-p))
  (kill-buffer (current-buffer)))

(defun rss-set-paths ()
  (let* ((time-string (current-time-string))
	 (date-string (concat (substring time-string 20 24) "-"
			      (format "%d" (rss-month-to-number
					    (substring time-string 4 7)))
			      "-" (substring time-string 8 10)))
	 (article-id date-string)
	 (uniquifier 2))
    (while (file-exists-p (concat rss-history-dirname "/" article-id ".html"))
      (setq article-id (concat date-string (format "-%d" uniquifier)))
      (setq uniquifier (1+ uniquifier)))
    (set-visited-file-name (concat rss-history-dirname "/" article-id ".html"))
    (setq rss-article-id article-id)
    (setq rss-date-string date-string)))

(defun rss-save-history (update-p)
  (unless update-p
    (save-excursion
      (goto-char (point-max))
      (backward-char 4)
      (insert (concat " <span class=\"date\">" rss-date-string "</span>"))))
  (save-buffer))

(defun rss-insert-buffer-substring-xml-escaped (buffer s e)
  (let ((start (point)))
    (insert-buffer-substring buffer s e)
    (let ((end (point)))
      (goto-char start)
      (while (re-search-forward "&\\|<\\|>" end t)
	(let* ((replacee (match-string 0))
	       (replacer (cadr (assoc replacee '(("&" "&amp;")
						 ("<" "&lt;")
						 (">" "&gt;"))))))
	  (replace-match replacer t t)
	  (setq end (+ end (length replacer) -1))))
      (goto-char end))))

(defun rss-save-rss (update-p)
  (let* ((article-id rss-article-id)
	 (edit-buffer (current-buffer))
	 (time-string (current-time-string))
	 (time-zone (car (current-time-zone)))
	 (rss-buffer (get-file-buffer rss-rss-filename))
	 (close-rss nil))
    (unless rss-buffer
      (setq rss-buffer (find-file-noselect rss-rss-filename))
      (setq close-rss t))
    (save-excursion
      (set-buffer rss-buffer)
      (goto-char (point-min))
      (search-forward "</description>")
      (when update-p
	(let ((beginning (point))
	      (searching-p t)
	      (found-p nil))
	  (while searching-p
	    (if (search-forward "</guid>" nil t)
		(when (string-equal (buffer-substring (- (point) 12
							 (length article-id))
						      (- (point) 12))
				    article-id)
		  (setq searching-p nil)
		  (setq found-p t))
	      (setq searching-p nil)))
	  (when found-p
	    (if (search-backward "</item>" beginning t)
		(forward-char 7)
	      (goto-char beginning))
	    (let ((start (point)))
	      (search-forward "</item>")
	      (delete-region start (point))))
	  (unless found-p
	    (goto-char beginning))))
      (insert "\n\n")
      (insert "<item>\n<description>")
      (rss-insert-buffer-substring-xml-escaped
       edit-buffer (save-excursion
		     (set-buffer edit-buffer)
		     (point-min))
       (save-excursion
	 (set-buffer edit-buffer)
	 (goto-char (point-max))
	 (let ((p (search-backward "</p>")))
	   (or (search-backward " <span class=\"date\">" nil t) p))))
      (insert "&lt;/p&gt;</description>\n<guid isPermaLink=\"true\">")
      (insert rss-history-urlbase)
      (insert article-id)
      (insert ".html</guid>\n<pubDate>")
      (insert (substring time-string 0 3))
      (insert ", ")
      (insert (substring time-string 8 11))
      (insert (substring time-string 4 8))
      (insert (substring time-string 20 24))
      (insert (substring time-string 10 20))
      (if (< time-zone 0)
	  (progn
	    (setq time-zone (- time-zone))
	    (insert "-"))
	(insert "+"))
      (insert (format "%02d" (/ time-zone 3600)))
      (insert (format "%02d" (/ (% time-zone 3600) 60)))
      (insert "</pubDate>\n</item>")
      (save-buffer))
    (when close-rss
      (kill-buffer rss-buffer))))

(defun rss-save-front (update-p)
  (let ((edit-buffer (current-buffer))
	(article-id rss-article-id)
	(linkname (concat rss-history-urlbase rss-article-id ".html"))
	(front-buffer (get-file-buffer rss-front-filename))
	(close-front nil))
    (unless front-buffer
      (setq front-buffer (find-file-noselect rss-front-filename))
      (setq close-front t))
    (save-excursion
      (set-buffer front-buffer)
      (goto-char (point-min))
      (search-forward "<p class=\"quotation\">")
      (search-forward "</p>")
      (when update-p
	(let ((beginning (point))
	      (searching-p t)
	      (span-pos nil)
	      (found-p nil))
	  (while searching-p
	    (setq span-pos (search-forward "<span class=\"archive\">" nil t))
	    (if (search-forward "\">" nil t)
		(when (string-equal (buffer-substring (- (point) 7
							 (length article-id))
						      (- (point) 7))
				    article-id)
		  (setq searching-p nil)
		  (setq found-p t))
	      (setq searching-p nil)))
	  (when found-p
	    (goto-char (1- span-pos))
	    (if (search-backward "<span class=\"archive\">" beginning t)
		(search-forward "</p>")
	      (goto-char beginning))
	    (let ((start (point)))
	      (search-forward "<span class=\"archive\">")
	      (search-forward "</p>")
	      (delete-region start (point))))
	  (unless found-p
	    (goto-char beginning))))
      (insert "\n\n")
      (insert-buffer-substring edit-buffer)
      (backward-char 4)
      (insert " <span class=\"archive\">[<a href=\"")
      (insert linkname)
      (insert "\">archive</a>]</span>")
      (save-buffer))
    (when close-front
      (kill-buffer front-buffer))))