* rlogin.el (rlogin): recognise the `-l user' option to rlogin and
[bpt/emacs.git] / lisp / type-break.el
CommitLineData
be8d412c 1;;; type-break.el --- encourage rests from typing at appropriate intervals
458401b6 2
458401b6
NF
3;;; Copyright (C) 1994 Noah S. Friedman
4
5;;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
458401b6 6;;; Maintainer: friedman@prep.ai.mit.edu
4cf64c15 7;;; Keywords: extensions, timers
be8d412c 8;;; Status: known to work in GNU Emacs 19.25 or later.
458401b6
NF
9;;; Created: 1994-07-13
10
4cf64c15
NF
11;;; LCD Archive Entry:
12;;; type-break|Noah Friedman|friedman@prep.ai.mit.edu|
be8d412c 13;;; encourage rests from typing at appropriate intervals|
4cf64c15
NF
14;;; $Date$|$Revision$||
15
458401b6
NF
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:
be8d412c
NF
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
be8d412c 45;;; This package was inspired by Roland McGrath's hanoi-break.el.
e7b20417
NF
46;;; Thanks to both Roland McGrath <roland@gnu.ai.mit.edu> and Mark Ashton
47;;; <mpashton@gnu.ai.mit.edu> for feedback and ideas.
be8d412c 48
458401b6
NF
49;;; Code:
50
51\f
622aca7c
RM
52(require 'timer)
53
be8d412c
NF
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.
622aca7c 56;;;###autoload
be8d412c 57(defvar type-break-mode nil
4cf64c15
NF
58 "*Non-`nil' means typing break mode is enabled.
59See 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.")
458401b6 64
be8d412c
NF
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
69When this variable is non-`nil', emacs checks the idle time between
cc669dd8 70keystrokes. If this idle time is long enough to be considered a \"good\"
be8d412c
NF
71rest from typing, then the next typing break is simply rescheduled for later.
72
cc669dd8
NF
73If a break is interrupted before this much time elapses, the user will be
74asked whether or not really to interrupt the break.")
be8d412c 75
458401b6 76;;;###autoload
4cf64c15 77(defvar type-break-keystroke-threshold
cc669dd8 78 ;; Assuming typing speed is 35wpm (on the average, do you really
f486195c
NF
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
4cf64c15
NF
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.
f486195c 85 ;; Conversely, the minimum threshold should be about a fifth of this.
cc669dd8 86 (let* ((wpm 35)
4cf64c15
NF
87 (avg-word-length 5)
88 (upper (* wpm avg-word-length (/ type-break-interval 60)))
f486195c 89 (lower (/ upper 5)))
4cf64c15
NF
90 (cons lower upper))
91 "*Upper and lower bound on number of keystrokes for considering typing break.
be8d412c 92This structure is a pair of numbers.
4cf64c15 93
be8d412c
NF
94The first number is the minimum number of keystrokes that must have been
95entered since the last typing break before considering another one, even if
96the scheduled time has elapsed; the break is simply rescheduled until later
97if the minimum threshold hasn't been reached. If this first value is nil,
98then there is no minimum threshold; as soon as the scheduled time has
99elapsed, the user will always be queried.
4cf64c15
NF
100
101The second number is the maximum number of keystrokes that can be entered
102before a typing break is requested immediately, pre-empting the originally
be8d412c
NF
103scheduled break. If this second value is nil, then no pre-emptive breaks
104will occur; only scheduled ones will.
4cf64c15
NF
105
106Keys with bucky bits (shift, control, meta, etc) are counted as only one
107keystroke even though they really require multiple keys to generate them.")
be8d412c 108
e7b20417
NF
109(defvar type-break-time-warning-intervals '(300 120 60 30)
110 "*List of time intervals for warnings about upcoming typing break.
111At each of the intervals (specified in seconds) away from a scheduled
112typing 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.
116At each of the intervals (specified in keystrokes) away from the upper
117keystroke threshold, print a warning in the echo area.
118If either this variable or the upper threshold is set, then no warnings
119Will occur.")
120
121(defvar type-break-query-interval 60
122 "*Number of seconds between queries to take a break, if put off.
123The user will continue to be prompted at this interval until he or she
124finally submits to taking a typing break.")
125
126(defvar type-break-warning-repeat 40
127 "*Number of keystrokes for which warnings should be repeated.
128That is, for each of this many keystrokes the warning is redisplayed
129in the echo area to make sure it's really seen.")
130
4cf64c15 131(defvar type-break-query-function 'yes-or-no-p
e7b20417 132 "Function to use for making query for a typing break.
4cf64c15
NF
133It should take a string as an argument, the prompt.
134Usually this should be set to `yes-or-no-p' or `y-or-n-p'.")
135
cc669dd8 136(defvar type-break-demo-functions
e7b20417 137 '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi)
cc669dd8 138 "*List of functions to consider running as demos during typing breaks.
458401b6
NF
139When a typing break begins, one of these functions is selected randomly
140to have emacs do something interesting.
622aca7c 141
cc669dd8 142Any function in this list should start a demo which ceases as soon as a
458401b6 143key is pressed.")
622aca7c 144
e7b20417
NF
145(defvar type-break-post-command-hook nil
146 "Hook run indirectly by post-command-hook for typing break functions.")
147
4cf64c15 148;; These are internal variables. Do not set them yourself.
622aca7c 149
defa7346 150(defvar type-break-alarm-p nil)
be8d412c 151(defvar type-break-keystroke-count 0)
be8d412c
NF
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))
e7b20417
NF
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)
cc669dd8
NF
159
160\f
4cf64c15
NF
161;;;###autoload
162(defun type-break-mode (&optional prefix)
163 "Enable or disable typing-break mode.
164This is a minor mode, but it is global to all buffers by default.
165
166When this mode is enabled, the user is encouraged to take typing breaks at
167appropriate intervals; either after a specified amount of time or when the
168user has exceeded a keystroke threshold. When the time arrives, the user
169is asked to take a break. If the user refuses at that time, emacs will ask
170again in a short period of time. The idea is to give the user enough time
171to find a good breaking point in his or her work, but be sufficiently
172annoying to discourage putting typing breaks off indefinitely.
173
4cf64c15 174A negative prefix argument disables this mode.
cc669dd8 175No argument or any non-negative argument enables it.
4cf64c15
NF
176
177The user may enable or disable this mode by setting the variable of the
178same name, though setting it in that way doesn't reschedule a break or
179reset the keystroke counter.
180
be8d412c
NF
181If the mode was previously disabled and is enabled as a consequence of
182calling this function, it schedules a break with `type-break-schedule' to
183make sure one occurs (the user can call that command to reschedule the
184break at any time). It also initializes the keystroke counter.
4cf64c15
NF
185
186The variable `type-break-interval' specifies the number of seconds to
187schedule between regular typing breaks. This variable doesn't directly
188affect the time schedule; it simply provides a default for the
189`type-break-schedule' command.
190
cc669dd8
NF
191If set, the variable `type-break-good-rest-interval' specifies the minimum
192amount of time which is considered a reasonable typing break. Whenever
193that time has elapsed, typing breaks are automatically rescheduled for
194later even if emacs didn't prompt you to take one first. Also, if a break
195is ended before this much time has elapsed, the user will be asked whether
196or not to continue.
be8d412c
NF
197
198The variable `type-break-keystroke-threshold' is used to determine the
199thresholds at which typing breaks should be considered. You can use
200the command `type-break-guestimate-keystroke-threshold' to try to
201approximate good values for this.
4cf64c15 202
be8d412c 203Finally, the command `type-break-statistics' prints interesting things."
4cf64c15
NF
204 (interactive "P")
205 ;; make sure it's there.
e7b20417
NF
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)
4cf64c15 208
be8d412c 209 (let ((already-enabled type-break-mode))
cc669dd8 210 (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
be8d412c
NF
211
212 (cond
213 ((and already-enabled type-break-mode)
214 (and (interactive-p)
cc669dd8 215 (message "type-break-mode is enabled")))
be8d412c 216 (type-break-mode
e7b20417 217 (type-break-keystroke-reset)
be8d412c
NF
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"))))
4cf64c15
NF
223 type-break-mode)
224
622aca7c 225;;;###autoload
458401b6
NF
226(defun type-break ()
227 "Take a typing break.
228
4cf64c15 229During the break, a demo selected from the functions listed in
cc669dd8 230`type-break-demo-functions' is run.
458401b6 231
4cf64c15 232After the typing break is finished, the next break is scheduled
cc669dd8 233as per the function `type-break-schedule'."
622aca7c 234 (interactive)
e7b20417 235 (type-break-cancel-schedule)
cc669dd8
NF
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))))
be8d412c 255
cc669dd8
NF
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))
e7b20417
NF
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)))
cc669dd8 266 (setq continue nil))
e7b20417 267 ((funcall
cc669dd8
NF
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)))))
4cf64c15 275
e7b20417 276 (type-break-keystroke-reset)
be8d412c 277 (type-break-schedule))
622aca7c 278
458401b6 279\f
458401b6 280(defun type-break-schedule (&optional time)
defa7346
NF
281 "Schedule a typing break for TIME seconds from now.
282If time is not specified, default to `type-break-interval'."
283 (interactive (list (and current-prefix-arg
284 (prefix-numeric-value current-prefix-arg))))
458401b6 285 (or time (setq time type-break-interval))
4cf64c15 286 (type-break-cancel-schedule)
e7b20417 287 (type-break-time-warning-schedule time 'reset)
be8d412c 288 (run-at-time time nil 'type-break-alarm)
defa7346
NF
289 (setq type-break-time-next-break
290 (type-break-time-sum (current-time) time)))
622aca7c 291
4cf64c15 292(defun type-break-cancel-schedule ()
e7b20417 293 (type-break-cancel-time-warning-schedule)
458401b6 294 (let ((timer-dont-exit t))
4cf64c15 295 (cancel-function-timers 'type-break-alarm))
be8d412c
NF
296 (setq type-break-alarm-p nil)
297 (setq type-break-time-next-break nil))
458401b6 298
e7b20417
NF
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
4cf64c15 334(defun type-break-alarm ()
4cf64c15 335 (setq type-break-alarm-p t))
458401b6 336
e7b20417
NF
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
458401b6 347(defun type-break-check ()
4cf64c15
NF
348 "Ask to take a typing break if appropriate.
349This may be the case either because the scheduled time has come \(and the
350minimum keystroke threshold has been reached\) or because the maximum
351keystroke threshold has been exceeded."
e7b20417
NF
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))))
4cf64c15
NF
420
421(defun type-break-query ()
422 (condition-case ()
423 (cond
e7b20417
NF
424 ((let ((type-break-mode nil))
425 (funcall type-break-query-function "Take a break from typing now? "))
4cf64c15
NF
426 (type-break))
427 (t
428 (type-break-schedule type-break-query-interval)))
429 (quit
430 (type-break-schedule type-break-query-interval))))
458401b6 431
e7b20417
NF
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))))
458401b6
NF
466
467\f
be8d412c
NF
468;;;###autoload
469(defun type-break-statistics ()
470 "Print statistics about typing breaks in a temporary buffer.
471This includes the last time a typing break was taken, when the next one is
472scheduled, 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
476Last typing break : %s
477Next scheduled typing break : %s\n
478Minimum keystroke threshold : %s
479Maximum keystroke threshold : %s
480Current 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)
6b62b567 485 (format "%s\t(%s from now)"
be8d412c 486 (current-time-string type-break-time-next-break)
e7b20417 487 (type-break-format-time
cc669dd8 488 (type-break-time-difference
e7b20417 489 (current-time)
cc669dd8 490 type-break-time-next-break)))
be8d412c
NF
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.
499If called interactively, the user is prompted for their guess as to how
500many words per minute they usually type. From that, the command sets the
501values in `type-break-keystroke-threshold' based on a fairly simple
502algorithm involving assumptions about the average length of words (5).
503For the minimum threshold, it uses about a quarter of the computed maximum
504threshold.
505
506When called from lisp programs, the optional args WORDLEN and FRAC can be
507used to override the default assumption about average word length and the
508fraction of the maximum threshold to which to set the minimum threshold.
509FRAC should be the inverse of the fractional value; for example, a value of
5102 would mean to use one half, a value of 4 would mean to use one quarter, etc."
defa7346 511 (interactive "NHow many words per minute do you type? ")
be8d412c 512 (let* ((upper (* wpm (or wordlen 5) (/ type-break-interval 60)))
f486195c 513 (lower (/ upper (or frac 5))))
be8d412c
NF
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
e7b20417
NF
523;;; misc functions
524
525;; Compute the difference, in seconds, between a and b, two structures
526;; similar to those returned by `current-time'.
defa7346
NF
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.
e7b20417
NF
530(defsubst type-break-time-difference (a b)
531 (+ (lsh (- (car b) (car a)) 16)
532 (- (car (cdr b)) (car (cdr a)))))
533
defa7346
NF
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
e7b20417
NF
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
defa7346 633;; Boring demo, but doesn't use many cycles
e7b20417
NF
634(defun type-break-demo-boring ()
635 "Boring typing break demo."
defa7346 636 (let ((rmsg "Press any key to resume from typing break")
e7b20417 637 (buffer-name "*Typing Break Buffer*")
defa7346
NF
638 line col pos
639 elapsed timeleft tmsg)
e7b20417
NF
640 (condition-case ()
641 (progn
642 (switch-to-buffer (get-buffer-create buffer-name))
643 (buffer-disable-undo (current-buffer))
644 (erase-buffer)
defa7346
NF
645 (setq line (1+ (/ (window-height) 2)))
646 (setq col (/ (- (window-width) (length rmsg)) 2))
e7b20417
NF
647 (insert (make-string line ?\C-j)
648 (make-string col ?\ )
defa7346
NF
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))
e7b20417
NF
676 (read-char)
677 (kill-buffer buffer-name))
678 (quit
679 (and (get-buffer buffer-name)
680 (kill-buffer buffer-name))))))
681
682\f
458401b6
NF
683(provide 'type-break)
684
defa7346
NF
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)
622aca7c 688
e7b20417
NF
689;; local variables:
690;; vc-make-backup-files: t
691;; end:
692
458401b6 693;;; type-break.el ends here