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