code.delx.au - gnu-emacs/blob - lisp/type-break.el

   1 ;;; type-break.el --- encourage rests from typing at appropriate intervals
   2
   3 ;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Noah Friedman
   6 ;; Maintainer: Noah Friedman <friedman@splode.com>
   7 ;; Keywords: extensions, timers
   8 ;; Status: Works in GNU Emacs 19.25 or later, some versions of XEmacs
   9 ;; Created: 1994-07-13
  10
  11 ;; $Id: type-break.el,v 1.22 1999/04/27 19:00:42 fx Exp kwzh $
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28 ;; Boston, MA 02111-1307, USA.
  29
  30 ;;; Commentary:
  31
  32 ;; The docstring for the function `type-break-mode' summarizes most of the
  33 ;; details of the interface.
  34
  35 ;; This package relies on the assumption that you live entirely in emacs,
  36 ;; as the author does.  If that's not the case for you (e.g. you often
  37 ;; suspend emacs or work in other windows) then this won't help very much;
  38 ;; it will depend on just how often you switch back to emacs.  At the very
  39 ;; least, you will want to turn off the keystroke thresholds and rest
  40 ;; interval tracking.
  41
  42 ;; If you prefer not to be queried about taking breaks, but instead just
  43 ;; want to be reminded, do the following:
  44 ;;
  45 ;;   (setq type-break-query-mode nil)
  46 ;;
  47 ;; Or call the command `type-break-query-mode' with a negative prefix
  48 ;; argument.
  49
  50 ;; If you find echo area messages annoying and would prefer to see messages
  51 ;; in the mode line instead, do M-x type-break-mode-line-message-mode
  52 ;; or set the variable of the same name to `t'.
  53
  54 ;; This program can truly cons up a storm because of all the calls to
  55 ;; `current-time' (which always returns 3 fresh conses).  I'm dismayed by
  56 ;; this, but I think the health of my hands is far more important than a
  57 ;; few pages of virtual memory.
  58
  59 ;; This program has no hope of working in Emacs 18.
  60
  61 ;; This package was inspired by Roland McGrath's hanoi-break.el.
  62 ;; Several people contributed feedback and ideas, including
  63 ;;      Roland McGrath <roland@gnu.org>
  64 ;;      Kleanthes Koniaris <kgk@martigny.ai.mit.edu>
  65 ;;      Mark Ashton <mpashton@gnu.org>
  66 ;;      Matt Wilding <wilding@cli.com>
  67 ;;      Robert S. Boyer <boyer@cs.utexas.edu>
  68
  69 ;;; Code:
  70
  71 \f
  72 (defgroup type-break nil
  73   "Encourage the user to take a rest from typing at suitable intervals."
  74   :prefix "type-break"
  75   :group 'keyboard)
  76
  77 ;;;###autoload
  78 (defcustom type-break-mode nil
  79   "Toggle typing break mode.
  80 See the docstring for the `type-break-mode' command for more information.
  81 Setting this variable directly does not take effect;
  82 use either \\[customize] or the function `type-break-mode'."
  83   :set (lambda (symbol value)
  84          (type-break-mode (if value 1 -1)))
  85   :initialize 'custom-initialize-default
  86   :type 'boolean
  87   :group 'type-break
  88   :require 'type-break)
  89
  90 ;;;###autoload
  91 (defcustom type-break-interval (* 60 60)
  92   "*Number of seconds between scheduled typing breaks."
  93   :type 'integer
  94   :group 'type-break)
  95
  96 ;;;###autoload
  97 (defcustom type-break-good-rest-interval (/ type-break-interval 6)
  98   "*Number of seconds of idle time considered to be an adequate typing rest.
  99
 100 When this variable is non-`nil', emacs checks the idle time between
 101 keystrokes.  If this idle time is long enough to be considered a \"good\"
 102 rest from typing, then the next typing break is simply rescheduled for later.
 103
 104 If a break is interrupted before this much time elapses, the user will be
 105 asked whether or not really to interrupt the break."
 106   :type 'integer
 107   :group 'type-break)
 108
 109 ;;;###autoload
 110 (defcustom type-break-keystroke-threshold
 111   ;; Assuming typing speed is 35wpm (on the average, do you really
 112   ;; type more than that in a minute?  I spend a lot of time reading mail
 113   ;; and simply studying code in buffers) and average word length is
 114   ;; about 5 letters, default upper threshold to the average number of
 115   ;; keystrokes one is likely to type in a break interval.  That way if the
 116   ;; user goes through a furious burst of typing activity, cause a typing
 117   ;; break to be required sooner than originally scheduled.
 118   ;; Conversely, the minimum threshold should be about a fifth of this.
 119   (let* ((wpm 35)
 120          (avg-word-length 5)
 121          (upper (* wpm avg-word-length (/ type-break-interval 60)))
 122          (lower (/ upper 5)))
 123     (cons lower upper))
 124   "*Upper and lower bound on number of keystrokes for considering typing break.
 125 This structure is a pair of numbers (MIN . MAX).
 126
 127 The first number is the minimum number of keystrokes that must have been
 128 entered since the last typing break before considering another one, even if
 129 the scheduled time has elapsed; the break is simply rescheduled until later
 130 if the minimum threshold hasn't been reached.  If this first value is nil,
 131 then there is no minimum threshold; as soon as the scheduled time has
 132 elapsed, the user will always be queried.
 133
 134 The second number is the maximum number of keystrokes that can be entered
 135 before a typing break is requested immediately, pre-empting the originally
 136 scheduled break.  If this second value is nil, then no pre-emptive breaks
 137 will occur; only scheduled ones will.
 138
 139 Keys with bucky bits (shift, control, meta, etc) are counted as only one
 140 keystroke even though they really require multiple keys to generate them.
 141
 142 The command `type-break-guesstimate-keystroke-threshold' can be used to
 143 guess a reasonably good pair of values for this variable."
 144   :type 'sexp
 145   :group 'type-break)
 146
 147 (defcustom type-break-query-mode t
 148   "*Non-`nil' means ask whether or not to prompt user for breaks.
 149 If so, call the function specified in the value of the variable
 150 `type-break-query-function' to do the asking."
 151   :type 'boolean
 152   :group 'type-break)
 153
 154 (defvar type-break-query-function 'yes-or-no-p
 155   "Function to use for making query for a typing break.
 156 It should take a string as an argument, the prompt.
 157 Usually this should be set to `yes-or-no-p' or `y-or-n-p'.
 158
 159 To avoid being queried at all, set `type-break-query-mode' to `nil'.")
 160
 161 (defcustom type-break-query-interval 60
 162   "*Number of seconds between queries to take a break, if put off.
 163 The user will continue to be prompted at this interval until he or she
 164 finally submits to taking a typing break."
 165   :type 'integer
 166   :group 'type-break)
 167
 168 (defcustom type-break-time-warning-intervals '(300 120 60 30)
 169   "*List of time intervals for warnings about upcoming typing break.
 170 At each of the intervals (specified in seconds) away from a scheduled
 171 typing break, print a warning in the echo area."
 172   :type '(repeat integer)
 173   :group 'type-break)
 174
 175 (defcustom type-break-keystroke-warning-intervals '(300 200 100 50)
 176   "*List of keystroke measurements for warnings about upcoming typing break.
 177 At each of the intervals (specified in keystrokes) away from the upper
 178 keystroke threshold, print a warning in the echo area.
 179 If either this variable or the upper threshold is set, then no warnings
 180 will occur."
 181   :type '(repeat integer)
 182   :group 'type-break)
 183
 184
 185 (defcustom type-break-warning-repeat 40
 186   "*Number of keystrokes for which warnings should be repeated.
 187 That is, for each of this many keystrokes the warning is redisplayed
 188 in the echo area to make sure it's really seen."
 189   :type 'integer
 190   :group 'type-break)
 191
 192 (defcustom type-break-demo-functions
 193   '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi)
 194   "*List of functions to consider running as demos during typing breaks.
 195 When a typing break begins, one of these functions is selected randomly
 196 to have emacs do something interesting.
 197
 198 Any function in this list should start a demo which ceases as soon as a
 199 key is pressed."
 200   :type '(repeat function)
 201   :group 'type-break)
 202
 203 (defvar type-break-post-command-hook '(type-break-check)
 204   "Hook run indirectly by post-command-hook for typing break functions.
 205 This is not really intended to be set by the user, but it's probably
 206 harmless to do so.  Mainly it is used by various parts of the typing break
 207 program to delay actions until after the user has completed some command.
 208 It exists because `post-command-hook' itself is inaccessible while its
 209 functions are being run, and some type-break--related functions want to
 210 remove themselves after running.")
 211
 212 \f
 213 ;; Mode line frobs
 214
 215 (defcustom type-break-mode-line-message-mode nil
 216   "*Non-`nil' means put type-break related messages in the mode line.
 217 Otherwise, messages typically go in the echo area.
 218
 219 See also `type-break-mode-line-format' and its members."
 220   :type 'boolean
 221   :group 'type-break)
 222
 223 (defvar type-break-mode-line-format
 224   '(type-break-mode-line-message-mode
 225     (""
 226      type-break-mode-line-break-message
 227      type-break-mode-line-warning))
 228   "*Format of messages in the mode line concerning typing breaks.")
 229
 230 (defvar type-break-mode-line-break-message
 231   '(type-break-mode-line-break-message-p
 232     type-break-mode-line-break-string))
 233
 234 (defvar type-break-mode-line-break-message-p nil)
 235 (defvar type-break-mode-line-break-string " *** TAKE A TYPING BREAK ***")
 236
 237 (defvar type-break-mode-line-warning
 238       '(type-break-mode-line-break-message-p
 239         ("")
 240         (type-break-warning-countdown-string
 241          (" ***Break in "
 242           type-break-warning-countdown-string
 243           " "
 244           type-break-warning-countdown-string-type
 245           "***"))))
 246
 247 (defvar type-break-warning-countdown-string nil
 248   "If non-nil, this is a countdown for the next typing break.
 249
 250 This variable, in conjunction with `type-break-warning-countdown-string-type'
 251 (which indicates whether this value is a number of keystrokes or seconds)
 252 is installed in mode-line-format to notify of imminent typing breaks.")
 253
 254 (defvar type-break-warning-countdown-string-type nil
 255   "Indicates the unit type of `type-break-warning-countdown-string'.
 256 It will be either \"seconds\" or \"keystrokes\".")
 257
 258 \f
 259 ;; These are internal variables.  Do not set them yourself.
 260
 261 (defvar type-break-alarm-p nil)
 262 (defvar type-break-keystroke-count 0)
 263 (defvar type-break-time-last-break nil)
 264 (defvar type-break-time-next-break nil)
 265 (defvar type-break-time-last-command (current-time))
 266 (defvar type-break-current-time-warning-interval nil)
 267 (defvar type-break-current-keystroke-warning-interval nil)
 268 (defvar type-break-time-warning-count 0)
 269 (defvar type-break-keystroke-warning-count 0)
 270
 271 ;; Constant indicating emacs variant.
 272 ;; This can be one of `xemacs', `lucid', `epoch', `mule', etc.
 273 (defconst type-break-emacs-variant
 274   (let ((data (match-data))
 275         (version (cond
 276                   ((fboundp 'nemacs-version)
 277                    (nemacs-version))
 278                   (t
 279                    (emacs-version))))
 280         (alist '(("\\bXEmacs\\b"  . xemacs)
 281                  ("\\bLucid\\b"   . lucid)
 282                  ("^Nemacs\\b"    . nemacs)
 283                  ("^GNU Emacs 19" . standard19)
 284                  ("^GNU Emacs 20" . standard19)
 285                  ("^GNU Emacs 18" . emacs18)))
 286         result)
 287     (while alist
 288       (cond
 289        ((string-match (car (car alist)) version)
 290         (setq result (cdr (car alist)))
 291         (setq alist nil))
 292        (t
 293         (setq alist (cdr alist)))))
 294     (set-match-data data)
 295     (cond ((eq result 'lucid)
 296            (and (string= emacs-version "19.8 Lucid")
 297                 (setq result 'lucid-19-8)))
 298           ((memq result '(nemacs emacs18))
 299            (signal 'error
 300                    "type-break not supported in this version of emacs.")))
 301     result))
 302
 303 \f
 304 ;;;###autoload
 305 (defun type-break-mode (&optional prefix)
 306   "Enable or disable typing-break mode.
 307 This is a minor mode, but it is global to all buffers by default.
 308
 309 When this mode is enabled, the user is encouraged to take typing breaks at
 310 appropriate intervals; either after a specified amount of time or when the
 311 user has exceeded a keystroke threshold.  When the time arrives, the user
 312 is asked to take a break.  If the user refuses at that time, emacs will ask
 313 again in a short period of time.  The idea is to give the user enough time
 314 to find a good breaking point in his or her work, but be sufficiently
 315 annoying to discourage putting typing breaks off indefinitely.
 316
 317 A negative prefix argument disables this mode.
 318 No argument or any non-negative argument enables it.
 319
 320 The user may enable or disable this mode by setting the variable of the
 321 same name, though setting it in that way doesn't reschedule a break or
 322 reset the keystroke counter.
 323
 324 If the mode was previously disabled and is enabled as a consequence of
 325 calling this function, it schedules a break with `type-break-schedule' to
 326 make sure one occurs (the user can call that command to reschedule the
 327 break at any time).  It also initializes the keystroke counter.
 328
 329 The variable `type-break-interval' specifies the number of seconds to
 330 schedule between regular typing breaks.  This variable doesn't directly
 331 affect the time schedule; it simply provides a default for the
 332 `type-break-schedule' command.
 333
 334 If set, the variable `type-break-good-rest-interval' specifies the minimum
 335 amount of time which is considered a reasonable typing break.  Whenever
 336 that time has elapsed, typing breaks are automatically rescheduled for
 337 later even if emacs didn't prompt you to take one first.  Also, if a break
 338 is ended before this much time has elapsed, the user will be asked whether
 339 or not to continue.
 340
 341 The variable `type-break-keystroke-threshold' is used to determine the
 342 thresholds at which typing breaks should be considered.  You can use
 343 the command `type-break-guesstimate-keystroke-threshold' to try to
 344 approximate good values for this.
 345
 346 There are several variables that affect how or when warning messages about
 347 imminent typing breaks are displayed.  They include:
 348
 349         `type-break-mode-line-message-mode'
 350         `type-break-time-warning-intervals'
 351         `type-break-keystroke-warning-intervals'
 352         `type-break-warning-repeat'
 353         `type-break-warning-countdown-string'
 354         `type-break-warning-countdown-string-type'
 355
 356 There are several variables that affect if, how, and when queries to begin
 357 a typing break occur.  They include:
 358
 359         `type-break-query-mode'
 360         `type-break-query-function'
 361         `type-break-query-interval'
 362
 363 Finally, the command `type-break-statistics' prints interesting things."
 364   (interactive "P")
 365   (type-break-check-post-command-hook)
 366
 367   (let ((already-enabled type-break-mode))
 368     (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
 369
 370     (cond
 371      ((and already-enabled type-break-mode)
 372       (and (interactive-p)
 373            (message "Type Break mode is already enabled")))
 374      (type-break-mode
 375       (or global-mode-string
 376           (setq global-mode-string '("")))
 377       (or (assq 'type-break-mode-line-message-mode
 378                 minor-mode-alist)
 379           (setq minor-mode-alist
 380                 (cons type-break-mode-line-format
 381                       minor-mode-alist)))
 382       (type-break-keystroke-reset)
 383       (type-break-mode-line-countdown-or-break nil)
 384       (type-break-schedule)
 385       (and (interactive-p)
 386            (message "Type Break mode is enabled and reset")))
 387      (t
 388       (type-break-keystroke-reset)
 389       (type-break-mode-line-countdown-or-break nil)
 390       (type-break-cancel-schedule)
 391       (and (interactive-p)
 392            (message "Type Break mode is disabled")))))
 393   type-break-mode)
 394
 395 (defun type-break-mode-line-message-mode (&optional prefix)
 396   "Enable or disable warnings in the mode line about typing breaks.
 397
 398 A negative prefix argument disables this mode.
 399 No argument or any non-negative argument enables it.
 400
 401 The user may also enable or disable this mode simply by setting the
 402 variable of the same name.
 403
 404 Variables controlling the display of messages in the mode line include:
 405
 406         `mode-line-format'
 407         `global-mode-string'
 408         `type-break-mode-line-break-message'
 409         `type-break-mode-line-warning'"
 410   (interactive "P")
 411   (setq type-break-mode-line-message-mode
 412         (>= (prefix-numeric-value prefix) 0))
 413   (and (interactive-p)
 414        (if type-break-mode-line-message-mode
 415            (message "type-break-mode-line-message-mode is enabled")
 416          (message "type-break-mode-line-message-mode is disabled")))
 417   type-break-mode-line-message-mode)
 418
 419 (defun type-break-query-mode (&optional prefix)
 420   "Enable or disable warnings in the mode line about typing breaks.
 421
 422 When enabled, the user is periodically queried about whether to take a
 423 typing break at that moment.  The function which does this query is
 424 specified by the variable `type-break-query-function'.
 425
 426 A negative prefix argument disables this mode.
 427 No argument or any non-negative argument enables it.
 428
 429 The user may also enable or disable this mode simply by setting the
 430 variable of the same name."
 431   (interactive "P")
 432   (setq type-break-query-mode
 433         (>= (prefix-numeric-value prefix) 0))
 434   (and (interactive-p)
 435        (if type-break-query-mode
 436            (message "type-break-query-mode is enabled")
 437          (message "type-break-query-mode is disabled")))
 438   type-break-query-mode)
 439
 440 \f
 441 ;;;###autoload
 442 (defun type-break ()
 443   "Take a typing break.
 444
 445 During the break, a demo selected from the functions listed in
 446 `type-break-demo-functions' is run.
 447
 448 After the typing break is finished, the next break is scheduled
 449 as per the function `type-break-schedule'."
 450   (interactive)
 451   (type-break-cancel-schedule)
 452   (let ((continue t)
 453         (start-time (current-time)))
 454     (setq type-break-time-last-break start-time)
 455     (while continue
 456       (save-window-excursion
 457         ;; Eat the screen.
 458         (and (eq (selected-window) (minibuffer-window))
 459              (other-window 1))
 460         (delete-other-windows)
 461         (scroll-right (window-width))
 462         (message "Press any key to resume from typing break.")
 463
 464         (random t)
 465         (let* ((len (length type-break-demo-functions))
 466                (idx (random len))
 467                (fn (nth idx type-break-demo-functions)))
 468           (condition-case ()
 469               (funcall fn)
 470             (error nil))))
 471
 472       (cond
 473        (type-break-good-rest-interval
 474         (let ((break-secs (type-break-time-difference
 475                            start-time (current-time))))
 476           (cond
 477            ((>= break-secs type-break-good-rest-interval)
 478             (setq continue nil))
 479            ;; 60 seconds may be too much leeway if the break is only 3
 480            ;; minutes to begin with.  You can just say "no" to the query
 481            ;; below if you're in that much of a hurry.
 482            ;((> 60 (abs (- break-secs type-break-good-rest-interval)))
 483            ; (setq continue nil))
 484            ((funcall
 485              type-break-query-function
 486              (format "You really ought to rest %s more.  Continue break? "
 487                      (type-break-format-time (- type-break-good-rest-interval
 488                                                 break-secs)))))
 489            (t
 490             (setq continue nil)))))
 491        (t (setq continue nil)))))
 492
 493   (type-break-keystroke-reset)
 494   (type-break-mode-line-countdown-or-break nil)
 495   (type-break-schedule))
 496
 497 \f
 498 (defun type-break-schedule (&optional time)
 499   "Schedule a typing break for TIME seconds from now.
 500 If time is not specified, default to `type-break-interval'."
 501   (interactive (list (and current-prefix-arg
 502                           (prefix-numeric-value current-prefix-arg))))
 503   (or time (setq time type-break-interval))
 504   (type-break-check-post-command-hook)
 505   (type-break-cancel-schedule)
 506   (type-break-time-warning-schedule time 'reset)
 507   (type-break-run-at-time (max 1 time) nil 'type-break-alarm)
 508   (setq type-break-time-next-break
 509         (type-break-time-sum (current-time) time)))
 510
 511 (defun type-break-cancel-schedule ()
 512   (type-break-cancel-time-warning-schedule)
 513   (type-break-cancel-function-timers 'type-break-alarm)
 514   (setq type-break-alarm-p nil)
 515   (setq type-break-time-next-break nil))
 516
 517 (defun type-break-time-warning-schedule (&optional time resetp)
 518   (let ((type-break-current-time-warning-interval nil))
 519     (type-break-cancel-time-warning-schedule))
 520   (add-hook 'type-break-post-command-hook 'type-break-time-warning 'append)
 521   (cond
 522    (type-break-time-warning-intervals
 523     (and resetp
 524          (setq type-break-current-time-warning-interval
 525                type-break-time-warning-intervals))
 526
 527     (or time
 528         (setq time (type-break-time-difference (current-time)
 529                                                type-break-time-next-break)))
 530
 531     (while (and type-break-current-time-warning-interval
 532                 (> (car type-break-current-time-warning-interval) time))
 533       (setq type-break-current-time-warning-interval
 534             (cdr type-break-current-time-warning-interval)))
 535
 536     (cond
 537      (type-break-current-time-warning-interval
 538       (setq time (- time (car type-break-current-time-warning-interval)))
 539       (setq type-break-current-time-warning-interval
 540             (cdr type-break-current-time-warning-interval))
 541
 542       ;(let (type-break-current-time-warning-interval)
 543       ;  (type-break-cancel-time-warning-schedule))
 544       (type-break-run-at-time (max 1 time) nil 'type-break-time-warning-alarm)
 545
 546       (cond
 547        (resetp
 548         (setq type-break-warning-countdown-string nil))
 549        (t
 550         (setq type-break-warning-countdown-string (number-to-string time))
 551         (setq type-break-warning-countdown-string-type "seconds"))))))))
 552
 553 (defun type-break-cancel-time-warning-schedule ()
 554   (type-break-cancel-function-timers 'type-break-time-warning-alarm)
 555   (remove-hook 'type-break-post-command-hook 'type-break-time-warning)
 556   (setq type-break-current-time-warning-interval
 557         type-break-time-warning-intervals)
 558   (setq type-break-warning-countdown-string nil))
 559
 560 (defun type-break-alarm ()
 561   (type-break-check-post-command-hook)
 562   (setq type-break-alarm-p t)
 563   (type-break-mode-line-countdown-or-break 'break))
 564
 565 (defun type-break-time-warning-alarm ()
 566   (type-break-check-post-command-hook)
 567   (type-break-time-warning-schedule)
 568   (setq type-break-time-warning-count type-break-warning-repeat)
 569   (type-break-time-warning)
 570   (type-break-mode-line-countdown-or-break 'countdown))
 571
 572 \f
 573 (defun type-break-run-tb-post-command-hook ()
 574   (and type-break-mode
 575        (run-hooks 'type-break-post-command-hook)))
 576
 577 (defun type-break-check ()
 578   "Ask to take a typing break if appropriate.
 579 This may be the case either because the scheduled time has come \(and the
 580 minimum keystroke threshold has been reached\) or because the maximum
 581 keystroke threshold has been exceeded."
 582   (let* ((min-threshold (car type-break-keystroke-threshold))
 583          (max-threshold (cdr type-break-keystroke-threshold)))
 584     (and type-break-good-rest-interval
 585          (progn
 586            (and (> (type-break-time-difference
 587                     type-break-time-last-command (current-time))
 588                    type-break-good-rest-interval)
 589                 (progn
 590                   (type-break-keystroke-reset)
 591                   (type-break-mode-line-countdown-or-break nil)
 592                   (setq type-break-time-last-break (current-time))
 593                   (type-break-schedule)))
 594            (setq type-break-time-last-command (current-time))))
 595
 596     (and type-break-keystroke-threshold
 597          ;; next line is test for 20.2 that can be deleted
 598          ;;(setq type-break-keystroke-count (1+ type-break-keystroke-count))
 599          (let ((keys (this-command-keys)))
 600            (cond
 601             ;; Ignore mouse motion
 602             ((and (vectorp keys)
 603                   (consp (aref keys 0))
 604                   (memq (car (aref keys 0)) '(mouse-movement))))
 605             (t
 606              (setq type-break-keystroke-count
 607                    (+ type-break-keystroke-count (length keys)))))))
 608
 609     (cond
 610      (type-break-alarm-p
 611       (cond
 612        ((input-pending-p))
 613        ((eq (selected-window) (minibuffer-window)))
 614        ((and min-threshold
 615              (< type-break-keystroke-count min-threshold))
 616         (type-break-schedule))
 617        (t
 618         ;; If keystroke count is within min-threshold of
 619         ;; max-threshold, lower it to reduce the likelihood of an
 620         ;; immediate subsequent query.
 621         (and max-threshold
 622              min-threshold
 623              (< (- max-threshold type-break-keystroke-count) min-threshold)
 624              (progn
 625                (type-break-keystroke-reset)
 626                (setq type-break-keystroke-count min-threshold)))
 627         (type-break-query))))
 628      ((and type-break-keystroke-warning-intervals
 629            max-threshold
 630            (= type-break-keystroke-warning-count 0)
 631            (type-break-check-keystroke-warning)))
 632      ((and max-threshold
 633            (> type-break-keystroke-count max-threshold)
 634            (not (input-pending-p))
 635            (not (eq (selected-window) (minibuffer-window))))
 636       (type-break-keystroke-reset)
 637       (setq type-break-keystroke-count (or min-threshold 0))
 638       (type-break-query)))))
 639
 640 ;; This should return t if warnings were enabled, nil otherwise.
 641 (defun type-break-check-keystroke-warning ()
 642   ;; This is safe because the caller should have checked that the cdr was
 643   ;; non-nil already.
 644   (let ((left (- (cdr type-break-keystroke-threshold)
 645                  type-break-keystroke-count)))
 646     (cond
 647      ((null (car type-break-current-keystroke-warning-interval))
 648       nil)
 649      ((> left (car type-break-current-keystroke-warning-interval))
 650       nil)
 651      (t
 652       (while (and (car type-break-current-keystroke-warning-interval)
 653                   (< left (car type-break-current-keystroke-warning-interval)))
 654         (setq type-break-current-keystroke-warning-interval
 655               (cdr type-break-current-keystroke-warning-interval)))
 656       (setq type-break-keystroke-warning-count type-break-warning-repeat)
 657       (add-hook 'type-break-post-command-hook 'type-break-keystroke-warning)
 658       (setq type-break-warning-countdown-string (number-to-string left))
 659       (setq type-break-warning-countdown-string-type "keystrokes")
 660       (type-break-mode-line-countdown-or-break 'countdown)
 661       t))))
 662
 663 ;; Arrange for a break query to be made, when the user stops typing furiously.
 664 (defun type-break-query ()
 665   (add-hook 'type-break-post-command-hook 'type-break-do-query))
 666
 667 (defun type-break-do-query ()
 668   (cond
 669    ((not type-break-query-mode)
 670     (type-break-noninteractive-query)
 671     (type-break-schedule type-break-query-interval)
 672     (remove-hook 'type-break-post-command-hook 'type-break-do-query))
 673    ((sit-for 2)
 674     (condition-case ()
 675         (cond
 676          ((let ((type-break-mode nil)
 677                 ;; yes-or-no-p sets this-command to exit-minibuffer,
 678                 ;; which hoses undo or yank-pop (if you happened to be
 679                 ;; yanking just when the query occurred).
 680                 (this-command this-command))
 681             (funcall type-break-query-function
 682                      "Take a break from typing now? "))
 683           (type-break))
 684          (t
 685           (type-break-schedule type-break-query-interval)))
 686       (quit
 687        (type-break-schedule type-break-query-interval)))
 688     (remove-hook 'type-break-post-command-hook 'type-break-do-query))))
 689
 690 (defun type-break-noninteractive-query (&optional ignored-args)
 691   "Null query function which doesn't interrupt user and assumes `no'.
 692 It prints a reminder in the echo area to take a break, but doesn't enforce
 693 this or ask the user to start one right now."
 694   (cond
 695    (type-break-mode-line-message-mode)
 696    (t
 697     (beep t)
 698     (message "You should take a typing break now.  Do `M-x type-break'.")
 699     (sit-for 1)
 700     (beep t)
 701     ;; return nil so query caller knows to reset reminder, as if user
 702     ;; said "no" in response to yes-or-no-p.
 703     nil)))
 704
 705 (defun type-break-time-warning ()
 706   (cond
 707    ((and (car type-break-keystroke-threshold)
 708          (< type-break-keystroke-count (car type-break-keystroke-threshold))))
 709    ((> type-break-time-warning-count 0)
 710     (let ((timeleft (type-break-time-difference (current-time)
 711                                                 type-break-time-next-break)))
 712       (setq type-break-warning-countdown-string (number-to-string timeleft))
 713       (cond
 714        ((eq (selected-window) (minibuffer-window)))
 715        ;; Do nothing if the command was just a prefix arg, since that will
 716        ;; immediately be followed by some other interactive command.
 717        ;; Otherwise, it is particularly annoying for the sit-for below to
 718        ;; delay redisplay when one types sequences like `C-u -1 C-l'.
 719        ((memq this-command '(digit-argument universal-argument)))
 720        ((not type-break-mode-line-message-mode)
 721         ;; Pause for a moment so any previous message can be seen.
 722         (sit-for 2)
 723         (message "Warning: typing break due in %s."
 724                  (type-break-format-time timeleft))
 725         (setq type-break-time-warning-count
 726               (1- type-break-time-warning-count))))))
 727    (t
 728     (remove-hook 'type-break-post-command-hook 'type-break-time-warning)
 729     (setq type-break-warning-countdown-string nil))))
 730
 731 (defun type-break-keystroke-warning ()
 732   (cond
 733    ((> type-break-keystroke-warning-count 0)
 734     (setq type-break-warning-countdown-string
 735           (number-to-string (- (cdr type-break-keystroke-threshold)
 736                                type-break-keystroke-count)))
 737     (cond
 738      ((eq (selected-window) (minibuffer-window)))
 739      ;; Do nothing if the command was just a prefix arg, since that will
 740      ;; immediately be followed by some other interactive command.
 741      ;; Otherwise, it is particularly annoying for the sit-for below to
 742      ;; delay redisplay when one types sequences like `C-u -1 C-l'.
 743      ((memq this-command '(digit-argument universal-argument)))
 744      ((not type-break-mode-line-message-mode)
 745       (sit-for 2)
 746       (message "Warning: typing break due in %s keystrokes."
 747                (- (cdr type-break-keystroke-threshold)
 748                   type-break-keystroke-count))
 749       (setq type-break-keystroke-warning-count
 750             (1- type-break-keystroke-warning-count)))))
 751    (t
 752     (remove-hook 'type-break-post-command-hook
 753                  'type-break-keystroke-warning)
 754     (setq type-break-warning-countdown-string nil))))
 755
 756 (defun type-break-mode-line-countdown-or-break (&optional type)
 757   (cond
 758    ((not type-break-mode-line-message-mode))
 759    ((eq type 'countdown)
 760     ;(setq type-break-mode-line-break-message-p nil)
 761     (add-hook 'type-break-post-command-hook
 762               'type-break-force-mode-line-update 'append))
 763    ((eq type 'break)
 764     ;; Alternate
 765     (setq type-break-mode-line-break-message-p
 766           (not type-break-mode-line-break-message-p))
 767     (remove-hook 'type-break-post-command-hook
 768                  'type-break-force-mode-line-update))
 769    (t
 770     (setq type-break-mode-line-break-message-p nil)
 771     (setq type-break-warning-countdown-string nil)
 772     (remove-hook 'type-break-post-command-hook
 773                  'type-break-force-mode-line-update)))
 774   (type-break-force-mode-line-update))
 775
 776 \f
 777 ;;;###autoload
 778 (defun type-break-statistics ()
 779   "Print statistics about typing breaks in a temporary buffer.
 780 This includes the last time a typing break was taken, when the next one is
 781 scheduled, the keystroke thresholds and the current keystroke count, etc."
 782   (interactive)
 783   (with-output-to-temp-buffer "*Typing Break Statistics*"
 784     (princ (format "Typing break statistics\n-----------------------\n
 785 Typing break mode is currently %s.
 786 Interactive query for breaks is %s.
 787 Warnings of imminent typing breaks in mode line is %s.
 788
 789 Last typing break ended     : %s
 790 Next scheduled typing break : %s\n
 791 Minimum keystroke threshold : %s
 792 Maximum keystroke threshold : %s
 793 Current keystroke count     : %s"
 794                    (if type-break-mode "enabled" "disabled")
 795                    (if type-break-query-mode "enabled" "disabled")
 796                    (if type-break-mode-line-message-mode "enabled" "disabled")
 797                    (if type-break-time-last-break
 798                        (current-time-string type-break-time-last-break)
 799                      "never")
 800                    (if (and type-break-mode type-break-time-next-break)
 801                        (format "%s\t(%s from now)"
 802                                (current-time-string type-break-time-next-break)
 803                                (type-break-format-time
 804                                 (type-break-time-difference
 805                                 (current-time)
 806                                 type-break-time-next-break)))
 807                      "none scheduled")
 808                    (or (car type-break-keystroke-threshold) "none")
 809                    (or (cdr type-break-keystroke-threshold) "none")
 810                    type-break-keystroke-count))))
 811
 812 ;;;###autoload
 813 (defun type-break-guesstimate-keystroke-threshold (wpm &optional wordlen frac)
 814   "Guess values for the minimum/maximum keystroke threshold for typing breaks.
 815
 816 If called interactively, the user is prompted for their guess as to how
 817 many words per minute they usually type.  This value should not be your
 818 maximum WPM, but your average.  Of course, this is harder to gauge since it
 819 can vary considerably depending on what you are doing.  For example, one
 820 tends to type less when debugging a program as opposed to writing
 821 documentation.  (Perhaps a separate program should be written to estimate
 822 average typing speed.)
 823
 824 From that, this command sets the values in `type-break-keystroke-threshold'
 825 based on a fairly simple algorithm involving assumptions about the average
 826 length of words (5).  For the minimum threshold, it uses about a fifth of
 827 the computed maximum threshold.
 828
 829 When called from lisp programs, the optional args WORDLEN and FRAC can be
 830 used to override the default assumption about average word length and the
 831 fraction of the maximum threshold to which to set the minimum threshold.
 832 FRAC should be the inverse of the fractional value; for example, a value of
 833 2 would mean to use one half, a value of 4 would mean to use one quarter, etc."
 834   (interactive "NOn average, how many words per minute do you type? ")
 835   (let* ((upper (* wpm (or wordlen 5) (/ type-break-interval 60)))
 836          (lower (/ upper (or frac 5))))
 837     (or type-break-keystroke-threshold
 838         (setq type-break-keystroke-threshold (cons nil nil)))
 839     (setcar type-break-keystroke-threshold lower)
 840     (setcdr type-break-keystroke-threshold upper)
 841     (if (interactive-p)
 842         (message "min threshold: %d\tmax threshold: %d" lower upper)
 843       type-break-keystroke-threshold)))
 844
 845 \f
 846 ;;; misc functions
 847
 848 ;; Compute the difference, in seconds, between a and b, two structures
 849 ;; similar to those returned by `current-time'.
 850 ;; Use addition rather than logand since that is more robust; the low 16
 851 ;; bits of the seconds might have been incremented, making it more than 16
 852 ;; bits wide.
 853 (defun type-break-time-difference (a b)
 854   (+ (lsh (- (car b) (car a)) 16)
 855      (- (car (cdr b)) (car (cdr a)))))
 856
 857 ;; Return (in a new list the same in structure to that returned by
 858 ;; `current-time') the sum of the arguments.  Each argument may be a time
 859 ;; list or a single integer, a number of seconds.
 860 ;; This function keeps the high and low 16 bits of the seconds properly
 861 ;; balanced so that the lower value never exceeds 16 bits.  Otherwise, when
 862 ;; the result is passed to `current-time-string' it will toss some of the
 863 ;; "low" bits and format the time incorrectly.
 864 (defun type-break-time-sum (&rest tmlist)
 865   (let ((high 0)
 866         (low 0)
 867         (micro 0)
 868         tem)
 869     (while tmlist
 870       (setq tem (car tmlist))
 871       (setq tmlist (cdr tmlist))
 872       (cond
 873        ((numberp tem)
 874         (setq low (+ low tem)))
 875        (t
 876         (setq high  (+ high  (or (car tem) 0)))
 877         (setq low   (+ low   (or (car (cdr tem)) 0)))
 878         (setq micro (+ micro (or (car (cdr (cdr tem))) 0))))))
 879
 880     (and (>= micro 1000000)
 881          (progn
 882            (setq tem (/ micro 1000000))
 883            (setq low (+ low tem))
 884            (setq micro (- micro (* tem 1000000)))))
 885
 886     (setq tem (lsh low -16))
 887     (and (> tem 0)
 888          (progn
 889            (setq low (logand low 65535))
 890            (setq high (+ high tem))))
 891
 892     (list high low micro)))
 893
 894 (defun type-break-format-time (secs)
 895   (let ((mins (/ secs 60)))
 896     (cond
 897      ((= mins 1) (format "%d minute" mins))
 898      ((> mins 0) (format "%d minutes" mins))
 899      ((= secs 1) (format "%d second" secs))
 900      (t (format "%d seconds" secs)))))
 901
 902 (defun type-break-keystroke-reset ()
 903   (setq type-break-keystroke-count 0)
 904   (setq type-break-keystroke-warning-count 0)
 905   (setq type-break-current-keystroke-warning-interval
 906         type-break-keystroke-warning-intervals)
 907   (remove-hook 'type-break-post-command-hook 'type-break-keystroke-warning))
 908
 909 (defun type-break-force-mode-line-update (&optional all)
 910   "Force the mode-line of the current buffer to be redisplayed.
 911 With optional non-nil ALL, force redisplay of all mode-lines."
 912   (and all (save-excursion (set-buffer (other-buffer))))
 913   (set-buffer-modified-p (buffer-modified-p)))
 914
 915 ;; If an exception occurs in emacs while running the post command hook, the
 916 ;; value of that hook is clobbered.  This is because the value of the
 917 ;; variable is temporarily set to nil while it's running to prevent
 918 ;; recursive application, but it also means an exception aborts the routine
 919 ;; of restoring it.  This function is called from the timers to restore it,
 920 ;; just in case.
 921 (defun type-break-check-post-command-hook ()
 922   (add-hook 'post-command-hook 'type-break-run-tb-post-command-hook 'append))
 923
 924 \f
 925 ;;; Timer wrapper functions
 926 ;;;
 927 ;;; These shield type-break from variations in the interval timer packages
 928 ;;; for different versions of emacs.
 929
 930 (defun type-break-run-at-time (time repeat function)
 931   (cond ((eq type-break-emacs-variant 'standard19)
 932          (require 'timer)
 933          (funcall 'run-at-time time repeat function))
 934         ((eq type-break-emacs-variant 'lucid-19-8)
 935          (let ((name (if (symbolp function)
 936                          (symbol-name function)
 937                        "type-break")))
 938            (require 'timer)
 939            (funcall 'start-timer name function time repeat)))
 940         ((memq type-break-emacs-variant '(xemacs lucid))
 941          (let ((name (if (symbolp function)
 942                          (symbol-name function)
 943                        "type-break")))
 944            (require 'itimer)
 945            (funcall 'start-itimer name function time repeat)))))
 946
 947 (defun type-break-cancel-function-timers (function)
 948   (cond ((eq type-break-emacs-variant 'standard19)
 949          (let ((timer-dont-exit t))
 950            (funcall 'cancel-function-timers function)))
 951         ((eq type-break-emacs-variant 'lucid-19-8)
 952          (let ((list timer-list))
 953            (while list
 954              (and (eq (funcall 'timer-function (car list)) function)
 955                   (funcall 'delete-timer (car list)))
 956              (setq list (cdr list)))))
 957         ((memq type-break-emacs-variant '(xemacs lucid))
 958          (let ((list itimer-list))
 959            (while list
 960              (and (eq (funcall 'itimer-function (car list)) function)
 961                   (funcall 'delete-itimer (car list)))
 962              (setq list (cdr list)))))))
 963
 964 \f
 965 ;;; Demo wrappers
 966
 967 ;; This is a wrapper around hanoi that calls it with an arg large enough to
 968 ;; make the largest discs possible that will fit in the window.
 969 ;; Also, clean up the *Hanoi* buffer after we're done.
 970 (defun type-break-demo-hanoi ()
 971   "Take a hanoiing typing break."
 972   (and (get-buffer "*Hanoi*")
 973        (kill-buffer "*Hanoi*"))
 974   (condition-case ()
 975       (progn
 976         (hanoi (/ (window-width) 8))
 977         ;; Wait for user to come back.
 978         (read-char)
 979         (kill-buffer "*Hanoi*"))
 980     (quit
 981      ;; eat char
 982      (read-char)
 983      (and (get-buffer "*Hanoi*")
 984           (kill-buffer "*Hanoi*")))))
 985
 986 ;; This is a wrapper around life that calls it with a `sleep' arg to make
 987 ;; it run a little more leisurely.
 988 ;; Also, clean up the *Life* buffer after we're done.
 989 (defun type-break-demo-life ()
 990   "Take a typing break and get a life."
 991   (let ((continue t))
 992     (while continue
 993       (setq continue nil)
 994       (and (get-buffer "*Life*")
 995            (kill-buffer "*Life*"))
 996       (condition-case ()
 997           (progn
 998             (life 3)
 999             ;; wait for user to return
1000             (read-char)
1001             (kill-buffer "*Life*"))
1002         (life-extinct
1003          (message "%s" (get 'life-extinct 'error-message))
1004          (sit-for 3)
1005          ;; restart demo
1006          (setq continue t))
1007         (quit
1008          (and (get-buffer "*Life*")
1009               (kill-buffer "*Life*")))))))
1010
1011 ;; Boring demo, but doesn't use many cycles
1012 (defun type-break-demo-boring ()
1013   "Boring typing break demo."
1014   (let ((rmsg "Press any key to resume from typing break")
1015         (buffer-name "*Typing Break Buffer*")
1016         line col pos
1017         elapsed timeleft tmsg)
1018     (condition-case ()
1019         (progn
1020           (switch-to-buffer (get-buffer-create buffer-name))
1021           (buffer-disable-undo (current-buffer))
1022           (erase-buffer)
1023           (setq line (1+ (/ (window-height) 2)))
1024           (setq col (/ (- (window-width) (length rmsg)) 2))
1025           (insert (make-string line ?\C-j)
1026                   (make-string col ?\ )
1027                   rmsg)
1028           (forward-line -1)
1029           (beginning-of-line)
1030           (setq pos (point))
1031           (while (not (input-pending-p))
1032             (delete-region pos (progn
1033                                  (goto-char pos)
1034                                  (end-of-line)
1035                                  (point)))
1036             (setq elapsed (type-break-time-difference
1037                            type-break-time-last-break
1038                            (current-time)))
1039             (cond
1040              (type-break-good-rest-interval
1041               (setq timeleft (- type-break-good-rest-interval elapsed))
1042               (if (> timeleft 0)
1043                   (setq tmsg (format "You should rest for %s more"
1044                                      (type-break-format-time timeleft)))
1045                 (setq tmsg (format "Typing break has lasted %s"
1046                                    (type-break-format-time elapsed)))))
1047              (t
1048               (setq tmsg (format "Typing break has lasted %s"
1049                                  (type-break-format-time elapsed)))))
1050             (setq col (/ (- (window-width) (length tmsg)) 2))
1051             (insert (make-string col ?\ ) tmsg)
1052             (goto-char (point-min))
1053             (sit-for 60))
1054           (read-char)
1055           (kill-buffer buffer-name))
1056       (quit
1057        (and (get-buffer buffer-name)
1058             (kill-buffer buffer-name))))))
1059
1060 \f
1061 (provide 'type-break)
1062
1063 (if type-break-mode
1064     (type-break-mode 1))
1065 ;;; type-break.el ends here