diff -r f3334abf4322 -r e848f1863d6b elisp/stack-mode/checklist.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/elisp/stack-mode/checklist.el Wed Sep 16 16:53:07 2015 -0500 @@ -0,0 +1,94 @@ +;;; 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 . + +;;; 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)