(defconst *am-re-word* "\\(\\b[-A-Za-z0-9_]+\\b\\)"
  "Regex to describe a word within an article.")
(defconst *am-info-buffer-name* "*article-info*"
  "The name of the buffer in the info window.")

(defvar am-update-time 2
  "The amount of time after the last change before the info window updates.")

(defvar am-timer nil)
(defvar am-timer-hook nil)

(defvar am-info-window nil)
(defvar am-info-buffer nil)

(defvar am-keywords nil)
(defvar am-keywords-regex nil)
(defvar am-highlighting-on nil)

(defun am-update-info ()
  (save-excursion
    ;; (set-buffer am-buffer)
    (let ((words (count-matches *am-re-word* (point-min) (point-max)))
          (region-words (if (not am-region-beginning) nil
                          (count-matches *am-re-word*
                                         am-region-beginning
                                         am-region-end)))
          (keywords (if (= (length am-keywords-regex) 0) 0
                      (count-matches am-keywords-regex
                                     (point-min)
                                     (point-max)))))
      (set-buffer am-info-buffer)
      (erase-buffer)

      (insert (format "# Words      : (%s%s)\n"
                      (if region-words (format "%s / " region-words) "")
                      words))

      (when (and (> words 0) (> (length am-keywords-regex) 0))
        (insert (format "# Keywords   : %d\n" keywords))
        (insert (format "Density      : %.2f%%\n"
                        (* (/ keywords (float words)) 100.0))))

      (insert (format "Keywords     : %s\n" am-keywords)))))

(defun am-add-info-window ()
  (interactive)
  (let ((buffer (current-buffer)))
    (delete-other-windows)
    (split-window-vertically (- (window-height) 6))
    (other-window 1)
    (setq am-info-window (selected-window))
    (setq am-info-buffer (get-buffer-create *am-info-buffer-name*))
    (switch-to-buffer am-info-buffer)
    (other-window -1)
    (switch-to-buffer buffer))
  (am-update-info))

(defvar am-overlays nil)

(defface am-keyword-face
  '((((class color)) (:background "yellow" :foreground "black" :bold t))
    (t (:bold t)))
  "Article mode keyword face")

(defun am-add-overlay (begin end)
  (let ((overlay (make-overlay begin end)))
    (overlay-put overlay 'face 'am-keyword-face)
    (push overlay am-overlays)))

(defun am-delete-overlays ()
  (dolist (overlay am-overlays)
    (delete-overlay overlay))
  (setq am-overlays nil))

(defun am-set-keyword-regex ()
  (let ((re (mapconcat (lambda (e) e) am-keywords "\\|")))
    (setq am-keywords-regex
          (if (> (length re) 0) (concat "\\(" re "\\)") ""))))

(defun am-add-keyword (keyword)
  (interactive "sKeyword: ")
  (if (member keyword am-keywords)
      (error (format "Error: keyword %s is already present" keyword))
    (push keyword am-keywords)
    (am-set-keyword-regex)
    (am-update-info)))

(defun am-remove-keyword (&optional keyword)
  (interactive)
  (when (not am-keywords)
    (error "Error: no keywords set"))
  (unless (stringp keyword)
    (setq keyword (ido-completing-read "Keyword: "
                                       am-keywords nil t nil)))
  (setq am-keywords (remove keyword am-keywords))
  (am-set-keyword-regex)
  (am-update-info))

(defun am-highlight-keywords ()
  (when (not am-keywords)
    (error "Error: no keywords set"))
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward am-keywords-regex nil t)
      (am-add-overlay (match-beginning 1) (match-end 1)))
    (setq am-highlighting-on t)))

(defun am-remove-highlight ()
  (am-delete-overlays)
  (setq am-highlighting-on nil))

(defun am-set-highlight (&optional value)
  (interactive)
  (when (not value)
    (setq value (not am-highlighting-on)))
  (if value (am-highlight-keywords) (am-remove-highlight)))

(defun am-run-timer-hook ()
  (run-hooks 'am-timer-hook))

(defun am-restart-timer ()
  (when (timerp am-timer) (cancel-timer am-timer))
  (setq am-timer
        (run-with-timer am-update-time nil 'am-run-timer-hook)))

(defun am-after-change-functions-hook (begin end length)
  (when article-mode (am-restart-timer)))

(defvar am-region-beginning nil)
(defvar am-region-end nil)

(defun am-post-command-hook ()
  (when mark-active
    (setq am-region-beginning (region-beginning))
    (setq am-region-end (region-end))
    (am-restart-timer)))

(defun am-deactivate-mark-hook ()
  (setq am-region-beginning nil)
  (setq am-region-end nil)
  (when (timerp am-timer) (cancel-timer am-timer))
  (am-update-info))

(defun article-mode-start ()
  (am-add-info-window)
  (am-update-info)
  (add-hook 'post-command-hook 'am-post-command-hook nil t)
  (add-hook 'deactivate-mark-hook 'am-deactivate-mark-hook nil t)
  (add-hook 'after-change-functions 'am-after-change-functions-hook nil t)
  (add-hook 'am-timer-hook 'am-update-info nil t)
  nil)

(defun article-mode-stop ()
  (remove-hook 'post-command-hook 'am-post-command-hook)
  (remove-hook 'deactivate-mark-hook 'am-deactivate-mark-hook)
  (remove-hook 'after-change-functions 'am-after-change-functions-hook)
  (remove-hook 'am-timer-hook 'am-update-info)
  (delete-window am-info-window)
  (setq am-info-window nil))

(defvar article-mode-keymap nil
  "Keymap for article minor mode.")

(if article-mode-keymap
    nil
  (progn
    (setq article-mode-keymap (make-sparse-keymap))
    (define-key article-mode-keymap (kbd "C-c a") 'am-add-keyword)
    (define-key article-mode-keymap (kbd "C-c d") 'am-remove-keyword)
    (define-key article-mode-keymap (kbd "C-c i") 'am-add-info-window)
    (define-key article-mode-keymap (kbd "C-c h") 'am-set-highlight)))

(define-minor-mode article-mode "Minor mode to assist writing articles."
  :lighter " Article"
  :keymap article-mode-keymap
  (if article-mode
      (article-mode-start)
    (article-mode-stop)))

(provide 'article-mode)