comparison lisp/type-break.el @ 18416:2ec71bb15f86

Don't require timer; use autoloaded functions from Emacs or XEmacs, depending on variant. Do not use defsubst anywhere. Replace with defuns. (type-break-warning-message-mode): Variable deleted. (type-break-query-mode): New variable and function. (type-break-mode): Mention in docstring. (type-break-run-at-time): New function. All callers of run-at-time changed. (type-break-cancel-function-timers): New function. All callers of cancel-function-timers changed. (type-break-check-post-command-hook): New function. (type-break-mode, type-break-schedule, type-break-alarm, type-break-time-warning-alarm): Call it. (type-break-mode-line-countdown-or-break): New function. (type-break): Call it. (type-break-time-warning-schedule): Put type-break-time-warning on type-break-post-command-hook. (type-break-check): Call type-break-mode-line-countdown-or-break. (type-break-noninteractive-query): New function. (type-break-force-mode-line-update): New function.
author Noah Friedman <friedman@splode.com>
date Mon, 23 Jun 1997 05:28:51 +0000
parents 8d2051b79879
children 43c77517a76c
comparison
equal deleted inserted replaced
18415:1cf4e09c841d 18416:2ec71bb15f86
1 ;;; type-break.el --- encourage rests from typing at appropriate intervals 1 ;;; type-break.el --- encourage rests from typing at appropriate intervals
2 2
3 ;; Copyright (C) 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc.
4 4
5 ;; Author: Noah Friedman <friedman@prep.ai.mit.edu> 5 ;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
6 ;; Maintainer: friedman@prep.ai.mit.edu 6 ;; Maintainer: friedman@prep.ai.mit.edu
7 ;; Keywords: extensions, timers 7 ;; Keywords: extensions, timers
8 ;; Status: Works in GNU Emacs 19.25 or later 8 ;; Status: Works in GNU Emacs 19.25 or later, some versions of XEmacs
9 ;; Created: 1994-07-13 9 ;; Created: 1994-07-13
10 ;; $Id: type-break.el,v 1.10 1994/10/06 19:12:46 friedman Exp friedman $ 10
11 ;; $Id$
11 12
12 ;; This file is part of GNU Emacs. 13 ;; This file is part of GNU Emacs.
13 14
14 ;; GNU Emacs is free software; you can redistribute it and/or modify 15 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by 16 ;; it under the terms of the GNU General Public License as published by
36 ;; suspend emacs or work in other windows) then this won't help very much; 37 ;; suspend emacs or work in other windows) then this won't help very much;
37 ;; it will depend on just how often you switch back to emacs. At the very 38 ;; it will depend on just how often you switch back to emacs. At the very
38 ;; least, you will want to turn off the keystroke thresholds and rest 39 ;; least, you will want to turn off the keystroke thresholds and rest
39 ;; interval tracking. 40 ;; interval tracking.
40 41
41 ;; This program has no hope of working in Emacs 18, and it doesn't 42 ;; If you prefer not to be queried about taking breaks, but instead just
42 ;; presently work in Lucid Emacs/XEmacs because the timer.el package is 43 ;; want to be reminded, do the following:
43 ;; entirely different. 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'.
44 53
45 ;; This program can truly cons up a storm because of all the calls to 54 ;; This program can truly cons up a storm because of all the calls to
46 ;; `current-time' (which always returns 3 fresh conses). I'm dismayed by 55 ;; `current-time' (which always returns 3 fresh conses). I'm dismayed by
47 ;; this, but I think the health of my hands is far more important than a 56 ;; this, but I think the health of my hands is far more important than a
48 ;; few pages of virtual memory. 57 ;; few pages of virtual memory.
58
59 ;; This program has no hope of working in Emacs 18.
49 60
50 ;; This package was inspired by Roland McGrath's hanoi-break.el. 61 ;; This package was inspired by Roland McGrath's hanoi-break.el.
51 ;; Several people contributed feedback and ideas, including 62 ;; Several people contributed feedback and ideas, including
52 ;; Roland McGrath <roland@gnu.ai.mit.edu> 63 ;; Roland McGrath <roland@gnu.ai.mit.edu>
53 ;; Kleanthes Koniaris <kgk@martigny.ai.mit.edu> 64 ;; Kleanthes Koniaris <kgk@martigny.ai.mit.edu>
54 ;; Mark Ashton <mpashton@gnu.ai.mit.edu> 65 ;; Mark Ashton <mpashton@gnu.ai.mit.edu>
55 ;; Matt Wilding <wilding@cli.com> 66 ;; Matt Wilding <wilding@cli.com>
67 ;; Robert S. Boyer <boyer@cs.utexas.edu>
56 68
57 ;;; Code: 69 ;;; Code:
58 70
59 71
60 (require 'timer)
61
62 ;; Make this nil initially so that the call to type-break-mode at the end
63 ;; will cause scheduling and so forth to happen.
64 ;;;###autoload 72 ;;;###autoload
65 (defvar type-break-mode nil 73 (defvar type-break-mode nil
66 "*Non-`nil' means typing break mode is enabled. 74 "*Non-`nil' means typing break mode is enabled.
67 See the docstring for the `type-break-mode' command for more information.") 75 See the docstring for the `type-break-mode' command for more information.")
68
69 (defvar type-break-warning-message-mode t
70 "*Non-`nil' means warn about imminent typing breaks in echo area.
71 See the docstring for the `type-break-warning-message-mode' command for
72 more information.")
73 76
74 ;;;###autoload 77 ;;;###autoload
75 (defvar type-break-interval (* 60 60) 78 (defvar type-break-interval (* 60 60)
76 "*Number of seconds between scheduled typing breaks.") 79 "*Number of seconds between scheduled typing breaks.")
77 80
120 keystroke even though they really require multiple keys to generate them. 123 keystroke even though they really require multiple keys to generate them.
121 124
122 The command `type-break-guesstimate-keystroke-threshold' can be used to 125 The command `type-break-guesstimate-keystroke-threshold' can be used to
123 guess a reasonably good pair of values for this variable.") 126 guess a reasonably good pair of values for this variable.")
124 127
128 (defvar type-break-query-mode t
129 "*Non-`nil' means ask whether or not to prompt user for breaks.
130 If so, call the function specified in the value of the variable
131 `type-break-query-function' to do the asking.")
132
125 (defvar type-break-query-function 'yes-or-no-p 133 (defvar type-break-query-function 'yes-or-no-p
126 "Function to use for making query for a typing break. 134 "Function to use for making query for a typing break.
127 It should take a string as an argument, the prompt. 135 It should take a string as an argument, the prompt.
128 Usually this should be set to `yes-or-no-p' or `y-or-n-p'. 136 Usually this should be set to `yes-or-no-p' or `y-or-n-p'.
129 137
130 Some people prefer a less intrusive way of being reminded to take a typing 138 To avoid being queried at all, set `type-break-query-mode' to `nil'.")
131 break. One possibility is simply to beep a couple of times. To accomplish
132 this, one could do:
133
134 (defun my-type-break-query (&optional ignored-args)
135 (beep t)
136 (message \"You should take a typing break now. Do `M-x type-break'.\")
137 (sit-for 1)
138 (beep t)
139 ;; return nil so query caller knows to reset reminder, as if user
140 ;; said \"no\" in response to yes-or-no-p.
141 nil)
142
143 (setq type-break-query-function 'my-type-break-query)")
144 139
145 (defvar type-break-query-interval 60 140 (defvar type-break-query-interval 60
146 "*Number of seconds between queries to take a break, if put off. 141 "*Number of seconds between queries to take a break, if put off.
147 The user will continue to be prompted at this interval until he or she 142 The user will continue to be prompted at this interval until he or she
148 finally submits to taking a typing break.") 143 finally submits to taking a typing break.")
162 (defvar type-break-warning-repeat 40 157 (defvar type-break-warning-repeat 40
163 "*Number of keystrokes for which warnings should be repeated. 158 "*Number of keystrokes for which warnings should be repeated.
164 That is, for each of this many keystrokes the warning is redisplayed 159 That is, for each of this many keystrokes the warning is redisplayed
165 in the echo area to make sure it's really seen.") 160 in the echo area to make sure it's really seen.")
166 161
167 (defvar type-break-warning-countdown-string nil
168 "If non-nil, this is a countdown for the next typing break.
169
170 This variable, in conjunction with `type-break-warning-countdown-string-type'
171 (which indicates whether this value is a number of keystrokes or seconds)
172 can be installed by the user somewhere in mode-line-format to notify of
173 imminent typing breaks there.
174
175 For example, you could do
176
177 (defvar type-break-mode-line-string
178 '(type-break-warning-countdown-string
179 (\" ***Break in \"
180 type-break-warning-countdown-string
181 \" \"
182 type-break-warning-countdown-string-type
183 \"***\")))
184
185 (setq global-mode-string
186 (append global-mode-string '(type-break-mode-line-string)))
187
188 If you do this, you may also wish to disable the warning messages in the
189 minibuffer. To do this, either set the variable
190 `type-break-warning-message-mode' to `nil' or call the function of the same
191 name with a negative argument.")
192
193 (defvar type-break-warning-countdown-string-type nil
194 "Indicates the unit type of `type-break-warning-countdown-string'.
195 It will be either \"seconds\" or \"keystrokes\".")
196
197 (defvar type-break-demo-functions 162 (defvar type-break-demo-functions
198 '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi) 163 '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi)
199 "*List of functions to consider running as demos during typing breaks. 164 "*List of functions to consider running as demos during typing breaks.
200 When a typing break begins, one of these functions is selected randomly 165 When a typing break begins, one of these functions is selected randomly
201 to have emacs do something interesting. 166 to have emacs do something interesting.
202 167
203 Any function in this list should start a demo which ceases as soon as a 168 Any function in this list should start a demo which ceases as soon as a
204 key is pressed.") 169 key is pressed.")
205 170
206 (defvar type-break-post-command-hook nil 171 (defvar type-break-post-command-hook '(type-break-check)
207 "Hook run indirectly by post-command-hook for typing break functions. 172 "Hook run indirectly by post-command-hook for typing break functions.
208 This is not really intended to be set by the user, but it's probably 173 This is not really intended to be set by the user, but it's probably
209 harmless to do so. Mainly it is used by various parts of the typing break 174 harmless to do so. Mainly it is used by various parts of the typing break
210 program to delay actions until after the user has completed some command. 175 program to delay actions until after the user has completed some command.
211 It exists because `post-command-hook' itself is inaccessible while its 176 It exists because `post-command-hook' itself is inaccessible while its
212 functions are being run, and some type-break--related functions want to 177 functions are being run, and some type-break--related functions want to
213 remove themselves after running.") 178 remove themselves after running.")
214 179
180
181 ;; Mode line frobs
182
183 (defvar type-break-mode-line-message-mode nil
184 "*Non-`nil' means put type-break related messages in the mode line.
185 Otherwise, messages typically go in the echo area.
186
187 See also `type-break-mode-line-format' and its members.")
188
189 (defvar type-break-mode-line-format
190 '(type-break-mode-line-message-mode
191 (""
192 type-break-mode-line-break-message
193 type-break-mode-line-warning))
194 "*Format of messages in the mode line concerning typing breaks.")
195
196 (defvar type-break-mode-line-break-message
197 '(type-break-mode-line-break-message-p
198 type-break-mode-line-break-string))
199
200 (defvar type-break-mode-line-break-message-p nil)
201 (defvar type-break-mode-line-break-string " *** TAKE A TYPING BREAK ***")
202
203 (defvar type-break-mode-line-warning
204 '(type-break-mode-line-break-message-p
205 ("")
206 (type-break-warning-countdown-string
207 (" ***Break in "
208 type-break-warning-countdown-string
209 " "
210 type-break-warning-countdown-string-type
211 "***"))))
212
213 (defvar type-break-warning-countdown-string nil
214 "If non-nil, this is a countdown for the next typing break.
215
216 This variable, in conjunction with `type-break-warning-countdown-string-type'
217 (which indicates whether this value is a number of keystrokes or seconds)
218 is installed in mode-line-format to notify of imminent typing breaks.")
219
220 (defvar type-break-warning-countdown-string-type nil
221 "Indicates the unit type of `type-break-warning-countdown-string'.
222 It will be either \"seconds\" or \"keystrokes\".")
223
224
215 ;; These are internal variables. Do not set them yourself. 225 ;; These are internal variables. Do not set them yourself.
216 226
217 (defvar type-break-alarm-p nil) 227 (defvar type-break-alarm-p nil)
218 (defvar type-break-keystroke-count 0) 228 (defvar type-break-keystroke-count 0)
219 (defvar type-break-time-last-break nil) 229 (defvar type-break-time-last-break nil)
221 (defvar type-break-time-last-command (current-time)) 231 (defvar type-break-time-last-command (current-time))
222 (defvar type-break-current-time-warning-interval nil) 232 (defvar type-break-current-time-warning-interval nil)
223 (defvar type-break-current-keystroke-warning-interval nil) 233 (defvar type-break-current-keystroke-warning-interval nil)
224 (defvar type-break-time-warning-count 0) 234 (defvar type-break-time-warning-count 0)
225 (defvar type-break-keystroke-warning-count 0) 235 (defvar type-break-keystroke-warning-count 0)
226 236
227 ;; This should return t if warnings were enabled, nil otherwise. 237 ;; Constant indicating emacs variant.
228 (defsubst type-break-check-keystroke-warning () 238 ;; This can be one of `xemacs', `lucid', `epoch', `mule', etc.
229 ;; This is safe because the caller should have checked that the cdr was 239 (defconst type-break-emacs-variant
230 ;; non-nil already. 240 (let ((data (match-data))
231 (let ((left (- (cdr type-break-keystroke-threshold) 241 (version (cond
232 type-break-keystroke-count))) 242 ((fboundp 'nemacs-version)
233 (cond 243 (nemacs-version))
234 ((null (car type-break-current-keystroke-warning-interval)) 244 (t
235 nil) 245 (emacs-version))))
236 ((> left (car type-break-current-keystroke-warning-interval)) 246 (alist '(("\\bXEmacs\\b" . xemacs)
237 nil) 247 ("\\bLucid\\b" . lucid)
238 (t 248 ("^Nemacs\\b" . nemacs)
239 (while (and (car type-break-current-keystroke-warning-interval) 249 ("^GNU Emacs 19" . standard19)
240 (< left (car type-break-current-keystroke-warning-interval))) 250 ("^GNU Emacs 18" . emacs18)))
241 (setq type-break-current-keystroke-warning-interval 251 result)
242 (cdr type-break-current-keystroke-warning-interval))) 252 (while alist
243 (setq type-break-keystroke-warning-count type-break-warning-repeat) 253 (cond
244 (add-hook 'type-break-post-command-hook 'type-break-keystroke-warning) 254 ((string-match (car (car alist)) version)
245 (setq type-break-warning-countdown-string (number-to-string left)) 255 (setq result (cdr (car alist)))
246 (setq type-break-warning-countdown-string-type "keystrokes") 256 (setq alist nil))
247 t)))) 257 (t
248 258 (setq alist (cdr alist)))))
249 ;; Compute the difference, in seconds, between a and b, two structures 259 (store-match-data data)
250 ;; similar to those returned by `current-time'. 260 (cond ((eq result 'lucid)
251 ;; Use addition rather than logand since that is more robust; the low 16 261 (and (string= emacs-version "19.8 Lucid")
252 ;; bits of the seconds might have been incremented, making it more than 16 262 (setq result 'lucid-19-8)))
253 ;; bits wide. 263 ((memq result '(nemacs emacs18))
254 (defsubst type-break-time-difference (a b) 264 (signal 'error
255 (+ (lsh (- (car b) (car a)) 16) 265 "type-break not supported in this version of emacs.")))
256 (- (car (cdr b)) (car (cdr a))))) 266 result))
257 267
258 (defsubst type-break-format-time (secs)
259 (let ((mins (/ secs 60)))
260 (cond
261 ((= mins 1) (format "%d minute" mins))
262 ((> mins 0) (format "%d minutes" mins))
263 ((= secs 1) (format "%d second" secs))
264 (t (format "%d seconds" secs)))))
265 268
266 ;;;###autoload 269 ;;;###autoload
267 (defun type-break-mode (&optional prefix) 270 (defun type-break-mode (&optional prefix)
268 "Enable or disable typing-break mode. 271 "Enable or disable typing-break mode.
269 This is a minor mode, but it is global to all buffers by default. 272 This is a minor mode, but it is global to all buffers by default.
306 approximate good values for this. 309 approximate good values for this.
307 310
308 There are several variables that affect how or when warning messages about 311 There are several variables that affect how or when warning messages about
309 imminent typing breaks are displayed. They include: 312 imminent typing breaks are displayed. They include:
310 313
311 type-break-warning-message-mode 314 type-break-mode-line-message-mode
312 type-break-time-warning-intervals 315 type-break-time-warning-intervals
313 type-break-keystroke-warning-intervals 316 type-break-keystroke-warning-intervals
314 type-break-warning-repeat 317 type-break-warning-repeat
315 type-break-warning-countdown-string 318 type-break-warning-countdown-string
316 type-break-warning-countdown-string-type 319 type-break-warning-countdown-string-type
317 320
318 There are several variables that affect how and when queries to begin a 321 There are several variables that affect if, how, and when queries to begin
319 typing break occur. They include: 322 a typing break occur. They include:
320 323
324 type-break-query-mode
321 type-break-query-function 325 type-break-query-function
322 type-break-query-interval 326 type-break-query-interval
323 327
324 Finally, the command `type-break-statistics' prints interesting things." 328 Finally, the command `type-break-statistics' prints interesting things."
325 (interactive "P") 329 (interactive "P")
326 ;; make sure it's there. 330 (type-break-check-post-command-hook)
327 (add-hook 'post-command-hook 'type-break-run-tb-post-command-hook 'append)
328 (add-hook 'type-break-post-command-hook 'type-break-check)
329 331
330 (let ((already-enabled type-break-mode)) 332 (let ((already-enabled type-break-mode))
331 (setq type-break-mode (>= (prefix-numeric-value prefix) 0)) 333 (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
332 334
333 (cond 335 (cond
334 ((and already-enabled type-break-mode) 336 ((and already-enabled type-break-mode)
335 (and (interactive-p) 337 (and (interactive-p)
336 (message "type-break-mode is enabled"))) 338 (message "type-break-mode is already enabled")))
337 (type-break-mode 339 (type-break-mode
340 (or global-mode-string
341 (setq global-mode-string '("")))
342 (or (memq 'type-break-mode-line-format
343 (default-value 'global-mode-string))
344 (setq-default global-mode-string
345 (nconc (default-value 'global-mode-string)
346 '(type-break-mode-line-format))))
338 (type-break-keystroke-reset) 347 (type-break-keystroke-reset)
348 (type-break-mode-line-countdown-or-break nil)
339 (type-break-schedule) 349 (type-break-schedule)
340 (and (interactive-p) 350 (and (interactive-p)
341 (message "type-break-mode is enabled and reset"))) 351 (message "type-break-mode is enabled and reset")))
342 ((interactive-p) 352 (t
343 (message "type-break-mode is disabled")))) 353 (type-break-keystroke-reset)
354 (type-break-mode-line-countdown-or-break nil)
355 (type-break-cancel-schedule)
356 (and (interactive-p)
357 (message "type-break-mode is disabled")))))
344 type-break-mode) 358 type-break-mode)
345 359
346 (defun type-break-warning-message-mode (&optional prefix) 360 (defun type-break-mode-line-message-mode (&optional prefix)
347 "Enable or disable warnings in the echo area about imminent typing breaks. 361 "Enable or disable warnings in the mode line about typing breaks.
362
363 A negative prefix argument disables this mode.
364 No argument or any non-negative argument enables it.
365
366 The user may also enable or disable this mode simply by setting the
367 variable of the same name.
368
369 Variables controlling the display of messages in the mode line include:
370
371 mode-line-format
372 global-mode-string
373 type-break-mode-line-break-message
374 type-break-mode-line-warning"
375 (interactive "P")
376 (setq type-break-mode-line-message-mode
377 (>= (prefix-numeric-value prefix) 0))
378 (and (interactive-p)
379 (if type-break-mode-line-message-mode
380 (message "type-break-mode-line-message-mode is enabled")
381 (message "type-break-mode-line-message-mode is disabled")))
382 type-break-mode-line-message-mode)
383
384 (defun type-break-query-mode (&optional prefix)
385 "Enable or disable warnings in the mode line about typing breaks.
386
387 When enabled, the user is periodically queried about whether to take a
388 typing break at that moment. The function which does this query is
389 specified by the variable `type-break-query-function'.
348 390
349 A negative prefix argument disables this mode. 391 A negative prefix argument disables this mode.
350 No argument or any non-negative argument enables it. 392 No argument or any non-negative argument enables it.
351 393
352 The user may also enable or disable this mode simply by setting the 394 The user may also enable or disable this mode simply by setting the
353 variable of the same name." 395 variable of the same name."
354 (interactive "P") 396 (interactive "P")
355 (setq type-break-warning-message-mode (>= (prefix-numeric-value prefix) 0)) 397 (setq type-break-query-mode
356 (cond 398 (>= (prefix-numeric-value prefix) 0))
357 ((not (interactive-p))) 399 (and (interactive-p)
358 (type-break-warning-message-mode 400 (if type-break-query-mode
359 (message "type-break-warning-message-mode is enabled")) 401 (message "type-break-query-mode is enabled")
360 (t 402 (message "type-break-query-mode is disabled")))
361 (message "type-break-warning-message-mode is disabled"))) 403 type-break-query-mode)
362 type-break-warning-message-mode) 404
363 405
364 ;;;###autoload 406 ;;;###autoload
365 (defun type-break () 407 (defun type-break ()
366 "Take a typing break. 408 "Take a typing break.
367 409
368 During the break, a demo selected from the functions listed in 410 During the break, a demo selected from the functions listed in
412 (t 454 (t
413 (setq continue nil))))) 455 (setq continue nil)))))
414 (t (setq continue nil))))) 456 (t (setq continue nil)))))
415 457
416 (type-break-keystroke-reset) 458 (type-break-keystroke-reset)
459 (type-break-mode-line-countdown-or-break nil)
417 (type-break-schedule)) 460 (type-break-schedule))
418 461
419 462
420 (defun type-break-schedule (&optional time) 463 (defun type-break-schedule (&optional time)
421 "Schedule a typing break for TIME seconds from now. 464 "Schedule a typing break for TIME seconds from now.
422 If time is not specified, default to `type-break-interval'." 465 If time is not specified, default to `type-break-interval'."
423 (interactive (list (and current-prefix-arg 466 (interactive (list (and current-prefix-arg
424 (prefix-numeric-value current-prefix-arg)))) 467 (prefix-numeric-value current-prefix-arg))))
425 (or time (setq time type-break-interval)) 468 (or time (setq time type-break-interval))
426 (let ((type-break-mode t)) 469 (type-break-check-post-command-hook)
427 (type-break-mode 1))
428 (type-break-cancel-schedule) 470 (type-break-cancel-schedule)
429 (type-break-time-warning-schedule time 'reset) 471 (type-break-time-warning-schedule time 'reset)
430 (run-at-time (max 1 time) nil 'type-break-alarm) 472 (type-break-run-at-time (max 1 time) nil 'type-break-alarm)
431 (setq type-break-time-next-break 473 (setq type-break-time-next-break
432 (type-break-time-sum (current-time) time))) 474 (type-break-time-sum (current-time) time)))
433 475
434 (defun type-break-cancel-schedule () 476 (defun type-break-cancel-schedule ()
435 (type-break-cancel-time-warning-schedule) 477 (type-break-cancel-time-warning-schedule)
436 (let ((timer-dont-exit t)) 478 (type-break-cancel-function-timers 'type-break-alarm)
437 (cancel-function-timers 'type-break-alarm))
438 (setq type-break-alarm-p nil) 479 (setq type-break-alarm-p nil)
439 (setq type-break-time-next-break nil)) 480 (setq type-break-time-next-break nil))
440 481
441 (defun type-break-time-warning-schedule (&optional time resetp) 482 (defun type-break-time-warning-schedule (&optional time resetp)
442 (let ((type-break-current-time-warning-interval nil)) 483 (let ((type-break-current-time-warning-interval nil))
443 (type-break-cancel-time-warning-schedule)) 484 (type-break-cancel-time-warning-schedule))
485 (add-hook 'type-break-post-command-hook 'type-break-time-warning 'append)
444 (cond 486 (cond
445 (type-break-time-warning-intervals 487 (type-break-time-warning-intervals
446 (and resetp 488 (and resetp
447 (setq type-break-current-time-warning-interval 489 (setq type-break-current-time-warning-interval
448 type-break-time-warning-intervals)) 490 type-break-time-warning-intervals))
462 (setq type-break-current-time-warning-interval 504 (setq type-break-current-time-warning-interval
463 (cdr type-break-current-time-warning-interval)) 505 (cdr type-break-current-time-warning-interval))
464 506
465 ;(let (type-break-current-time-warning-interval) 507 ;(let (type-break-current-time-warning-interval)
466 ; (type-break-cancel-time-warning-schedule)) 508 ; (type-break-cancel-time-warning-schedule))
467 (run-at-time (max 1 time) nil 'type-break-time-warning-alarm) 509 (type-break-run-at-time (max 1 time) nil 'type-break-time-warning-alarm)
468 510
469 (cond 511 (cond
470 (resetp 512 (resetp
471 (setq type-break-warning-countdown-string nil)) 513 (setq type-break-warning-countdown-string nil))
472 (t 514 (t
473 (setq type-break-warning-countdown-string (number-to-string time)) 515 (setq type-break-warning-countdown-string (number-to-string time))
474 (setq type-break-warning-countdown-string-type "seconds")))))))) 516 (setq type-break-warning-countdown-string-type "seconds"))))))))
475 517
476 (defun type-break-cancel-time-warning-schedule () 518 (defun type-break-cancel-time-warning-schedule ()
477 (let ((timer-dont-exit t)) 519 (type-break-cancel-function-timers 'type-break-time-warning-alarm)
478 (cancel-function-timers 'type-break-time-warning-alarm))
479 (remove-hook 'type-break-post-command-hook 'type-break-time-warning) 520 (remove-hook 'type-break-post-command-hook 'type-break-time-warning)
480 (setq type-break-current-time-warning-interval 521 (setq type-break-current-time-warning-interval
481 type-break-time-warning-intervals) 522 type-break-time-warning-intervals)
482 (setq type-break-warning-countdown-string nil)) 523 (setq type-break-warning-countdown-string nil))
483 524
484 (defun type-break-alarm () 525 (defun type-break-alarm ()
485 (let ((type-break-mode t)) 526 (type-break-check-post-command-hook)
486 (type-break-mode 1)) 527 (setq type-break-alarm-p t)
487 (setq type-break-alarm-p t)) 528 (type-break-mode-line-countdown-or-break 'break))
488 529
489 (defun type-break-time-warning-alarm () 530 (defun type-break-time-warning-alarm ()
490 (let ((type-break-mode t)) 531 (type-break-check-post-command-hook)
491 (type-break-mode 1))
492 (type-break-time-warning-schedule) 532 (type-break-time-warning-schedule)
493 (setq type-break-time-warning-count type-break-warning-repeat) 533 (setq type-break-time-warning-count type-break-warning-repeat)
494 (add-hook 'type-break-post-command-hook 'type-break-time-warning 'append)) 534 (type-break-time-warning)
535 (type-break-mode-line-countdown-or-break 'countdown))
495 536
496 537
497 (defun type-break-run-tb-post-command-hook () 538 (defun type-break-run-tb-post-command-hook ()
498 (and type-break-mode 539 (and type-break-mode
499 (run-hooks 'type-break-post-command-hook))) 540 (run-hooks 'type-break-post-command-hook)))
510 (and (> (type-break-time-difference 551 (and (> (type-break-time-difference
511 type-break-time-last-command (current-time)) 552 type-break-time-last-command (current-time))
512 type-break-good-rest-interval) 553 type-break-good-rest-interval)
513 (progn 554 (progn
514 (type-break-keystroke-reset) 555 (type-break-keystroke-reset)
556 (type-break-mode-line-countdown-or-break nil)
515 (setq type-break-time-last-break (current-time)) 557 (setq type-break-time-last-break (current-time))
516 (type-break-schedule))) 558 (type-break-schedule)))
517 (setq type-break-time-last-command (current-time)))) 559 (setq type-break-time-last-command (current-time))))
518 560
519 (and type-break-keystroke-threshold 561 (and type-break-keystroke-threshold
557 (type-break-keystroke-reset) 599 (type-break-keystroke-reset)
558 (setq type-break-keystroke-count (or min-threshold 0)) 600 (setq type-break-keystroke-count (or min-threshold 0))
559 (type-break-query))))) 601 (type-break-query)))))
560 602
561 ;; This should return t if warnings were enabled, nil otherwise. 603 ;; This should return t if warnings were enabled, nil otherwise.
562 (defsubst type-break-check-keystroke-warning () 604 (defun type-break-check-keystroke-warning ()
563 ;; This is safe because the caller should have checked that the cdr was 605 ;; This is safe because the caller should have checked that the cdr was
564 ;; non-nil already. 606 ;; non-nil already.
565 (let ((left (- (cdr type-break-keystroke-threshold) 607 (let ((left (- (cdr type-break-keystroke-threshold)
566 type-break-keystroke-count))) 608 type-break-keystroke-count)))
567 (cond 609 (cond
576 (cdr type-break-current-keystroke-warning-interval))) 618 (cdr type-break-current-keystroke-warning-interval)))
577 (setq type-break-keystroke-warning-count type-break-warning-repeat) 619 (setq type-break-keystroke-warning-count type-break-warning-repeat)
578 (add-hook 'type-break-post-command-hook 'type-break-keystroke-warning) 620 (add-hook 'type-break-post-command-hook 'type-break-keystroke-warning)
579 (setq type-break-warning-countdown-string (number-to-string left)) 621 (setq type-break-warning-countdown-string (number-to-string left))
580 (setq type-break-warning-countdown-string-type "keystrokes") 622 (setq type-break-warning-countdown-string-type "keystrokes")
623 (type-break-mode-line-countdown-or-break 'countdown)
581 t)))) 624 t))))
582 625
583 ;; Arrange for a break query to be made, when the user stops typing furiously. 626 ;; Arrange for a break query to be made, when the user stops typing furiously.
584 (defun type-break-query () 627 (defun type-break-query ()
585 (add-hook 'type-break-post-command-hook 'type-break-do-query)) 628 (add-hook 'type-break-post-command-hook 'type-break-do-query))
586 629
587 ;; Ask to take a break, but only after the user stops typing continuously
588 ;; for at least a second. Renaming the minibuffer because you did M-x
589 ;; rename-buffer just as type-break popped the question is... annoying.
590 (defun type-break-do-query () 630 (defun type-break-do-query ()
591 (cond 631 (cond
592 ((sit-for 1) 632 ((not type-break-query-mode)
633 (type-break-noninteractive-query)
634 (type-break-schedule type-break-query-interval)
635 (remove-hook 'type-break-post-command-hook 'type-break-do-query))
636 ((sit-for 2)
593 (condition-case () 637 (condition-case ()
594 (cond 638 (cond
595 ((let ((type-break-mode nil) 639 ((let ((type-break-mode nil)
596 ;; yes-or-no-p sets this-command to exit-minibuffer, 640 ;; yes-or-no-p sets this-command to exit-minibuffer,
597 ;; which hoses undo or yank-pop (if you happened to be 641 ;; which hoses undo or yank-pop (if you happened to be
604 (type-break-schedule type-break-query-interval))) 648 (type-break-schedule type-break-query-interval)))
605 (quit 649 (quit
606 (type-break-schedule type-break-query-interval))) 650 (type-break-schedule type-break-query-interval)))
607 (remove-hook 'type-break-post-command-hook 'type-break-do-query)))) 651 (remove-hook 'type-break-post-command-hook 'type-break-do-query))))
608 652
653 (defun type-break-noninteractive-query (&optional ignored-args)
654 "Null query function which doesn't interrupt user and assumes `no'.
655 It prints a reminder in the echo area to take a break, but doesn't enforce
656 this or ask the user to start one right now."
657 (cond
658 (type-break-mode-line-message-mode)
659 (t
660 (beep t)
661 (message "You should take a typing break now. Do `M-x type-break'.")
662 (sit-for 1)
663 (beep t)
664 ;; return nil so query caller knows to reset reminder, as if user
665 ;; said "no" in response to yes-or-no-p.
666 nil)))
667
609 (defun type-break-time-warning () 668 (defun type-break-time-warning ()
610 (cond 669 (cond
611 ((and (car type-break-keystroke-threshold) 670 ((and (car type-break-keystroke-threshold)
612 (< type-break-keystroke-count (car type-break-keystroke-threshold)))) 671 (< type-break-keystroke-count (car type-break-keystroke-threshold))))
613 ((> type-break-time-warning-count 0) 672 ((> type-break-time-warning-count 0)
616 (setq type-break-warning-countdown-string (number-to-string timeleft)) 675 (setq type-break-warning-countdown-string (number-to-string timeleft))
617 (cond 676 (cond
618 ((eq (selected-window) (minibuffer-window))) 677 ((eq (selected-window) (minibuffer-window)))
619 ;; Do nothing if the command was just a prefix arg, since that will 678 ;; Do nothing if the command was just a prefix arg, since that will
620 ;; immediately be followed by some other interactive command. 679 ;; immediately be followed by some other interactive command.
680 ;; Otherwise, it is particularly annoying for the sit-for below to
681 ;; delay redisplay when one types sequences like `C-u -1 C-l'.
621 ((memq this-command '(digit-argument universal-argument))) 682 ((memq this-command '(digit-argument universal-argument)))
622 (type-break-warning-message-mode 683 ((not type-break-mode-line-message-mode)
623 ;; Pause for a moment so any previous message can be seen. 684 ;; Pause for a moment so any previous message can be seen.
624 (sit-for 2) 685 (sit-for 2)
625 (message "Warning: typing break due in %s." 686 (message "Warning: typing break due in %s."
626 (type-break-format-time timeleft)) 687 (type-break-format-time timeleft))
627 (setq type-break-time-warning-count 688 (setq type-break-time-warning-count
636 (setq type-break-warning-countdown-string 697 (setq type-break-warning-countdown-string
637 (number-to-string (- (cdr type-break-keystroke-threshold) 698 (number-to-string (- (cdr type-break-keystroke-threshold)
638 type-break-keystroke-count))) 699 type-break-keystroke-count)))
639 (cond 700 (cond
640 ((eq (selected-window) (minibuffer-window))) 701 ((eq (selected-window) (minibuffer-window)))
641 (type-break-warning-message-mode 702 ;; Do nothing if the command was just a prefix arg, since that will
703 ;; immediately be followed by some other interactive command.
704 ;; Otherwise, it is particularly annoying for the sit-for below to
705 ;; delay redisplay when one types sequences like `C-u -1 C-l'.
706 ((memq this-command '(digit-argument universal-argument)))
707 ((not type-break-mode-line-message-mode)
642 (sit-for 2) 708 (sit-for 2)
643 (message "Warning: typing break due in %s keystrokes." 709 (message "Warning: typing break due in %s keystrokes."
644 (- (cdr type-break-keystroke-threshold) 710 (- (cdr type-break-keystroke-threshold)
645 type-break-keystroke-count)) 711 type-break-keystroke-count))
646 (setq type-break-keystroke-warning-count 712 (setq type-break-keystroke-warning-count
648 (t 714 (t
649 (remove-hook 'type-break-post-command-hook 715 (remove-hook 'type-break-post-command-hook
650 'type-break-keystroke-warning) 716 'type-break-keystroke-warning)
651 (setq type-break-warning-countdown-string nil)))) 717 (setq type-break-warning-countdown-string nil))))
652 718
719 (defun type-break-mode-line-countdown-or-break (&optional type)
720 (cond
721 ((not type-break-mode-line-message-mode))
722 ((eq type 'countdown)
723 ;(setq type-break-mode-line-break-message-p nil)
724 (add-hook 'type-break-post-command-hook
725 'type-break-force-mode-line-update 'append))
726 ((eq type 'break)
727 ;; Alternate
728 (setq type-break-mode-line-break-message-p
729 (not type-break-mode-line-break-message-p))
730 (remove-hook 'type-break-post-command-hook
731 'type-break-force-mode-line-update))
732 (t
733 (setq type-break-mode-line-break-message-p nil)
734 (setq type-break-warning-countdown-string nil)
735 (remove-hook 'type-break-post-command-hook
736 'type-break-force-mode-line-update)))
737 (type-break-force-mode-line-update))
738
653 739
654 ;;;###autoload 740 ;;;###autoload
655 (defun type-break-statistics () 741 (defun type-break-statistics ()
656 "Print statistics about typing breaks in a temporary buffer. 742 "Print statistics about typing breaks in a temporary buffer.
657 This includes the last time a typing break was taken, when the next one is 743 This includes the last time a typing break was taken, when the next one is
658 scheduled, the keystroke thresholds and the current keystroke count, etc." 744 scheduled, the keystroke thresholds and the current keystroke count, etc."
659 (interactive) 745 (interactive)
660 (with-output-to-temp-buffer "*Typing Break Statistics*" 746 (with-output-to-temp-buffer "*Typing Break Statistics*"
661 (princ (format "Typing break statistics\n-----------------------\n 747 (princ (format "Typing break statistics\n-----------------------\n
662 Typing break mode is currently %s. 748 Typing break mode is currently %s.
663 Warnings of imminent typing breaks in echo area is %s. 749 Interactive query for breaks is %s.
750 Warnings of imminent typing breaks in mode line is %s.
664 751
665 Last typing break ended : %s 752 Last typing break ended : %s
666 Next scheduled typing break : %s\n 753 Next scheduled typing break : %s\n
667 Minimum keystroke threshold : %s 754 Minimum keystroke threshold : %s
668 Maximum keystroke threshold : %s 755 Maximum keystroke threshold : %s
669 Current keystroke count : %s" 756 Current keystroke count : %s"
670 (if type-break-mode "enabled" "disabled") 757 (if type-break-mode "enabled" "disabled")
671 (if type-break-warning-message-mode "enabled" "disabled") 758 (if type-break-query-mode "enabled" "disabled")
759 (if type-break-mode-line-message-mode "enabled" "disabled")
672 (if type-break-time-last-break 760 (if type-break-time-last-break
673 (current-time-string type-break-time-last-break) 761 (current-time-string type-break-time-last-break)
674 "never") 762 "never")
675 (if (and type-break-mode type-break-time-next-break) 763 (if (and type-break-mode type-break-time-next-break)
676 (format "%s\t(%s from now)" 764 (format "%s\t(%s from now)"
690 778
691 If called interactively, the user is prompted for their guess as to how 779 If called interactively, the user is prompted for their guess as to how
692 many words per minute they usually type. This value should not be your 780 many words per minute they usually type. This value should not be your
693 maximum WPM, but your average. Of course, this is harder to gauge since it 781 maximum WPM, but your average. Of course, this is harder to gauge since it
694 can vary considerably depending on what you are doing. For example, one 782 can vary considerably depending on what you are doing. For example, one
695 tends actually to type less when debugging a program, as opposed to writing 783 tends to type less when debugging a program as opposed to writing
696 documentation. (Perhaps a separate program should be written to estimate 784 documentation. (Perhaps a separate program should be written to estimate
697 average typing speed.) 785 average typing speed.)
698 786
699 From that, this command sets the values in `type-break-keystroke-threshold' 787 From that, this command sets the values in `type-break-keystroke-threshold'
700 based on a fairly simple algorithm involving assumptions about the average 788 based on a fairly simple algorithm involving assumptions about the average
723 ;; Compute the difference, in seconds, between a and b, two structures 811 ;; Compute the difference, in seconds, between a and b, two structures
724 ;; similar to those returned by `current-time'. 812 ;; similar to those returned by `current-time'.
725 ;; Use addition rather than logand since that is more robust; the low 16 813 ;; Use addition rather than logand since that is more robust; the low 16
726 ;; bits of the seconds might have been incremented, making it more than 16 814 ;; bits of the seconds might have been incremented, making it more than 16
727 ;; bits wide. 815 ;; bits wide.
728 (defsubst type-break-time-difference (a b) 816 (defun type-break-time-difference (a b)
729 (+ (lsh (- (car b) (car a)) 16) 817 (+ (lsh (- (car b) (car a)) 16)
730 (- (car (cdr b)) (car (cdr a))))) 818 (- (car (cdr b)) (car (cdr a)))))
731 819
732 ;; Return (in a new list the same in structure to that returned by 820 ;; Return (in a new list the same in structure to that returned by
733 ;; `current-time') the sum of the arguments. Each argument may be a time 821 ;; `current-time') the sum of the arguments. Each argument may be a time
734 ;; list or a single integer, a number of seconds. 822 ;; list or a single integer, a number of seconds.
735 ;; This function keeps the high and low 16 bits of the seconds properly 823 ;; This function keeps the high and low 16 bits of the seconds properly
736 ;; balanced so that the lower value never exceeds 16 bits. Otherwise, when 824 ;; balanced so that the lower value never exceeds 16 bits. Otherwise, when
737 ;; the result is passed to `current-time-string' it will toss some of the 825 ;; the result is passed to `current-time-string' it will toss some of the
738 ;; "low" bits and return the wrong value. 826 ;; "low" bits and format the time incorrectly.
739 (defun type-break-time-sum (&rest tmlist) 827 (defun type-break-time-sum (&rest tmlist)
740 (let ((high 0) 828 (let ((high 0)
741 (low 0) 829 (low 0)
742 (micro 0) 830 (micro 0)
743 tem) 831 tem)
764 (setq low (logand low 65535)) 852 (setq low (logand low 65535))
765 (setq high (+ high tem)))) 853 (setq high (+ high tem))))
766 854
767 (list high low micro))) 855 (list high low micro)))
768 856
769 (defsubst type-break-format-time (secs) 857 (defun type-break-format-time (secs)
770 (let ((mins (/ secs 60))) 858 (let ((mins (/ secs 60)))
771 (cond 859 (cond
772 ((= mins 1) (format "%d minute" mins)) 860 ((= mins 1) (format "%d minute" mins))
773 ((> mins 0) (format "%d minutes" mins)) 861 ((> mins 0) (format "%d minutes" mins))
774 ((= secs 1) (format "%d second" secs)) 862 ((= secs 1) (format "%d second" secs))
778 (setq type-break-keystroke-count 0) 866 (setq type-break-keystroke-count 0)
779 (setq type-break-keystroke-warning-count 0) 867 (setq type-break-keystroke-warning-count 0)
780 (setq type-break-current-keystroke-warning-interval 868 (setq type-break-current-keystroke-warning-interval
781 type-break-keystroke-warning-intervals) 869 type-break-keystroke-warning-intervals)
782 (remove-hook 'type-break-post-command-hook 'type-break-keystroke-warning)) 870 (remove-hook 'type-break-post-command-hook 'type-break-keystroke-warning))
871
872 (defun type-break-force-mode-line-update (&optional all)
873 "Force the mode-line of the current buffer to be redisplayed.
874 With optional non-nil ALL, force redisplay of all mode-lines."
875 (and all (save-excursion (set-buffer (other-buffer))))
876 (set-buffer-modified-p (buffer-modified-p)))
877
878 ;; If an exception occurs in emacs while running the post command hook, the
879 ;; value of that hook is clobbered. This is because the value of the
880 ;; variable is temporarily set to nil while it's running to prevent
881 ;; recursive application, but it also means an exception aborts the routine
882 ;; of restoring it. This function is called from the timers to restore it,
883 ;; just in case.
884 (defun type-break-check-post-command-hook ()
885 (add-hook 'post-command-hook 'type-break-run-tb-post-command-hook 'append))
886
887
888 ;;; Timer wrapper functions
889 ;;;
890 ;;; These shield type-break from variations in the interval timer packages
891 ;;; for different versions of emacs.
892
893 (defun type-break-run-at-time (time repeat function)
894 (cond ((eq type-break-emacs-variant 'standard19)
895 (require 'timer)
896 (funcall 'run-at-time time repeat function))
897 ((eq type-break-emacs-variant 'lucid-19-8)
898 (let ((name (if (symbolp function)
899 (symbol-name function)
900 "type-break")))
901 (require 'timer)
902 (funcall 'start-timer name function time repeat)))
903 ((memq type-break-emacs-variant '(xemacs lucid))
904 (let ((name (if (symbolp function)
905 (symbol-name function)
906 "type-break")))
907 (require 'itimer)
908 (funcall 'start-itimer name function time repeat)))))
909
910 (defun type-break-cancel-function-timers (function)
911 (cond ((eq type-break-emacs-variant 'standard19)
912 (let ((timer-dont-exit t))
913 (funcall 'cancel-function-timers function)))
914 ((eq type-break-emacs-variant 'lucid-19-8)
915 (let ((list timer-list))
916 (while list
917 (and (eq (funcall 'timer-function (car list)) function)
918 (funcall 'delete-timer (car list)))
919 (setq list (cdr list)))))
920 ((memq type-break-emacs-variant '(xemacs lucid))
921 (let ((list itimer-list))
922 (while list
923 (and (eq (funcall 'itimer-function (car list)) function)
924 (funcall 'delete-itimer (car list)))
925 (setq list (cdr list)))))))
783 926
784 927
785 ;;; Demo wrappers 928 ;;; Demo wrappers
786 929
787 ;; This is a wrapper around hanoi that calls it with an arg large enough to 930 ;; This is a wrapper around hanoi that calls it with an arg large enough to
878 (kill-buffer buffer-name)))))) 1021 (kill-buffer buffer-name))))))
879 1022
880 1023
881 (provide 'type-break) 1024 (provide 'type-break)
882 1025
883 ;; Do not do this at load time because it makes it impossible to load this
884 ;; file into temacs and then dump it.
885 ;(type-break-mode t)
886
887 ;; local variables:
888 ;; vc-make-backup-files: t
889 ;; end:
890
891 ;;; type-break.el ends here 1026 ;;; type-break.el ends here