super-duper-yes-or-no.el (12390B)
1 ;;; super-duper-yes-or-no.el --- A "better"(?) yes-or-no-p. -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2023 Yuval Langer 4 5 ;; Author: Yuval Langer <yuval.langer@gmail.com> 6 ;; Version: 1.0.0 7 ;; Keywords: 8 ;; URL: https://sr.ht/~kakafarm/super-duper-yes-or-no/ 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; Usage: 26 ;; 27 ;; To replace yes-or-no-p with random sequences of words: 28 ;; 29 ;; (defalias 'yes-or-no-p 30 ;; 'super-duper-yes-or-no-yes-or-no-words-p) 31 ;; 32 ;; To replace yes-or-no-p with uppercase letters hunts: 33 ;; 34 ;; (defalias 'yes-or-no-p 35 ;; 'super-duper-yes-or-no-yes-or-no-toggle-case-p) 36 ;; 37 ;; To replace yes-or-no-p with arithmetic problems: 38 ;; 39 ;; (defalias 'yes-or-no-p 40 ;; 'super-duper-yes-or-no-yes-or-no-arithmetic-problem-p) 41 42 ;;; Code: 43 44 (require 'cl-lib) 45 46 (defcustom sd-number-of-words 2 47 "Number of words in the `sd-yes-or-no-words-p' words sequences." 48 :type 'natnum 49 :group 'super-duper-yes-or-no) 50 51 (defvar sd-words 52 ["aaaaa" 53 "moo" 54 "foo" 55 "bar"] 56 "Words to be used by `sd-yes-or-no-words-p'. 57 58 The default vector here is just an example - you could replace it 59 with a longer and better vector of words, like one of the 60 Diceware wordlists (https://diceware.dmuth.org/), or one of the 61 EFF wordlists (https://www.eff.org/dice).") 62 63 (defcustom sd-upper-case-phrase-for-yes 64 "(If you understand what you're doing, enter the capitalized letters here for \"yes\")" 65 "Phrase to be used by the \"yes\" prong of `sd-yes-or-no-toggle-case-p'." 66 :type 'string 67 :group 'super-duper-yes-or-no) 68 69 (defcustom sd-upper-case-phrase-for-no 70 "(If you understand what you're doing, enter the capitalized letters here for \"no\")" 71 "Phrase to be used by the \"no\" prong of `sd-yes-or-no-toggle-case-p'." 72 :type 'string 73 :group 'super-duper-yes-or-no) 74 75 (defcustom sd-number-of-case-toggle-characters 4 76 "Number of English ASCII chars toggled in a phrase. 77 78 This number is used in `sd-yes-or-no-toggle-case-p'." 79 :type 'natnum 80 :group 'super-duper-yes-or-no) 81 82 (defcustom sd-arithmetic-problem-minimum 83 0 84 "Smallest integer to be used in `sd-yes-or-no-arithmetic-problem-p'." 85 :type 'integer 86 :group 'super-duper-yes-or-no) 87 88 (defcustom sd-arithmetic-problem-maximum 89 10 90 "Biggest integer to be used in `sd-yes-or-no-arithmetic-problem-p'." 91 :type 'integer 92 :group 'super-duper-yes-or-no) 93 94 (defcustom sd-arithmetic-problem-template 95 '(+ (* 0 0) 96 (* 0 0)) 97 "Template used to create arithmetic problems. 98 99 Used by `sd-yes-or-no-arithmetic-problem-p'. 100 101 The atomic arguments are replaced by integers and the functions 102 stay unchanged." 103 :type 'list 104 :group 'super-duper-yes-or-no) 105 106 (defcustom sd-two-prongs nil 107 "If t, ask for two hard to enter inputs, otherwise ask only for the affermative." 108 :type 'bool 109 :group 'super-duper-yes-or-no) 110 111 (defun sd--randint (minimum maximum) 112 "Return an integer between MINIMUM (inclusive) and MAXIMUM (exclusive)." 113 114 (+ minimum 115 (random (- maximum 116 minimum)))) 117 118 (defun sd--make-random-input-string (wanted-number-of-words) 119 "Make a list of words, WANTED-NUMBER-OF-WORDS long. 120 121 Used in the `sd-yes-or-no-words-p' function." 122 (cl-loop 123 with wordlist-size = 124 (seq-length sd-words) 125 126 for random-word-index = 127 (random wordlist-size) 128 129 for random-word = 130 (aref sd-words 131 random-word-index) 132 133 repeat wanted-number-of-words 134 135 collect random-word)) 136 137 (defun sd--make-random-yes-or-no-input-pair (number-of-words) 138 "Make two different word lists, each NUMBER-OF-WORDS long. 139 140 Used in super-duper-yes-or-no-words-p function." 141 (cl-loop 142 with yes-input = 143 (sd--make-random-input-string 144 number-of-words) 145 146 for no-input = 147 (sd--make-random-input-string 148 number-of-words) 149 150 while 151 (equal yes-input 152 no-input) 153 154 finally return 155 (list yes-input 156 no-input))) 157 158 (defun sd--list-intersperse (input-list intersperser) 159 "Return INPUT-LIST interspersed with INTERSPERSER. 160 161 Examples: 162 163 \\='(sd--list-intersperse \\='() \\='d) returns \\='() 164 \\='(sd--list-intersperse \\='(a) \\='d) returns \\='(a) 165 \\='(sd--list-intersperse \\='(a b) \\='d) returns \\='(a d b) 166 \\='(sd--list-intersperse \\='(a b c) \\='d) returns \\='(a d b d c)" 167 (if (null input-list) 168 '() 169 (cons (car input-list) 170 (cl-loop 171 for item 172 in (cdr input-list) 173 174 append 175 (list intersperser item))))) 176 177 (defun sd-yes-or-no-words-p (prompt) 178 "Ask user a yes or no question. 179 180 Display in minibuffer PROMPT followed by a sequence of words the 181 user must enter to choose yes. 182 183 If the variable `sd-two-prongs' is t, ask two sequences, one for 184 the affermative and one for the negative." 185 (cl-loop 186 for wanted-yes-or-no = 187 (super-duper-yes-or-no--make-random-yes-or-no-input-pair 188 super-duper-yes-or-no-number-of-words) 189 190 for wanted-yes = 191 (car wanted-yes-or-no) 192 193 for wanted-no = 194 (if sd-two-prongs 195 (cadr wanted-yes-or-no) 196 (list "no")) 197 198 for wanted-yes-string = 199 (apply 'concat 200 (super-duper-yes-or-no--list-intersperse 201 wanted-yes 202 " ")) 203 204 for wanted-no-string = 205 (apply 'concat 206 (super-duper-yes-or-no--list-intersperse 207 wanted-no 208 " ")) 209 210 for user-input = 211 (read-from-minibuffer 212 (concat prompt 213 "(Enter \"" 214 wanted-yes-string 215 "\" for yes, \"" 216 wanted-no-string 217 "\" for no) ")) 218 219 until 220 (or (equal user-input 221 wanted-yes-string) 222 (equal user-input 223 wanted-no-string)) 224 225 finally return 226 (equal user-input 227 wanted-yes-string))) 228 229 (defun sd--toggle-char-case (our-char) 230 "Return the opposite case of OUR-CHAR. 231 232 Examples: 233 234 - (sd--toggle-char-case ?a) returns ?A 235 - (sd--toggle-char-case ?B) returns ?b" 236 (cond 237 ((char-uppercase-p our-char) 238 (downcase our-char)) 239 (t 240 (upcase our-char)))) 241 242 (defun sd--randomly-toggle-string-case (input-string number-of-chars-to-toggle) 243 "Toggle a number of chars' case in a string. 244 245 A NUMBER-OF-CHARS-TO-TOGGLE chars will be selected at random from 246 INPUT-STRING. Then function returns INPUT-STRING, with the 247 selected chars' case toggled. 248 249 NUMBERS-OF-CHARS-TO-TOGGLE MUST be less or equal to the number of 250 English ASCII chars in INPUT-STRING - other chars do not count in 251 the toggle count AND they are not toggled." 252 (let* ((input-length (length input-string)) 253 (our-shuffled-positions 254 (cl-loop 255 with our-positions = 256 (number-sequence 0 (1- input-length)) 257 258 for wanted-position-index = 259 (random (length our-positions)) 260 261 for wanted-position = 262 (nth wanted-position-index 263 our-positions) 264 265 for position-char = 266 (aref input-string 267 wanted-position) 268 269 when 270 (or (<= ?a 271 position-char 272 ?z) 273 (<= ?A 274 position-char 275 ?Z)) 276 277 do 278 (setq our-positions 279 (delq wanted-position 280 our-positions)) 281 282 repeat number-of-chars-to-toggle 283 284 collect wanted-position))) 285 286 (concat 287 (cl-loop 288 for input-char 289 across input-string 290 291 for input-string-position 292 in (number-sequence 0 293 (1- input-length)) 294 295 collect 296 (if (member 297 input-string-position 298 our-shuffled-positions) 299 (sd--toggle-char-case input-char) 300 input-char))))) 301 302 (defun sd--string-only-uppercase (input-string) 303 "Return INPUT-STRING with only the uppercase chars." 304 (cl-loop 305 for input-char 306 across input-string 307 when (char-uppercase-p input-char) 308 concat (char-to-string input-char))) 309 310 (defun sd-yes-or-no-toggle-case-p (prompt) 311 "Ask user a yes or no question, but expect the uppercase letters. 312 313 Display in minibuffer PROMPT followed by a string with some of 314 its letters' case flipped. Enter the uppercase letters found in 315 sequence for the affermative and \"no\" for the negative. 316 317 If `sd-two-prongs' is t, provides the user with two of such 318 strings. Enter the second one's uppercase letters for the 319 negative." 320 (cl-loop 321 for wanted-yes-prompt = 322 (sd--randomly-toggle-string-case 323 sd-upper-case-phrase-for-yes 324 sd-number-of-case-toggle-characters) 325 326 for wanted-no-prompt = 327 (if sd-two-prongs 328 (sd--randomly-toggle-string-case 329 sd-upper-case-phrase-for-no 330 sd-number-of-case-toggle-characters) 331 "(Enter \"no\" for no)") 332 333 for wanted-input-yes = 334 (sd--string-only-uppercase 335 wanted-yes-prompt) 336 337 for wanted-input-no = 338 (if sd-two-prongs 339 (sd--string-only-uppercase 340 wanted-no-prompt) 341 "no") 342 343 while 344 (equal wanted-input-yes 345 wanted-input-no) 346 347 finally return 348 (cl-loop 349 for user-input = 350 (read-from-minibuffer 351 (concat prompt 352 wanted-yes-prompt 353 "\n" 354 wanted-no-prompt 355 ":\n")) 356 357 until (or (equal user-input 358 wanted-input-yes) 359 (equal user-input 360 wanted-input-no)) 361 362 finally return 363 (equal user-input 364 wanted-input-yes)))) 365 366 (defun sd--make-arithmetic-problem-number () 367 "Return a random integer number between the two variables. 368 `sd-arithmetic-problem-minimum' and `sd-arithmetic-problem-maximum'." 369 (sd--randint sd-arithmetic-problem-minimum 370 (1+ sd-arithmetic-problem-maximum))) 371 372 (defun sd--make-arithmetic-problem-arguments (argument-list) 373 "Return ARGUMENT-LIST in an arithmetic problem with actual integer values." 374 (cl-loop 375 for argument 376 in argument-list 377 378 collect 379 (if (atom argument) 380 (sd--make-arithmetic-problem-number) 381 (sd--make-arithmetic-problem 382 argument)))) 383 384 (defun sd--make-arithmetic-problem (arithmetic-expression-template) 385 "Make an arithmetic problem using an ARITHMETIC-EXPRESSION-TEMPLATE." 386 (cond 387 ((null arithmetic-expression-template) '()) 388 (t (cons (car arithmetic-expression-template) 389 (sd--make-arithmetic-problem-arguments 390 (cdr arithmetic-expression-template)))))) 391 392 (defun sd-yes-or-no-arithmetic-problem-p (prompt) 393 "Ask user a yes or no question, but as an answer to an arithmetic expression. 394 395 Display in minibuffer PROMPT followed by an arithmetic 396 expression. Enter the answer to the expression for affermitive 397 and \"no\" for the negative. 398 399 If `sd-two-prongs' us t, two arithmetic expressions appear, 400 enter the second's result for the negative." 401 (cl-loop 402 for wanted-yes-prompt = 403 (sd--make-arithmetic-problem 404 sd-arithmetic-problem-template) 405 406 for wanted-no-prompt = 407 (if sd-two-prongs 408 (sd--make-arithmetic-problem 409 sd-arithmetic-problem-template) 410 "no") 411 412 for wanted-input-yes = 413 (number-to-string (eval wanted-yes-prompt)) 414 415 for wanted-input-no = 416 (if sd-two-prongs 417 (number-to-string (eval wanted-no-prompt)) 418 "no") 419 420 while 421 (equal wanted-input-yes 422 wanted-input-no) 423 424 finally return 425 (cl-loop 426 for user-input = 427 428 (read-from-minibuffer 429 (concat prompt 430 "Please answer " 431 (format "%S" wanted-yes-prompt) 432 " for \"yes\" and " 433 (format "%S" wanted-no-prompt) 434 " for \"no\": " 435 (format "%s" (list wanted-input-yes 436 wanted-input-no)))) 437 438 until 439 (or (equal user-input 440 wanted-input-yes) 441 (equal user-input 442 wanted-input-no)) 443 444 finally return 445 (equal user-input 446 wanted-input-yes)))) 447 448 (provide 'super-duper-yes-or-no) 449 450 ;; Local Variables: 451 ;; read-symbol-shorthands: (("sd-" . "super-duper-yes-or-no-")) 452 ;; End: 453 ;;; super-duper-yes-or-no.el ends here