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

     2 

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

     4 

     5 ;; This file is free software; you can redistribute it and/or modify

     6 ;; it under the terms of the GNU General Public License as published by

     7 ;; the Free Software Foundation; either version 3, or (at your option)

     8 ;; any later version.

     9 

    10 ;; This file is distributed in the hope that it will be useful,

    11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

    12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    13 ;; GNU General Public License for more details.

    14 

    15 ;; You should have received a copy of the GNU General Public License

    16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

    17 

    18 ;;; Code:

    19 

    20 (defvar checklist-read-checklist-result nil)

    21 (make-variable-buffer-local 'checklist-read-checklist-result)

    22 

    23 (defun checklist-read-checklist (prompt choices)

    24   "Prompt with PROMPT to choose one or more from the list of CHOICES."

    25   (switch-to-buffer (generate-new-buffer-name "checklist"))

    26   (let ((inhibit-read-only t))

    27     (special-mode)

    28     (setq buffer-read-only t)

    29     (setq cursor-type 'box)

    30     (insert (concat prompt "\n\n"))

    31     (use-local-map (copy-keymap special-mode-map))

    32     (local-set-key "n" 'next-line)

    33     (local-set-key "p" 'previous-line)

    34     (local-set-key (kbd "RET") 'checklist-checklist-choose)

    35     (local-set-key (kbd "SPC") 'checklist-checklist-choose)

    36     (local-set-key (kbd "C-c C-c") 'checklist-checklist-done)

    37     (save-excursion

    38       (cl-loop for choice in choices

    39                do (insert (propertize (concat "[ ] " (cdr choice) "\n")

    40                                       'checklist-check-item (car choice))))

    41       (insert "\n")

    42       (insert "Hit " (propertize "C-c C-c" 'face 'bold) " to finish."))

    43     (add-hook 'post-command-hook #'checklist-highlight-section t t)

    44     (setq checklist-read-checklist-result nil)

    45     (recursive-edit)

    46     (let ((result  checklist-read-checklist-result)

    47           (kill-buffer-query-functions nil))

    48       (kill-buffer (current-buffer))

    49       result)))

    50 

    51 (defun checklist-checklist-done ()

    52   "Done with the checklist, return the result."

    53   (interactive)

    54   (throw 'exit nil))

    55 

    56 (defun checklist-highlight-section ()

    57   "Highlight the item at point."

    58   (remove-overlays)

    59   (when (get-text-property (point) 'checklist-check-item)

    60     (let ((o (make-overlay (line-beginning-position)

    61                            (1+ (line-end-position)))))

    62       (overlay-put o 'face 'secondary-selection))))

    63 

    64 (defun checklist-checklist-choose ()

    65   "Choose the current item at point."

    66   (interactive)

    67   (let ((inhibit-read-only t)

    68         (checked (get-text-property (point) 'checklist-item-checked)))

    69     (when (get-text-property (point) 'checklist-check-item)

    70       (if checked

    71           (setq checklist-read-checklist-result

    72                 (delete (get-text-property (point) 'checklist-check-item)

    73                         checklist-read-checklist-result))

    74           (add-to-list 'checklist-read-checklist-result

    75                        (get-text-property (point) 'checklist-check-item)

    76                        t))

    77       (save-excursion (goto-char (line-beginning-position))

    78                       (delete-region (line-beginning-position)

    79                                      (+ (line-beginning-position) (length "[ ]")))

    80                       (if checked

    81                           (insert "[ ]")

    82                         (insert "[x]")))

    83       (put-text-property (line-beginning-position)

    84                          (1+ (line-end-position))

    85                          'checklist-item-checked (not checked))

    86       (put-text-property (line-beginning-position)

    87                          (1+ (line-end-position))

    88                          'face (if checked nil 'bold))

    89       (put-text-property (line-beginning-position)

    90                          (1+ (line-end-position))

    91                          'checklist-check-item t)

    92       (checklist-highlight-section))))

    93 

    94 (provide 'checklist)