2 files changed, 73 insertions(+), 6 deletions(-)

M README.md
M time-block.el

@@ 94,6 94,17 @@ workday.
 (advice-add 'buffer-sets-load-set :around #'my/buffer-sets-around-advice)
 ```
 
+### Confirmation Functions
+
+When  an  automatically-advised  function  or  function  defined  with
+`define-time-block-command` provides  an override prompt,  an override
+confirmation function (`time-block-confirmation-function`)  is used to
+ensure that you want to  override it.  This defaults to `yes-or-no-p`,
+but   two  additional   functions   are   provided  for   convenience:
+`time-block-command-math-question` which  will ask a  basic arithmatic
+question,  and  `time-block-command-random-string`  which  requires  a
+16-32 character string be retyped.
+
 ## Errors and Bugs
 
 If you find an error or a bug, send an email to

@@ 2,7 2,7 @@
 
 ;; Author: Samuel W. Flint <swflint@flintfam.org>
 ;; URL: https://git.sr.ht/~swflint/time-block
-;; Version: 1.2.2
+;; Version: 1.3.0
 ;; Package-Requires: ((emacs "25.1") (ts "0.1"))
 ;; Keywords: tools, productivity, convenience
 ;; SPDX-FileCopyrightText: 2022 Samuel W. Flint <swflint@flintfam.org>


@@ 103,6 103,18 @@
 ;;                (not (yes-or-no-p "You have decided not to edit your emacs configuration at this time.\nContinue?")))
 ;;     (funcall orig name)))
 ;; (advice-add 'buffer-sets-load-set :around #'my/buffer-sets-around-advice)
+;;
+;;;; Confirmation Functions
+;;
+;; When an automatically-advised function or function defined with
+;; `define-time-block-command' provides an override prompt, an
+;; override confirmation function (`time-block-confirmation-function')
+;; is used to ensure that you want to override it.  This defaults to
+;; `yes-or-no-p', but two additional functions are provided for
+;; convenience: `time-block-command-math-question' which will ask a
+;; basic arithmatic question, and `time-block-command-random-string'
+;; which requires a 16-32 character string be retyped.
+;;
 
 (require 'ts)
 (require 'cl-lib)


@@ 159,6 171,21 @@ skipped; if a regexp, only holidays matching will be skipped."
                  (repeat :tag "Listed holidays" string)
                  (const :tag "All holidays" t)))
 
+(defcustom time-block-confirmation-function #'yes-or-no-p
+  "What command should be used to confirm overrides of time-blocked commands.
+
+This function should return nil if no override, t if override,
+and take one argument, a PROMPT.  This defaults to `yes-or-no-p',
+but the `time-block-command-math-question' and
+`time-block-command-random-string' functions may be used as
+well."
+  :group 'time-block
+  :type '(choice
+          (const :tag "Yes or No" yes-or-no-p)
+          (const :tag "Math Question" time-block-command-math-question)
+          (const :tag "Type Random String" time-block-command-random-string)
+          (function :tag "Arbitrary Function")))
+
 
 ;; Utility Functions
 


@@ 200,6 227,34 @@ skipped; if a regexp, only holidays matching will be skipped."
 (make-obsolete 'timeblock-define-block-command 'define-time-blocked-command "time-block 0.1.0")
 
 
+;; Alternative block commands
+
+(defun time-block-command-math-question (prompt)
+  "Ask to override with PROMPT and a math problem.
+
+If user elects to override, then use a math problem (addition,
+multiplication, subtraction) to override."
+  (let* ((a (random 100))
+         (b (random 100))
+         (op (seq-random-elt (list '* '+ '-)))
+         (ans (funcall op a b)))
+    (and (yes-or-no-p (format-message prompt))
+         (= ans (read-number (format-message "Are you sure?\n%d %s %d = " a op b))))))
+
+(defun time-block-command-random-string (prompt)
+  "Ask to override with PROMPT and typing of random string.
+
+If user elects to override, then require a random 16-32 character
+string is typed exactly to override."
+  (let* ((length (+ 16 (random 17)))
+         (characters (cl-loop for i from 1 to length
+                              collect (+ 33 (random 94))))
+         (string (mapconcat #'(lambda (x) (format "%c" x)) characters nil)))
+    (and (yes-or-no-p (format-message prompt))
+         (string= string
+                  (read-string (format-message "Please type the string `%s': " string))))))
+
+
 ;; Main definition macro
 
 (cl-defmacro define-time-blocked-command (name argslist (group block-message &optional override-prompt) &body body)


@@ 214,7 269,7 @@ whether or not to run.
 BLOCK-MESSAGE is the message to show when run is blocked.
 
 If OVERRIDE-PROMPT is present, then ask if blocking should be
-overriden.
+overriden using `time-block-confirmation-function'.
 
 BODY is the body of the code.  This should include an
 `interactive' specification matching \\=ARGSLIST.


@@ 234,7 289,7 @@ BODY is the body of the code.  This should include an
          (body (if interactive-spec (cl-rest body) body))
          (condition (if override-prompt
                         `(and (time-block-group-blocked-p ,group)
-                              (not (yes-or-no-p ,override-prompt)))
+                              (not (funcall time-block-confirmation-function ,override-prompt)))
                       `(time-block-group-blocked-p ,group))))
     (if docstring
         `(defun ,name ,argslist


@@ 256,11 311,12 @@ BODY is the body of the code.  This should include an
   "Define `:around' advice for COMMAND called ADVICE-NAME.
 
 Use BLOCK-MESSAGE to notify user if run is currently blocked by
-GROUP.  If OVERRIDE-PROMPT is present, use `yes-or-no-p' to ask
-if blocking should be overridden."
+GROUP.  If OVERRIDE-PROMPT is present, use
+`time-block-confirmation-function' to ask if blocking should be
+overridden."
   (let ((condition (if override-prompt
                        `(and (time-block-group-blocked-p ,group)
-                             (not (yes-or-no-p ,override-prompt)))
+                             (not (funcall time-block-confirmation-function ,override-prompt)))
                      `(time-block-group-blocked-p ,group))))
     `(progn
        (defun ,advice-name (orig &rest args)