Commit | Line | Data |
---|---|---|
be8d412c | 1 | ;;; type-break.el --- encourage rests from typing at appropriate intervals |
458401b6 | 2 | |
846f6dd9 | 3 | ;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc. |
99c0333b | 4 | |
f6cafb3e NF |
5 | ;; Author: Noah Friedman |
6 | ;; Maintainer: Noah Friedman <friedman@splode.com> | |
99c0333b | 7 | ;; Keywords: extensions, timers |
846f6dd9 | 8 | ;; Status: Works in GNU Emacs 19.25 or later, some versions of XEmacs |
99c0333b | 9 | ;; Created: 1994-07-13 |
846f6dd9 | 10 | |
4de26885 | 11 | ;; $Id: type-break.el,v 1.21 1999/03/30 21:37:10 kwzh Exp fx $ |
99c0333b NF |
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 | |
b4dc9e6a NF |
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. | |
458401b6 NF |
29 | |
30 | ;;; Commentary: | |
be8d412c | 31 | |
b4dc9e6a NF |
32 | ;; The docstring for the function `type-break-mode' summarizes most of the |
33 | ;; details of the interface. | |
be8d412c | 34 | |
b4dc9e6a NF |
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. | |
be8d412c | 41 | |
846f6dd9 NF |
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'. | |
b4dc9e6a NF |
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 | ||
846f6dd9 NF |
59 | ;; This program has no hope of working in Emacs 18. |
60 | ||
b4dc9e6a NF |
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.ai.mit.edu> | |
64 | ;; Kleanthes Koniaris <kgk@martigny.ai.mit.edu> | |
65 | ;; Mark Ashton <mpashton@gnu.ai.mit.edu> | |
66 | ;; Matt Wilding <wilding@cli.com> | |
846f6dd9 | 67 | ;; Robert S. Boyer <boyer@cs.utexas.edu> |
be8d412c | 68 | |
458401b6 NF |
69 | ;;; Code: |
70 | ||
71 | \f | |
104221a0 SE |
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 | ||
622aca7c | 77 | ;;;###autoload |
104221a0 | 78 | (defcustom type-break-mode nil |
511a0719 | 79 | "Toggle typing break mode. |
104221a0 | 80 | See the docstring for the `type-break-mode' command for more information. |
4de26885 DL |
81 | Setting this variable directly does not take effect; |
82 | use either \\[customize] or the function `type-break-mode'." | |
104221a0 SE |
83 | :set (lambda (symbol value) |
84 | (type-break-mode (if value 1 -1))) | |
e18b0c51 | 85 | :initialize 'custom-initialize-default |
104221a0 SE |
86 | :type 'boolean |
87 | :group 'type-break | |
e18b0c51 | 88 | :require 'type-break) |
4cf64c15 NF |
89 | |
90 | ;;;###autoload | |
104221a0 SE |
91 | (defcustom type-break-interval (* 60 60) |
92 | "*Number of seconds between scheduled typing breaks." | |
93 | :type 'integer | |
94 | :group 'type-break) | |
458401b6 | 95 | |
be8d412c | 96 | ;;;###autoload |
104221a0 | 97 | (defcustom type-break-good-rest-interval (/ type-break-interval 6) |
be8d412c NF |
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 | |
cc669dd8 | 101 | keystrokes. If this idle time is long enough to be considered a \"good\" |
be8d412c NF |
102 | rest from typing, then the next typing break is simply rescheduled for later. |
103 | ||
cc669dd8 | 104 | If a break is interrupted before this much time elapses, the user will be |
104221a0 SE |
105 | asked whether or not really to interrupt the break." |
106 | :type 'integer | |
107 | :group 'type-break) | |
be8d412c | 108 | |
458401b6 | 109 | ;;;###autoload |
104221a0 | 110 | (defcustom type-break-keystroke-threshold |
cc669dd8 | 111 | ;; Assuming typing speed is 35wpm (on the average, do you really |
f486195c NF |
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 | |
4cf64c15 NF |
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. | |
f486195c | 118 | ;; Conversely, the minimum threshold should be about a fifth of this. |
cc669dd8 | 119 | (let* ((wpm 35) |
4cf64c15 NF |
120 | (avg-word-length 5) |
121 | (upper (* wpm avg-word-length (/ type-break-interval 60))) | |
f486195c | 122 | (lower (/ upper 5))) |
4cf64c15 NF |
123 | (cons lower upper)) |
124 | "*Upper and lower bound on number of keystrokes for considering typing break. | |
104221a0 | 125 | This structure is a pair of numbers (MIN . MAX). |
4cf64c15 | 126 | |
be8d412c NF |
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. | |
4cf64c15 NF |
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 | |
be8d412c NF |
136 | scheduled break. If this second value is nil, then no pre-emptive breaks |
137 | will occur; only scheduled ones will. | |
4cf64c15 NF |
138 | |
139 | Keys with bucky bits (shift, control, meta, etc) are counted as only one | |
b4dc9e6a NF |
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 | |
104221a0 SE |
143 | guess a reasonably good pair of values for this variable." |
144 | :type 'sexp | |
145 | :group 'type-break) | |
b4dc9e6a | 146 | |
104221a0 | 147 | (defcustom type-break-query-mode t |
846f6dd9 NF |
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 | |
104221a0 SE |
150 | `type-break-query-function' to do the asking." |
151 | :type 'boolean | |
152 | :group 'type-break) | |
846f6dd9 | 153 | |
b4dc9e6a NF |
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 | ||
846f6dd9 | 159 | To avoid being queried at all, set `type-break-query-mode' to `nil'.") |
b4dc9e6a | 160 | |
104221a0 | 161 | (defcustom type-break-query-interval 60 |
b4dc9e6a NF |
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 | |
104221a0 SE |
164 | finally submits to taking a typing break." |
165 | :type 'integer | |
166 | :group 'type-break) | |
be8d412c | 167 | |
104221a0 | 168 | (defcustom type-break-time-warning-intervals '(300 120 60 30) |
e7b20417 NF |
169 | "*List of time intervals for warnings about upcoming typing break. |
170 | At each of the intervals (specified in seconds) away from a scheduled | |
104221a0 SE |
171 | typing break, print a warning in the echo area." |
172 | :type '(repeat integer) | |
173 | :group 'type-break) | |
e7b20417 | 174 | |
104221a0 | 175 | (defcustom type-break-keystroke-warning-intervals '(300 200 100 50) |
e7b20417 NF |
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 | |
104221a0 SE |
180 | will occur." |
181 | :type '(repeat integer) | |
182 | :group 'type-break) | |
183 | ||
e7b20417 | 184 | |
104221a0 | 185 | (defcustom type-break-warning-repeat 40 |
e7b20417 NF |
186 | "*Number of keystrokes for which warnings should be repeated. |
187 | That is, for each of this many keystrokes the warning is redisplayed | |
104221a0 SE |
188 | in the echo area to make sure it's really seen." |
189 | :type 'integer | |
190 | :group 'type-break) | |
e7b20417 | 191 | |
104221a0 | 192 | (defcustom type-break-demo-functions |
e7b20417 | 193 | '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi) |
cc669dd8 | 194 | "*List of functions to consider running as demos during typing breaks. |
458401b6 NF |
195 | When a typing break begins, one of these functions is selected randomly |
196 | to have emacs do something interesting. | |
622aca7c | 197 | |
cc669dd8 | 198 | Any function in this list should start a demo which ceases as soon as a |
104221a0 SE |
199 | key is pressed." |
200 | :type '(repeat function) | |
201 | :group 'type-break) | |
622aca7c | 202 | |
846f6dd9 | 203 | (defvar type-break-post-command-hook '(type-break-check) |
b4dc9e6a NF |
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.") | |
e7b20417 | 211 | |
846f6dd9 NF |
212 | \f |
213 | ;; Mode line frobs | |
214 | ||
104221a0 | 215 | (defcustom type-break-mode-line-message-mode nil |
846f6dd9 NF |
216 | "*Non-`nil' means put type-break related messages in the mode line. |
217 | Otherwise, messages typically go in the echo area. | |
218 | ||
104221a0 SE |
219 | See also `type-break-mode-line-format' and its members." |
220 | :type 'boolean | |
221 | :group 'type-break) | |
846f6dd9 NF |
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 | |
4cf64c15 | 259 | ;; These are internal variables. Do not set them yourself. |
622aca7c | 260 | |
defa7346 | 261 | (defvar type-break-alarm-p nil) |
be8d412c | 262 | (defvar type-break-keystroke-count 0) |
be8d412c NF |
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)) | |
e7b20417 NF |
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) | |
cc669dd8 | 270 | |
846f6dd9 NF |
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) | |
104221a0 | 284 | ("^GNU Emacs 20" . standard19) |
846f6dd9 NF |
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))))) | |
bc3cb41d | 294 | (set-match-data data) |
846f6dd9 NF |
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)) | |
b4dc9e6a | 302 | |
cc669dd8 | 303 | \f |
4cf64c15 NF |
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 | ||
4cf64c15 | 317 | A negative prefix argument disables this mode. |
cc669dd8 | 318 | No argument or any non-negative argument enables it. |
4cf64c15 NF |
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 | ||
be8d412c NF |
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. | |
4cf64c15 NF |
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 | ||
cc669dd8 NF |
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. | |
be8d412c NF |
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 | |
b4dc9e6a | 343 | the command `type-break-guesstimate-keystroke-threshold' to try to |
be8d412c | 344 | approximate good values for this. |
4cf64c15 | 345 | |
b4dc9e6a NF |
346 | There are several variables that affect how or when warning messages about |
347 | imminent typing breaks are displayed. They include: | |
348 | ||
2157be68 RS |
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' | |
b4dc9e6a | 355 | |
846f6dd9 NF |
356 | There are several variables that affect if, how, and when queries to begin |
357 | a typing break occur. They include: | |
b4dc9e6a | 358 | |
2157be68 RS |
359 | `type-break-query-mode' |
360 | `type-break-query-function' | |
361 | `type-break-query-interval' | |
b4dc9e6a | 362 | |
be8d412c | 363 | Finally, the command `type-break-statistics' prints interesting things." |
4cf64c15 | 364 | (interactive "P") |
846f6dd9 | 365 | (type-break-check-post-command-hook) |
4cf64c15 | 366 | |
be8d412c | 367 | (let ((already-enabled type-break-mode)) |
cc669dd8 | 368 | (setq type-break-mode (>= (prefix-numeric-value prefix) 0)) |
be8d412c NF |
369 | |
370 | (cond | |
371 | ((and already-enabled type-break-mode) | |
372 | (and (interactive-p) | |
2157be68 | 373 | (message "Type Break mode is already enabled"))) |
be8d412c | 374 | (type-break-mode |
846f6dd9 NF |
375 | (or global-mode-string |
376 | (setq global-mode-string '(""))) | |
7cd3279a RS |
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))) | |
e7b20417 | 382 | (type-break-keystroke-reset) |
846f6dd9 | 383 | (type-break-mode-line-countdown-or-break nil) |
be8d412c NF |
384 | (type-break-schedule) |
385 | (and (interactive-p) | |
2157be68 | 386 | (message "Type Break mode is enabled and reset"))) |
846f6dd9 NF |
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) | |
2157be68 | 392 | (message "Type Break mode is disabled"))))) |
4cf64c15 NF |
393 | type-break-mode) |
394 | ||
846f6dd9 NF |
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 | ||
2157be68 RS |
406 | `mode-line-format' |
407 | `global-mode-string' | |
408 | `type-break-mode-line-break-message' | |
409 | `type-break-mode-line-warning'" | |
846f6dd9 NF |
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'. | |
b4dc9e6a NF |
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") | |
846f6dd9 NF |
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) | |
b4dc9e6a | 439 | |
846f6dd9 | 440 | \f |
622aca7c | 441 | ;;;###autoload |
458401b6 NF |
442 | (defun type-break () |
443 | "Take a typing break. | |
444 | ||
4cf64c15 | 445 | During the break, a demo selected from the functions listed in |
cc669dd8 | 446 | `type-break-demo-functions' is run. |
458401b6 | 447 | |
4cf64c15 | 448 | After the typing break is finished, the next break is scheduled |
cc669dd8 | 449 | as per the function `type-break-schedule'." |
622aca7c | 450 | (interactive) |
e7b20417 | 451 | (type-break-cancel-schedule) |
cc669dd8 NF |
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)))) | |
be8d412c | 471 | |
cc669dd8 NF |
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)) | |
b4dc9e6a NF |
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)) | |
e7b20417 | 484 | ((funcall |
cc669dd8 NF |
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))))) | |
4cf64c15 | 492 | |
e7b20417 | 493 | (type-break-keystroke-reset) |
846f6dd9 | 494 | (type-break-mode-line-countdown-or-break nil) |
be8d412c | 495 | (type-break-schedule)) |
622aca7c | 496 | |
458401b6 | 497 | \f |
458401b6 | 498 | (defun type-break-schedule (&optional time) |
defa7346 NF |
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)))) | |
458401b6 | 503 | (or time (setq time type-break-interval)) |
846f6dd9 | 504 | (type-break-check-post-command-hook) |
4cf64c15 | 505 | (type-break-cancel-schedule) |
e7b20417 | 506 | (type-break-time-warning-schedule time 'reset) |
846f6dd9 | 507 | (type-break-run-at-time (max 1 time) nil 'type-break-alarm) |
defa7346 NF |
508 | (setq type-break-time-next-break |
509 | (type-break-time-sum (current-time) time))) | |
622aca7c | 510 | |
4cf64c15 | 511 | (defun type-break-cancel-schedule () |
e7b20417 | 512 | (type-break-cancel-time-warning-schedule) |
846f6dd9 | 513 | (type-break-cancel-function-timers 'type-break-alarm) |
be8d412c NF |
514 | (setq type-break-alarm-p nil) |
515 | (setq type-break-time-next-break nil)) | |
458401b6 | 516 | |
e7b20417 | 517 | (defun type-break-time-warning-schedule (&optional time resetp) |
b4dc9e6a | 518 | (let ((type-break-current-time-warning-interval nil)) |
e7b20417 | 519 | (type-break-cancel-time-warning-schedule)) |
846f6dd9 | 520 | (add-hook 'type-break-post-command-hook 'type-break-time-warning 'append) |
e7b20417 NF |
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 | ||
b4dc9e6a NF |
542 | ;(let (type-break-current-time-warning-interval) |
543 | ; (type-break-cancel-time-warning-schedule)) | |
846f6dd9 | 544 | (type-break-run-at-time (max 1 time) nil 'type-break-time-warning-alarm) |
b4dc9e6a NF |
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")))))))) | |
e7b20417 NF |
552 | |
553 | (defun type-break-cancel-time-warning-schedule () | |
846f6dd9 | 554 | (type-break-cancel-function-timers 'type-break-time-warning-alarm) |
e7b20417 NF |
555 | (remove-hook 'type-break-post-command-hook 'type-break-time-warning) |
556 | (setq type-break-current-time-warning-interval | |
b4dc9e6a NF |
557 | type-break-time-warning-intervals) |
558 | (setq type-break-warning-countdown-string nil)) | |
e7b20417 | 559 | |
4cf64c15 | 560 | (defun type-break-alarm () |
846f6dd9 NF |
561 | (type-break-check-post-command-hook) |
562 | (setq type-break-alarm-p t) | |
563 | (type-break-mode-line-countdown-or-break 'break)) | |
458401b6 | 564 | |
e7b20417 | 565 | (defun type-break-time-warning-alarm () |
846f6dd9 | 566 | (type-break-check-post-command-hook) |
e7b20417 NF |
567 | (type-break-time-warning-schedule) |
568 | (setq type-break-time-warning-count type-break-warning-repeat) | |
846f6dd9 NF |
569 | (type-break-time-warning) |
570 | (type-break-mode-line-countdown-or-break 'countdown)) | |
e7b20417 NF |
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 | ||
458401b6 | 577 | (defun type-break-check () |
4cf64c15 NF |
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." | |
e7b20417 NF |
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) | |
846f6dd9 | 591 | (type-break-mode-line-countdown-or-break nil) |
e7b20417 NF |
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 | |
104221a0 SE |
597 | ;; next line is test for 20.2 that can be deleted |
598 | ;;(setq type-break-keystroke-count (1+ type-break-keystroke-count)) | |
b4dc9e6a NF |
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))))))) | |
e7b20417 | 608 | |
e7b20417 NF |
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 | |
b4dc9e6a | 619 | ;; max-threshold, lower it to reduce the likelihood of an |
e7b20417 NF |
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. | |
846f6dd9 | 641 | (defun type-break-check-keystroke-warning () |
b4dc9e6a NF |
642 | ;; This is safe because the caller should have checked that the cdr was |
643 | ;; non-nil already. | |
e7b20417 NF |
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) | |
b4dc9e6a NF |
658 | (setq type-break-warning-countdown-string (number-to-string left)) |
659 | (setq type-break-warning-countdown-string-type "keystrokes") | |
846f6dd9 | 660 | (type-break-mode-line-countdown-or-break 'countdown) |
e7b20417 | 661 | t)))) |
4cf64c15 | 662 | |
b4dc9e6a | 663 | ;; Arrange for a break query to be made, when the user stops typing furiously. |
4cf64c15 | 664 | (defun type-break-query () |
b4dc9e6a NF |
665 | (add-hook 'type-break-post-command-hook 'type-break-do-query)) |
666 | ||
b4dc9e6a NF |
667 | (defun type-break-do-query () |
668 | (cond | |
846f6dd9 NF |
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) | |
b4dc9e6a NF |
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)))) | |
458401b6 | 689 | |
846f6dd9 NF |
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 | ||
e7b20417 NF |
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) | |
b4dc9e6a NF |
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. | |
846f6dd9 NF |
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'. | |
b4dc9e6a | 719 | ((memq this-command '(digit-argument universal-argument))) |
846f6dd9 | 720 | ((not type-break-mode-line-message-mode) |
b4dc9e6a NF |
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)))))) | |
e7b20417 | 727 | (t |
b4dc9e6a NF |
728 | (remove-hook 'type-break-post-command-hook 'type-break-time-warning) |
729 | (setq type-break-warning-countdown-string nil)))) | |
e7b20417 NF |
730 | |
731 | (defun type-break-keystroke-warning () | |
732 | (cond | |
733 | ((> type-break-keystroke-warning-count 0) | |
b4dc9e6a NF |
734 | (setq type-break-warning-countdown-string |
735 | (number-to-string (- (cdr type-break-keystroke-threshold) | |
736 | type-break-keystroke-count))) | |
e7b20417 NF |
737 | (cond |
738 | ((eq (selected-window) (minibuffer-window))) | |
846f6dd9 NF |
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) | |
e7b20417 NF |
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 | |
b4dc9e6a NF |
753 | 'type-break-keystroke-warning) |
754 | (setq type-break-warning-countdown-string nil)))) | |
458401b6 | 755 | |
846f6dd9 NF |
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 | ||
458401b6 | 776 | \f |
be8d412c NF |
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 | |
b4dc9e6a | 785 | Typing break mode is currently %s. |
846f6dd9 NF |
786 | Interactive query for breaks is %s. |
787 | Warnings of imminent typing breaks in mode line is %s. | |
b4dc9e6a NF |
788 | |
789 | Last typing break ended : %s | |
be8d412c NF |
790 | Next scheduled typing break : %s\n |
791 | Minimum keystroke threshold : %s | |
792 | Maximum keystroke threshold : %s | |
793 | Current keystroke count : %s" | |
b4dc9e6a | 794 | (if type-break-mode "enabled" "disabled") |
846f6dd9 NF |
795 | (if type-break-query-mode "enabled" "disabled") |
796 | (if type-break-mode-line-message-mode "enabled" "disabled") | |
be8d412c NF |
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) | |
6b62b567 | 801 | (format "%s\t(%s from now)" |
be8d412c | 802 | (current-time-string type-break-time-next-break) |
e7b20417 | 803 | (type-break-format-time |
cc669dd8 | 804 | (type-break-time-difference |
e7b20417 | 805 | (current-time) |
cc669dd8 | 806 | type-break-time-next-break))) |
be8d412c NF |
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 | |
b4dc9e6a | 813 | (defun type-break-guesstimate-keystroke-threshold (wpm &optional wordlen frac) |
be8d412c | 814 | "Guess values for the minimum/maximum keystroke threshold for typing breaks. |
b4dc9e6a | 815 | |
be8d412c | 816 | If called interactively, the user is prompted for their guess as to how |
b4dc9e6a NF |
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 | |
846f6dd9 | 820 | tends to type less when debugging a program as opposed to writing |
b4dc9e6a NF |
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. | |
be8d412c NF |
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." | |
b4dc9e6a | 834 | (interactive "NOn average, how many words per minute do you type? ") |
be8d412c | 835 | (let* ((upper (* wpm (or wordlen 5) (/ type-break-interval 60))) |
f486195c | 836 | (lower (/ upper (or frac 5)))) |
be8d412c NF |
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 | |
e7b20417 NF |
846 | ;;; misc functions |
847 | ||
848 | ;; Compute the difference, in seconds, between a and b, two structures | |
849 | ;; similar to those returned by `current-time'. | |
defa7346 NF |
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. | |
846f6dd9 | 853 | (defun type-break-time-difference (a b) |
e7b20417 NF |
854 | (+ (lsh (- (car b) (car a)) 16) |
855 | (- (car (cdr b)) (car (cdr a))))) | |
856 | ||
defa7346 NF |
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 | |
846f6dd9 | 863 | ;; "low" bits and format the time incorrectly. |
defa7346 NF |
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 | ||
846f6dd9 | 894 | (defun type-break-format-time (secs) |
e7b20417 NF |
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 | ||
846f6dd9 NF |
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 | ||
e7b20417 NF |
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 | |
b4dc9e6a | 1003 | (message "%s" (get 'life-extinct 'error-message)) |
e7b20417 NF |
1004 | (sit-for 3) |
1005 | ;; restart demo | |
1006 | (setq continue t)) | |
1007 | (quit | |
1008 | (and (get-buffer "*Life*") | |
1009 | (kill-buffer "*Life*"))))))) | |
1010 | ||
defa7346 | 1011 | ;; Boring demo, but doesn't use many cycles |
e7b20417 NF |
1012 | (defun type-break-demo-boring () |
1013 | "Boring typing break demo." | |
defa7346 | 1014 | (let ((rmsg "Press any key to resume from typing break") |
e7b20417 | 1015 | (buffer-name "*Typing Break Buffer*") |
defa7346 NF |
1016 | line col pos |
1017 | elapsed timeleft tmsg) | |
e7b20417 NF |
1018 | (condition-case () |
1019 | (progn | |
1020 | (switch-to-buffer (get-buffer-create buffer-name)) | |
1021 | (buffer-disable-undo (current-buffer)) | |
1022 | (erase-buffer) | |
defa7346 NF |
1023 | (setq line (1+ (/ (window-height) 2))) |
1024 | (setq col (/ (- (window-width) (length rmsg)) 2)) | |
e7b20417 NF |
1025 | (insert (make-string line ?\C-j) |
1026 | (make-string col ?\ ) | |
defa7346 NF |
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)) | |
e7b20417 NF |
1054 | (read-char) |
1055 | (kill-buffer buffer-name)) | |
1056 | (quit | |
1057 | (and (get-buffer buffer-name) | |
1058 | (kill-buffer buffer-name)))))) | |
1059 | ||
1060 | \f | |
458401b6 NF |
1061 | (provide 'type-break) |
1062 | ||
104221a0 SE |
1063 | (if type-break-mode |
1064 | (type-break-mode 1)) | |
458401b6 | 1065 | ;;; type-break.el ends here |