lisp/type-break.el

   1 ;;; type-break.el --- encourage rests from typing at appropriate intervals
   2
   3 ;;; Copyright (C) 1994 Noah S. Friedman
   4
   5 ;;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
   6 ;;; Maintainer: friedman@prep.ai.mit.edu
   7 ;;; Keywords: extensions, timers
   8 ;;; Status: known to work in GNU Emacs 19.25 or later.
   9 ;;; Created: 1994-07-13
  10
  11 ;;; LCD Archive Entry:
  12 ;;; type-break|Noah Friedman|friedman@prep.ai.mit.edu|
  13 ;;; encourage rests from typing at appropriate intervals|
  14 ;;; $Date$|$Revision$||
  15
  16 ;;; $Id$
  17
  18 ;;; This program is free software; you can redistribute it and/or modify
  19 ;;; it under the terms of the GNU General Public License as published by
  20 ;;; the Free Software Foundation; either version 2, or (at your option)
  21 ;;; any later version.
  22 ;;;
  23 ;;; This program is distributed in the hope that it will be useful,
  24 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  25 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26 ;;; GNU General Public License for more details.
  27 ;;;
  28 ;;; You should have received a copy of the GNU General Public License
  29 ;;; along with this program; if not, you can either send email to this
  30 ;;; program's maintainer or write to: The Free Software Foundation,
  31 ;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  32
  33 ;;; Commentary:
  34
  35 ;;; The docstring for the function `type-break-mode' summarizes most of the
  36 ;;; details of the interface.
  37
  38 ;;; This package relies on the assumption that you live entirely in emacs,
  39 ;;; as the author does.  If that's not the case for you (e.g. you often
  40 ;;; suspend emacs or work in other windows) then this won't help very much;
  41 ;;; it will depend on just how often you switch back to emacs.  At the very
  42 ;;; least, you will want to turn off the keystroke thresholds and rest
  43 ;;; interval tracking.
  44
  45 ;;; This package was inspired by Roland McGrath's hanoi-break.el.
  46 ;;; Thanks to both Roland McGrath <roland@gnu.ai.mit.edu> and Mark Ashton
  47 ;;; <mpashton@gnu.ai.mit.edu> for feedback and ideas.
  48
  49 ;;; Code:
  50
  51 \f
  52 (require 'timer)
  53
  54 ;; Make this nil initially so that the call to type-break-mode at the end
  55 ;; will cause scheduling and so forth to happen.
  56 ;;;###autoload
  57 (defvar type-break-mode nil
  58   "*Non-`nil' means typing break mode is enabled.
  59 See the docstring for the `type-break-mode' command for more information.")
  60
  61 ;;;###autoload
  62 (defvar type-break-interval (* 60 60)
  63   "*Number of seconds between scheduled typing breaks.")
  64
  65 ;;;###autoload
  66 (defvar type-break-good-rest-interval (/ type-break-interval 6)
  67   "*Number of seconds of idle time considered to be an adequate typing rest.
  68
  69 When this variable is non-`nil', emacs checks the idle time between
  70 keystrokes.  If this idle time is long enough to be considered a \"good\"
  71 rest from typing, then the next typing break is simply rescheduled for later.
  72
  73 If a break is interrupted before this much time elapses, the user will be
  74 asked whether or not really to interrupt the break.")
  75
  76 ;;;###autoload
  77 (defvar type-break-keystroke-threshold
  78   ;; Assuming typing speed is 35wpm (on the average, do you really
  79   ;; type more than that in a minute?  I spend a lot of time reading mail
  80   ;; and simply studying code in buffers) and average word length is
  81   ;; about 5 letters, default upper threshold to the average number of
  82   ;; keystrokes one is likely to type in a break interval.  That way if the
  83   ;; user goes through a furious burst of typing activity, cause a typing
  84   ;; break to be required sooner than originally scheduled.
  85   ;; Conversely, the minimum threshold should be about a fifth of this.
  86   (let* ((wpm 35)
  87          (avg-word-length 5)
  88          (upper (* wpm avg-word-length (/ type-break-interval 60)))
  89          (lower (/ upper 5)))
  90     (cons lower upper))
  91   "*Upper and lower bound on number of keystrokes for considering typing break.
  92 This structure is a pair of numbers.
  93
  94 The first number is the minimum number of keystrokes that must have been
  95 entered since the last typing break before considering another one, even if
  96 the scheduled time has elapsed; the break is simply rescheduled until later
  97 if the minimum threshold hasn't been reached.  If this first value is nil,
  98 then there is no minimum threshold; as soon as the scheduled time has
  99 elapsed, the user will always be queried.
 100
 101 The second number is the maximum number of keystrokes that can be entered
 102 before a typing break is requested immediately, pre-empting the originally
 103 scheduled break.  If this second value is nil, then no pre-emptive breaks
 104 will occur; only scheduled ones will.
 105
 106 Keys with bucky bits (shift, control, meta, etc) are counted as only one
 107 keystroke even though they really require multiple keys to generate them.")
 108
 109 (defvar type-break-time-warning-intervals '(300 120 60 30)
 110   "*List of time intervals for warnings about upcoming typing break.
 111 At each of the intervals (specified in seconds) away from a scheduled
 112 typing break, print a warning in the echo area.")
 113
 114 (defvar type-break-keystroke-warning-intervals '(300 200 100 50)
 115   "*List of keystroke measurements for warnings about upcoming typing break.
 116 At each of the intervals (specified in keystrokes) away from the upper
 117 keystroke threshold, print a warning in the echo area.
 118 If either this variable or the upper threshold is set, then no warnings
 119 Will occur.")
 120
 121 (defvar type-break-query-interval 60
 122   "*Number of seconds between queries to take a break, if put off.
 123 The user will continue to be prompted at this interval until he or she
 124 finally submits to taking a typing break.")
 125
 126 (defvar type-break-warning-repeat 40
 127   "*Number of keystrokes for which warnings should be repeated.
 128 That is, for each of this many keystrokes the warning is redisplayed
 129 in the echo area to make sure it's really seen.")
 130
 131 (defvar type-break-query-function 'yes-or-no-p
 132   "Function to use for making query for a typing break.
 133 It should take a string as an argument, the prompt.
 134 Usually this should be set to `yes-or-no-p' or `y-or-n-p'.")
 135
 136 (defvar type-break-demo-functions
 137   '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi)
 138   "*List of functions to consider running as demos during typing breaks.
 139 When a typing break begins, one of these functions is selected randomly
 140 to have emacs do something interesting.
 141
 142 Any function in this list should start a demo which ceases as soon as a
 143 key is pressed.")
 144
 145 (defvar type-break-post-command-hook nil
 146   "Hook run indirectly by post-command-hook for typing break functions.")
 147
 148 ;; These are internal variables.  Do not set them yourself.
 149
 150 (defvar type-break-alarm-p nil)
 151 (defvar type-break-keystroke-count 0)
 152 (defvar type-break-time-last-break nil)
 153 (defvar type-break-time-next-break nil)
 154 (defvar type-break-time-last-command (current-time))
 155 (defvar type-break-current-time-warning-interval nil)
 156 (defvar type-break-current-keystroke-warning-interval nil)
 157 (defvar type-break-time-warning-count 0)
 158 (defvar type-break-keystroke-warning-count 0)
 159
 160 \f
 161 ;;;###autoload
 162 (defun type-break-mode (&optional prefix)
 163   "Enable or disable typing-break mode.
 164 This is a minor mode, but it is global to all buffers by default.
 165
 166 When this mode is enabled, the user is encouraged to take typing breaks at
 167 appropriate intervals; either after a specified amount of time or when the
 168 user has exceeded a keystroke threshold.  When the time arrives, the user
 169 is asked to take a break.  If the user refuses at that time, emacs will ask
 170 again in a short period of time.  The idea is to give the user enough time
 171 to find a good breaking point in his or her work, but be sufficiently
 172 annoying to discourage putting typing breaks off indefinitely.
 173
 174 A negative prefix argument disables this mode.
 175 No argument or any non-negative argument enables it.
 176
 177 The user may enable or disable this mode by setting the variable of the
 178 same name, though setting it in that way doesn't reschedule a break or
 179 reset the keystroke counter.
 180
 181 If the mode was previously disabled and is enabled as a consequence of
 182 calling this function, it schedules a break with `type-break-schedule' to
 183 make sure one occurs (the user can call that command to reschedule the
 184 break at any time).  It also initializes the keystroke counter.
 185
 186 The variable `type-break-interval' specifies the number of seconds to
 187 schedule between regular typing breaks.  This variable doesn't directly
 188 affect the time schedule; it simply provides a default for the
 189 `type-break-schedule' command.
 190
 191 If set, the variable `type-break-good-rest-interval' specifies the minimum
 192 amount of time which is considered a reasonable typing break.  Whenever
 193 that time has elapsed, typing breaks are automatically rescheduled for
 194 later even if emacs didn't prompt you to take one first.  Also, if a break
 195 is ended before this much time has elapsed, the user will be asked whether
 196 or not to continue.
 197
 198 The variable `type-break-keystroke-threshold' is used to determine the
 199 thresholds at which typing breaks should be considered.  You can use
 200 the command `type-break-guestimate-keystroke-threshold' to try to
 201 approximate good values for this.
 202
 203 Finally, the command `type-break-statistics' prints interesting things."
 204   (interactive "P")
 205   ;; make sure it's there.
 206   (add-hook 'post-command-hook 'type-break-run-tb-post-command-hook 'append)
 207   (add-hook 'type-break-post-command-hook 'type-break-check)
 208
 209   (let ((already-enabled type-break-mode))
 210     (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
 211
 212     (cond
 213      ((and already-enabled type-break-mode)
 214       (and (interactive-p)
 215            (message "type-break-mode is enabled")))
 216      (type-break-mode
 217       (type-break-keystroke-reset)
 218       (type-break-schedule)
 219       (and (interactive-p)
 220            (message "type-break-mode is enabled and reset")))
 221      ((interactive-p)
 222       (message "type-break-mode is disabled"))))
 223   type-break-mode)
 224
 225 ;;;###autoload
 226 (defun type-break ()
 227   "Take a typing break.
 228
 229 During the break, a demo selected from the functions listed in
 230 `type-break-demo-functions' is run.
 231
 232 After the typing break is finished, the next break is scheduled
 233 as per the function `type-break-schedule'."
 234   (interactive)
 235   (type-break-cancel-schedule)
 236   (let ((continue t)
 237         (start-time (current-time)))
 238     (setq type-break-time-last-break start-time)
 239     (while continue
 240       (save-window-excursion
 241         ;; Eat the screen.
 242         (and (eq (selected-window) (minibuffer-window))
 243              (other-window 1))
 244         (delete-other-windows)
 245         (scroll-right (window-width))
 246         (message "Press any key to resume from typing break.")
 247
 248         (random t)
 249         (let* ((len (length type-break-demo-functions))
 250                (idx (random len))
 251                (fn (nth idx type-break-demo-functions)))
 252           (condition-case ()
 253               (funcall fn)
 254             (error nil))))
 255
 256       (cond
 257        (type-break-good-rest-interval
 258         (let ((break-secs (type-break-time-difference
 259                            start-time (current-time))))
 260           (cond
 261            ((>= break-secs type-break-good-rest-interval)
 262             (setq continue nil))
 263            ;; Don't be pedantic; if user's rest was only a minute short,
 264            ;; why bother?
 265            ((> 60 (abs (- break-secs type-break-good-rest-interval)))
 266             (setq continue nil))
 267            ((funcall
 268              type-break-query-function
 269              (format "You really ought to rest %s more.  Continue break? "
 270                      (type-break-format-time (- type-break-good-rest-interval
 271                                                 break-secs)))))
 272            (t
 273             (setq continue nil)))))
 274        (t (setq continue nil)))))
 275
 276   (type-break-keystroke-reset)
 277   (type-break-schedule))
 278
 279 \f
 280 (defun type-break-schedule (&optional time)
 281   "Schedule a typing break for TIME seconds from now.
 282 If time is not specified, default to `type-break-interval'."
 283   (interactive (list (and current-prefix-arg
 284                           (prefix-numeric-value current-prefix-arg))))
 285   (or time (setq time type-break-interval))
 286   (type-break-cancel-schedule)
 287   (type-break-time-warning-schedule time 'reset)
 288   (run-at-time time nil 'type-break-alarm)
 289   (setq type-break-time-next-break
 290         (type-break-time-sum (current-time) time)))
 291
 292 (defun type-break-cancel-schedule ()
 293   (type-break-cancel-time-warning-schedule)
 294   (let ((timer-dont-exit t))
 295     (cancel-function-timers 'type-break-alarm))
 296   (setq type-break-alarm-p nil)
 297   (setq type-break-time-next-break nil))
 298
 299 (defun type-break-time-warning-schedule (&optional time resetp)
 300   (let (type-break-current-time-warning-interval)
 301     (type-break-cancel-time-warning-schedule))
 302   (cond
 303    (type-break-time-warning-intervals
 304     (and resetp
 305          (setq type-break-current-time-warning-interval
 306                type-break-time-warning-intervals))
 307
 308     (or time
 309         (setq time (type-break-time-difference (current-time)
 310                                                type-break-time-next-break)))
 311
 312     (while (and type-break-current-time-warning-interval
 313                 (> (car type-break-current-time-warning-interval) time))
 314       (setq type-break-current-time-warning-interval
 315             (cdr type-break-current-time-warning-interval)))
 316
 317     (cond
 318      (type-break-current-time-warning-interval
 319       (setq time (- time (car type-break-current-time-warning-interval)))
 320       (setq type-break-current-time-warning-interval
 321             (cdr type-break-current-time-warning-interval))
 322
 323       (let (type-break-current-time-warning-interval)
 324         (type-break-cancel-time-warning-schedule))
 325       (run-at-time time nil 'type-break-time-warning-alarm))))))
 326
 327 (defun type-break-cancel-time-warning-schedule ()
 328   (let ((timer-dont-exit t))
 329     (cancel-function-timers 'type-break-time-warning-alarm))
 330   (remove-hook 'type-break-post-command-hook 'type-break-time-warning)
 331   (setq type-break-current-time-warning-interval
 332         type-break-time-warning-intervals))
 333
 334 (defun type-break-alarm ()
 335   (setq type-break-alarm-p t))
 336
 337 (defun type-break-time-warning-alarm ()
 338   (type-break-time-warning-schedule)
 339   (setq type-break-time-warning-count type-break-warning-repeat)
 340   (add-hook 'type-break-post-command-hook 'type-break-time-warning 'append))
 341
 342 \f
 343 (defun type-break-run-tb-post-command-hook ()
 344   (and type-break-mode
 345        (run-hooks 'type-break-post-command-hook)))
 346
 347 (defun type-break-check ()
 348   "Ask to take a typing break if appropriate.
 349 This may be the case either because the scheduled time has come \(and the
 350 minimum keystroke threshold has been reached\) or because the maximum
 351 keystroke threshold has been exceeded."
 352   (let* ((min-threshold (car type-break-keystroke-threshold))
 353          (max-threshold (cdr type-break-keystroke-threshold)))
 354     (and type-break-good-rest-interval
 355          (progn
 356            (and (> (type-break-time-difference
 357                     type-break-time-last-command (current-time))
 358                    type-break-good-rest-interval)
 359                 (progn
 360                   (type-break-keystroke-reset)
 361                   (setq type-break-time-last-break (current-time))
 362                   (type-break-schedule)))
 363            (setq type-break-time-last-command (current-time))))
 364
 365     (and type-break-keystroke-threshold
 366          (setq type-break-keystroke-count
 367                (+ type-break-keystroke-count (length (this-command-keys)))))
 368
 369     ;; This has been optimized for speed; calls to input-pending-p and
 370     ;; checking for the minibuffer window are only done if it would
 371     ;; matter for the sake of querying user.
 372     (cond
 373      (type-break-alarm-p
 374       (cond
 375        ((input-pending-p))
 376        ((eq (selected-window) (minibuffer-window)))
 377        ((and min-threshold
 378              (< type-break-keystroke-count min-threshold))
 379         (type-break-schedule))
 380        (t
 381         ;; If keystroke count is within min-threshold of
 382         ;; max-threshold, lower it to reduce the liklihood of an
 383         ;; immediate subsequent query.
 384         (and max-threshold
 385              min-threshold
 386              (< (- max-threshold type-break-keystroke-count) min-threshold)
 387              (progn
 388                (type-break-keystroke-reset)
 389                (setq type-break-keystroke-count min-threshold)))
 390         (type-break-query))))
 391      ((and type-break-keystroke-warning-intervals
 392            max-threshold
 393            (= type-break-keystroke-warning-count 0)
 394            (type-break-check-keystroke-warning)))
 395      ((and max-threshold
 396            (> type-break-keystroke-count max-threshold)
 397            (not (input-pending-p))
 398            (not (eq (selected-window) (minibuffer-window))))
 399       (type-break-keystroke-reset)
 400       (setq type-break-keystroke-count (or min-threshold 0))
 401       (type-break-query)))))
 402
 403 ;; This should return t if warnings were enabled, nil otherwise.
 404 (defsubst type-break-check-keystroke-warning ()
 405   (let ((left (- (cdr type-break-keystroke-threshold)
 406                  type-break-keystroke-count)))
 407     (cond
 408      ((null (car type-break-current-keystroke-warning-interval))
 409       nil)
 410      ((> left (car type-break-current-keystroke-warning-interval))
 411       nil)
 412      (t
 413       (while (and (car type-break-current-keystroke-warning-interval)
 414                   (< left (car type-break-current-keystroke-warning-interval)))
 415         (setq type-break-current-keystroke-warning-interval
 416               (cdr type-break-current-keystroke-warning-interval)))
 417       (setq type-break-keystroke-warning-count type-break-warning-repeat)
 418       (add-hook 'type-break-post-command-hook 'type-break-keystroke-warning)
 419       t))))
 420
 421 (defun type-break-query ()
 422   (condition-case ()
 423       (cond
 424        ((let ((type-break-mode nil))
 425           (funcall type-break-query-function "Take a break from typing now? "))
 426         (type-break))
 427        (t
 428         (type-break-schedule type-break-query-interval)))
 429     (quit
 430      (type-break-schedule type-break-query-interval))))
 431
 432 (defun type-break-time-warning ()
 433   (cond
 434    ((and (car type-break-keystroke-threshold)
 435          (< type-break-keystroke-count (car type-break-keystroke-threshold))))
 436    ((> type-break-time-warning-count 0)
 437     (cond
 438      ((eq (selected-window) (minibuffer-window)))
 439      (t
 440       ;; Pause for a moment so previous messages can be seen.
 441       (sit-for 2)
 442       (message "Warning: typing break due in %s."
 443                (type-break-format-time
 444                 (type-break-time-difference (current-time)
 445                                             type-break-time-next-break)))
 446       (setq type-break-time-warning-count
 447             (1- type-break-time-warning-count)))))
 448    (t
 449     (remove-hook 'type-break-post-command-hook 'type-break-time-warning))))
 450
 451 (defun type-break-keystroke-warning ()
 452   (cond
 453    ((> type-break-keystroke-warning-count 0)
 454     (cond
 455      ((eq (selected-window) (minibuffer-window)))
 456      (t
 457       (sit-for 2)
 458       (message "Warning: typing break due in %s keystrokes."
 459                (- (cdr type-break-keystroke-threshold)
 460                   type-break-keystroke-count))
 461       (setq type-break-keystroke-warning-count
 462             (1- type-break-keystroke-warning-count)))))
 463    (t
 464     (remove-hook 'type-break-post-command-hook
 465                  'type-break-keystroke-warning))))
 466
 467 \f
 468 ;;;###autoload
 469 (defun type-break-statistics ()
 470   "Print statistics about typing breaks in a temporary buffer.
 471 This includes the last time a typing break was taken, when the next one is
 472 scheduled, the keystroke thresholds and the current keystroke count, etc."
 473   (interactive)
 474   (with-output-to-temp-buffer "*Typing Break Statistics*"
 475     (princ (format "Typing break statistics\n-----------------------\n
 476 Last typing break           : %s
 477 Next scheduled typing break : %s\n
 478 Minimum keystroke threshold : %s
 479 Maximum keystroke threshold : %s
 480 Current keystroke count     : %s"
 481                    (if type-break-time-last-break
 482                        (current-time-string type-break-time-last-break)
 483                      "never")
 484                    (if (and type-break-mode type-break-time-next-break)
 485                        (format "%s\t(%s from now)"
 486                                (current-time-string type-break-time-next-break)
 487                                (type-break-format-time
 488                                 (type-break-time-difference
 489                                 (current-time)
 490                                 type-break-time-next-break)))
 491                      "none scheduled")
 492                    (or (car type-break-keystroke-threshold) "none")
 493                    (or (cdr type-break-keystroke-threshold) "none")
 494                    type-break-keystroke-count))))
 495
 496 ;;;###autoload
 497 (defun type-break-guestimate-keystroke-threshold (wpm &optional wordlen frac)
 498   "Guess values for the minimum/maximum keystroke threshold for typing breaks.
 499 If called interactively, the user is prompted for their guess as to how
 500 many words per minute they usually type.  From that, the command sets the
 501 values in `type-break-keystroke-threshold' based on a fairly simple
 502 algorithm involving assumptions about the average length of words (5).
 503 For the minimum threshold, it uses about a quarter of the computed maximum
 504 threshold.
 505
 506 When called from lisp programs, the optional args WORDLEN and FRAC can be
 507 used to override the default assumption about average word length and the
 508 fraction of the maximum threshold to which to set the minimum threshold.
 509 FRAC should be the inverse of the fractional value; for example, a value of
 510 2 would mean to use one half, a value of 4 would mean to use one quarter, etc."
 511   (interactive "NHow many words per minute do you type? ")
 512   (let* ((upper (* wpm (or wordlen 5) (/ type-break-interval 60)))
 513          (lower (/ upper (or frac 5))))
 514     (or type-break-keystroke-threshold
 515         (setq type-break-keystroke-threshold (cons nil nil)))
 516     (setcar type-break-keystroke-threshold lower)
 517     (setcdr type-break-keystroke-threshold upper)
 518     (if (interactive-p)
 519         (message "min threshold: %d\tmax threshold: %d" lower upper)
 520       type-break-keystroke-threshold)))
 521
 522 \f
 523 ;;; misc functions
 524
 525 ;; Compute the difference, in seconds, between a and b, two structures
 526 ;; similar to those returned by `current-time'.
 527 ;; Use addition rather than logand since that is more robust; the low 16
 528 ;; bits of the seconds might have been incremented, making it more than 16
 529 ;; bits wide.
 530 (defsubst type-break-time-difference (a b)
 531   (+ (lsh (- (car b) (car a)) 16)
 532      (- (car (cdr b)) (car (cdr a)))))
 533
 534 ;; Return (in a new list the same in structure to that returned by
 535 ;; `current-time') the sum of the arguments.  Each argument may be a time
 536 ;; list or a single integer, a number of seconds.
 537 ;; This function keeps the high and low 16 bits of the seconds properly
 538 ;; balanced so that the lower value never exceeds 16 bits.  Otherwise, when
 539 ;; the result is passed to `current-time-string' it will toss some of the
 540 ;; "low" bits and return the wrong value.
 541 (defun type-break-time-sum (&rest tmlist)
 542   (let ((high 0)
 543         (low 0)
 544         (micro 0)
 545         tem)
 546     (while tmlist
 547       (setq tem (car tmlist))
 548       (setq tmlist (cdr tmlist))
 549       (cond
 550        ((numberp tem)
 551         (setq low (+ low tem)))
 552        (t
 553         (setq high  (+ high  (or (car tem) 0)))
 554         (setq low   (+ low   (or (car (cdr tem)) 0)))
 555         (setq micro (+ micro (or (car (cdr (cdr tem))) 0))))))
 556
 557     (and (>= micro 1000000)
 558          (progn
 559            (setq tem (/ micro 1000000))
 560            (setq low (+ low tem))
 561            (setq micro (- micro (* tem 1000000)))))
 562
 563     (setq tem (lsh low -16))
 564     (and (> tem 0)
 565          (progn
 566            (setq low (logand low 65535))
 567            (setq high (+ high tem))))
 568
 569     (list high low micro)))
 570
 571 (defsubst type-break-format-time (secs)
 572   (let ((mins (/ secs 60)))
 573     (cond
 574      ((= mins 1) (format "%d minute" mins))
 575      ((> mins 0) (format "%d minutes" mins))
 576      ((= secs 1) (format "%d second" secs))
 577      (t (format "%d seconds" secs)))))
 578
 579 (defun type-break-keystroke-reset ()
 580   (setq type-break-keystroke-count 0)
 581   (setq type-break-keystroke-warning-count 0)
 582   (setq type-break-current-keystroke-warning-interval
 583         type-break-keystroke-warning-intervals)
 584   (remove-hook 'type-break-post-command-hook 'type-break-keystroke-warning))
 585
 586 \f
 587 ;;; Demo wrappers
 588
 589 ;; This is a wrapper around hanoi that calls it with an arg large enough to
 590 ;; make the largest discs possible that will fit in the window.
 591 ;; Also, clean up the *Hanoi* buffer after we're done.
 592 (defun type-break-demo-hanoi ()
 593   "Take a hanoiing typing break."
 594   (and (get-buffer "*Hanoi*")
 595        (kill-buffer "*Hanoi*"))
 596   (condition-case ()
 597       (progn
 598         (hanoi (/ (window-width) 8))
 599         ;; Wait for user to come back.
 600         (read-char)
 601         (kill-buffer "*Hanoi*"))
 602     (quit
 603      ;; eat char
 604      (read-char)
 605      (and (get-buffer "*Hanoi*")
 606           (kill-buffer "*Hanoi*")))))
 607
 608 ;; This is a wrapper around life that calls it with a `sleep' arg to make
 609 ;; it run a little more leisurely.
 610 ;; Also, clean up the *Life* buffer after we're done.
 611 (defun type-break-demo-life ()
 612   "Take a typing break and get a life."
 613   (let ((continue t))
 614     (while continue
 615       (setq continue nil)
 616       (and (get-buffer "*Life*")
 617            (kill-buffer "*Life*"))
 618       (condition-case ()
 619           (progn
 620             (life 3)
 621             ;; wait for user to return
 622             (read-char)
 623             (kill-buffer "*Life*"))
 624         (life-extinct
 625          (message (get 'life-extinct 'error-message))
 626          (sit-for 3)
 627          ;; restart demo
 628          (setq continue t))
 629         (quit
 630          (and (get-buffer "*Life*")
 631               (kill-buffer "*Life*")))))))
 632
 633 ;; Boring demo, but doesn't use many cycles
 634 (defun type-break-demo-boring ()
 635   "Boring typing break demo."
 636   (let ((rmsg "Press any key to resume from typing break")
 637         (buffer-name "*Typing Break Buffer*")
 638         line col pos
 639         elapsed timeleft tmsg)
 640     (condition-case ()
 641         (progn
 642           (switch-to-buffer (get-buffer-create buffer-name))
 643           (buffer-disable-undo (current-buffer))
 644           (erase-buffer)
 645           (setq line (1+ (/ (window-height) 2)))
 646           (setq col (/ (- (window-width) (length rmsg)) 2))
 647           (insert (make-string line ?\C-j)
 648                   (make-string col ?\ )
 649                   rmsg)
 650           (forward-line -1)
 651           (beginning-of-line)
 652           (setq pos (point))
 653           (while (not (input-pending-p))
 654             (delete-region pos (progn
 655                                  (goto-char pos)
 656                                  (end-of-line)
 657                                  (point)))
 658             (setq elapsed (type-break-time-difference
 659                            type-break-time-last-break
 660                            (current-time)))
 661             (cond
 662              (type-break-good-rest-interval
 663               (setq timeleft (- type-break-good-rest-interval elapsed))
 664               (if (> timeleft 0)
 665                   (setq tmsg (format "You should rest for %s more"
 666                                      (type-break-format-time timeleft)))
 667                 (setq tmsg (format "Typing break has lasted %s"
 668                                    (type-break-format-time elapsed)))))
 669              (t
 670               (setq tmsg (format "Typing break has lasted %s"
 671                                  (type-break-format-time elapsed)))))
 672             (setq col (/ (- (window-width) (length tmsg)) 2))
 673             (insert (make-string col ?\ ) tmsg)
 674             (goto-char (point-min))
 675             (sit-for 60))
 676           (read-char)
 677           (kill-buffer buffer-name))
 678       (quit
 679        (and (get-buffer buffer-name)
 680             (kill-buffer buffer-name))))))
 681
 682 \f
 683 (provide 'type-break)
 684
 685 ;; Do not do this at load time because it makes it impossible to load this
 686 ;; file into temacs and then dump it.
 687 ;(type-break-mode t)
 688
 689 ;; local variables:
 690 ;; vc-make-backup-files: t
 691 ;; end:
 692
 693 ;;; type-break.el ends here