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