;;; checklist.el --- Simple checklist UI functionality

;; Copyright (c) 2015 Chris Done. All rights reserved.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(defvar checklist-read-checklist-result nil)
(make-variable-buffer-local 'checklist-read-checklist-result)

(defun checklist-read-checklist (prompt choices)
  "Prompt with PROMPT to choose one or more from the list of CHOICES."
  (switch-to-buffer (generate-new-buffer-name "checklist"))
  (let ((inhibit-read-only t))
    (special-mode)
    (setq buffer-read-only t)
    (setq cursor-type 'box)
    (insert (concat prompt "\n\n"))
    (use-local-map (copy-keymap special-mode-map))
    (local-set-key "n" 'next-line)
    (local-set-key "p" 'previous-line)
    (local-set-key (kbd "RET") 'checklist-checklist-choose)
    (local-set-key (kbd "SPC") 'checklist-checklist-choose)
    (local-set-key (kbd "C-c C-c") 'checklist-checklist-done)
    (save-excursion
      (cl-loop for choice in choices
               do (insert (propertize (concat "[ ] " (cdr choice) "\n")
                                      'checklist-check-item (car choice))))
      (insert "\n")
      (insert "Hit " (propertize "C-c C-c" 'face 'bold) " to finish."))
    (add-hook 'post-command-hook #'checklist-highlight-section t t)
    (setq checklist-read-checklist-result nil)
    (recursive-edit)
    (let ((result  checklist-read-checklist-result)
          (kill-buffer-query-functions nil))
      (kill-buffer (current-buffer))
      result)))

(defun checklist-checklist-done ()
  "Done with the checklist, return the result."
  (interactive)
  (throw 'exit nil))

(defun checklist-highlight-section ()
  "Highlight the item at point."
  (remove-overlays)
  (when (get-text-property (point) 'checklist-check-item)
    (let ((o (make-overlay (line-beginning-position)
                           (1+ (line-end-position)))))
      (overlay-put o 'face 'secondary-selection))))

(defun checklist-checklist-choose ()
  "Choose the current item at point."
  (interactive)
  (let ((inhibit-read-only t)
        (checked (get-text-property (point) 'checklist-item-checked)))
    (when (get-text-property (point) 'checklist-check-item)
      (if checked
          (setq checklist-read-checklist-result
                (delete (get-text-property (point) 'checklist-check-item)
                        checklist-read-checklist-result))
          (add-to-list 'checklist-read-checklist-result
                       (get-text-property (point) 'checklist-check-item)
                       t))
      (save-excursion (goto-char (line-beginning-position))
                      (delete-region (line-beginning-position)
                                     (+ (line-beginning-position) (length "[ ]")))
                      (if checked
                          (insert "[ ]")
                        (insert "[x]")))
      (put-text-property (line-beginning-position)
                         (1+ (line-end-position))
                         'checklist-item-checked (not checked))
      (put-text-property (line-beginning-position)
                         (1+ (line-end-position))
                         'face (if checked nil 'bold))
      (put-text-property (line-beginning-position)
                         (1+ (line-end-position))
                         'checklist-check-item t)
      (checklist-highlight-section))))

(provide 'checklist)