(require 'ido)
(require 'derived)

(require 'flyspell)

(defconst *ac-re-word* "\\(\\b[-A-Za-z0-9_]+\\b\\)")
(defconst *ac-info-buffer-name* "*article-info*")

(defvar ac-timer nil)
(defvar ac-timer-hooks nil)

(defvar ac-info-buffer nil)
(defvar ac-keywords nil)
(defvar ac-keywords-regex nil)
(defvar ac-highlighting-on 0)

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

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

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

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

(defun ac-remove-highlight ()
  (remove-text-properties (point-min) (point-max) '(face highlight))
  (setq ac-highlighting-on 0))

(defun ac-set-highlight (&optional value)
  (interactive)
  (when (not value)
    (setq value (if (> ac-highlighting-on 0) nil t)))
  (if value (ac-highlight-keywords) (ac-remove-highlight)))

(defun ac-update-info ()
  (save-excursion
    (let ((words (count-matches *ac-re-word* (point-min) (point-max)))
          (keywords (if (= (length ac-keywords-regex) 0) 0
                      (count-matches ac-keywords-regex
                                     (point-min)
                                     (point-max)))))
      (set-buffer ac-info-buffer)
      (erase-buffer)
      (insert (format "# Words      : %s\n" words))

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

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

(defun ac-add-info-window ()
  (interactive)
  (delete-other-windows)
  (split-window-vertically (- (window-height) 6))
  (other-window 1)
  (setq ac-info-buffer *ac-info-buffer-name*)
  (switch-to-buffer ac-info-buffer)
  (ac-update-info)
  (other-window -1))

(defun ac-run-timer-hooks ()
  (run-hooks 'ac-timer-hooks))

(defun ac-add-timer ()
  (setq ac-timer (run-with-idle-timer 0.5 t 'ac-run-timer-hooks)))

(defvar article-mode-hook nil
  "Hook run when entering article mode.")

(defvar article-mode-map nil
  "Keymap for article major mode.")

(define-derived-mode article-mode text-mode "Article"
  "Major mode for editing articles
Special commands:
\\{article-mode-map}")

(if article-mode-map
    nil
  (progn
    (setq article-mode-map (make-sparse-keymap))
    (define-key article-mode-map (kbd "C-c a") 'ac-add-keyword)
    (define-key article-mode-map (kbd "C-c d") 'ac-remove-keyword)
    (define-key article-mode-map (kbd "C-c h") 'ac-set-highlight)))
        
(defun ac-post-command-hook ()
  (cond ((>= ac-highlighting-on 2) (setq ac-highlighting-on 1))
        ((and (= ac-highlighting-on 1)
              (equal major-mode 'article-mode))
         (ac-remove-highlight))))

(defun ac-article-mode-entry ()
  (add-hook 'post-command-hook 'ac-post-command-hook t)
  (ac-add-info-window)
  (flyspell-mode 1)
  (longlines-mode 1))

(add-hook 'ac-timer-hooks 'ac-update-info)

(add-hook 'article-mode-hook 'ac-add-timer)
(add-hook 'article-mode-hook 'ac-article-mode-entry)

(provide 'article-mode)