;;; survey.el
;;;
;;; Copyright (C) 1999, 2004, 2007, 2008 Thien-Thi Nguyen
;;;
;;; This file is part of ttn's personal elisp library, released 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.  There is NO WARRANTY.  See file COPYING for details.

;;; Description: Conduct survey and email results.

;;;---------------------------------------------------------------------------
;;; Variables

(require 'sendmail)

(defvar survey-results-buffer "*Survey Results*"
  "Buffer accumulating survey results.")

(defvar survey-gatherers nil
  "Functions that take QUESTION, display it to the user, collect
an answer and arrange for the question and answer to be appended
to `survey-results-buffer'.")

(defvar survey-last-answer nil
  "The last answer for `survey-y-or-n-p', `survey-yes-or-no-p' and
`survey-multiple-choice' type gatherers.  In the first two cases, it
is either t or nil, in the last case it is an integer starting with 1.
Custom gatherers may also set this variable (using `setq').")

;;;---------------------------------------------------------------------------
;;; Support functions

(defun survey-init ()
  "Prepare `survey-results-buffer' for a survey."
  (when (get-buffer survey-results-buffer)
    (kill-buffer survey-results-buffer)))

(defun survey-display-question (question)
  "Display QUESTION, a string, in a new buffer."
  (switch-to-buffer "*Survey Question*")
  (erase-buffer)
  (insert question "\n")
  (apply-macro-to-region-lines (point-min) (point-max) ";;;;;; "))

(defun survey-simple-answer (question predicate)
  "Display QUESTION in a buffer, call PREDICATE, save result."
  (survey-display-question question)
  (insert (if (setq survey-last-answer (funcall predicate "")) "y" "n") "\n")
  (append-to-buffer survey-results-buffer (point-min) (point-max))
  (kill-buffer nil))

(defun survey-y-or-n-p (question)
  "Display QUESTION in buffer, call `y-or-n-p', save result."
  (survey-simple-answer question 'y-or-n-p))

(defun survey-yes-or-no-p (question)
  "Display QUESTION in buffer, call `yes-or-no-p', save result."
  (survey-simple-answer question 'yes-or-no-p))

(defun survey-freeform (question)
  "Display QUESTION in a new buffer, and go into Survey Freeform mode.
In this mode, `C-c C-c' finishes the entry, appending the entire buffer
`survey-results-buffer'."
  (survey-display-question question)
  (setq major-mode 'survey-freeform-mode)
  (setq mode-name "Survey Freeform")
  (use-local-map (copy-keymap text-mode-map))
  (local-set-key "\C-c\C-c" 'survey-freeform-finish)
  (message "Type answer then `C-c C-c' to continue.")
  (recursive-edit))

(defun survey-freeform-finish ()
  "Finish the entry, appending current buffer to `survey-results-buffer'."
  (interactive)
  (when (eq major-mode 'survey-freeform-mode)
    (goto-char (point-max))
    (insert "\n")
    (append-to-buffer survey-results-buffer (point-min) (point-max))
    (kill-buffer nil)
    (exit-recursive-edit)))

(defun survey-multiple-choice (question &rest choices)
  (let ((i 1) (q question) (cc '()))
    (dolist (choice choices)
      (setq q (format "%s\n(%d) %s" q i choice))
      (setq cc (cons (char-to-string (+ i ?0)) cc))
      (setq i (1+ i)))
    (survey-display-question q)
    (let (ans (range (format "(1 - %d)" (length choices))))
      (while (progn (message range)
                    (setq ans (char-to-string (read-char))) ; loses for 10+
                    (not (member ans cc)))
        (message "Please type a number in the range %s" range)
        (sit-for 2))
      (setq survey-last-answer (string-to-number ans))
      (insert ans "\n"))
    (append-to-buffer survey-results-buffer (point-min) (point-max))
    (kill-buffer nil)))

(defun survey-ask (gatherer question &rest extra-args)
  "Apply GATHERER to QUESTION, a string, and optional EXTRA-ARGS.
GATHERER must be registered in `survey-gatherers'."
  (if (memq gatherer survey-gatherers)
      (apply gatherer question extra-args)
    (error "Gatherer %s not in `survey-gatherers'" gatherer)))

(defun survey-mail-results (recip subject &optional for-sure)
  "Email survey results to RECIP w/ SUBJECT and kill results buffer.
Optional third arg FOR-SURE, if non-nil, inhibits user confirmation."
  (switch-to-buffer survey-results-buffer)
  (goto-char (point-min))
  (if (or for-sure
          (y-or-n-p (format "Survey done, send results to %s? " recip)))
      (progn
        (compose-mail recip subject)
        (insert-buffer-substring survey-results-buffer)
        (mail-send-and-exit t)
        (kill-buffer survey-results-buffer))
    (setq major-mode 'survey-results-mode)
    (setq mode-name "Survey Results")
    (use-local-map (copy-keymap text-mode-map))
    (put-text-property (point-min) (point-max)
                       'survey-mail-args (list recip subject t))
    (local-set-key "\C-c\C-c" (lambda ()
                                (interactive)
                                (apply 'survey-mail-results
                                       (get-text-property
                                        (point-min) 'survey-mail-args))))
    (message "When ready, type `C-c C-c' in this buffer to send results.")))

;;;---------------------------------------------------------------------------
;;; Load-time actions

(unless survey-gatherers
  (setq survey-gatherers
        '(survey-y-or-n-p
          survey-yes-or-no-p
          survey-freeform
          survey-multiple-choice)))

(provide 'survey)

;;;---------------------------------------------------------------------------
;;; Testing

; (progn
;   (survey-init)
;   (map-table-2col
;    'survey-ask
;    '(survey-yes-or-no-p "Do you find surveys annoying?"
;      survey-y-or-n-p "Is this almost over?"
;      survey-freeform "Name the weirdest question you've seen."))
;   (survey-mail-results "ttn" "nothing is real"))

;;; survey.el ends here