+ (add-hook 'type-break-post-command-hook 'type-break-do-query))
+
+(defun type-break-do-query ()
+ (cond
+ ((not type-break-query-mode)
+ (type-break-noninteractive-query)
+ (type-break-schedule type-break-query-interval)
+ (remove-hook 'type-break-post-command-hook 'type-break-do-query))
+ ((sit-for 2)
+ (condition-case ()
+ (cond
+ ((let ((type-break-mode nil)
+ ;; yes-or-no-p sets this-command to exit-minibuffer,
+ ;; which hoses undo or yank-pop (if you happened to be
+ ;; yanking just when the query occurred).
+ (this-command this-command))
+ ;; Cancel schedule to prevent possibility of a second query
+ ;; from taking place before this one has even returned.
+ ;; The condition-case wrapper will reschedule on quit.
+ (type-break-cancel-schedule)
+ ;; Also prevent a second query when the break is interrupted.
+ (remove-hook 'type-break-post-command-hook 'type-break-do-query)
+ (funcall type-break-query-function
+ (format "%s%s"
+ (type-break-time-stamp)
+ (if type-break-terse-messages
+ "Break now? "
+ "Take a break from typing now? "))))
+ (type-break))
+ (t
+ (type-break-schedule type-break-query-interval)))
+ (quit
+ (type-break-schedule type-break-query-interval))))))
+
+(defun type-break-noninteractive-query (&optional ignored-args)
+ "Null query function which doesn't interrupt user and assumes `no'.
+It prints a reminder in the echo area to take a break, but doesn't enforce
+this or ask the user to start one right now."
+ (cond
+ (type-break-mode-line-message-mode)
+ (t
+ (beep t)
+ (message "%sYou should take a typing break now. Do `M-x type-break'."
+ (type-break-time-stamp))
+ (sit-for 1)
+ (beep t)
+ ;; return nil so query caller knows to reset reminder, as if user
+ ;; said "no" in response to yes-or-no-p.
+ nil)))
+
+(defun type-break-time-warning ()
+ (cond
+ ((and (car type-break-keystroke-threshold)
+ (< type-break-keystroke-count (car type-break-keystroke-threshold))))
+ ((> type-break-time-warning-count 0)
+ (let ((timeleft (type-break-time-difference (current-time)
+ type-break-time-next-break)))
+ (setq type-break-warning-countdown-string (number-to-string timeleft))
+ (cond
+ ((eq (selected-window) (minibuffer-window)))
+ ;; Do nothing if the command was just a prefix arg, since that will
+ ;; immediately be followed by some other interactive command.
+ ;; Otherwise, it is particularly annoying for the sit-for below to
+ ;; delay redisplay when one types sequences like `C-u -1 C-l'.
+ ((memq this-command '(digit-argument universal-argument)))
+ ((not type-break-mode-line-message-mode)
+ ;; Pause for a moment so any previous message can be seen.
+ (sit-for 2)
+ (message "%sWarning: typing break due in %s."
+ (type-break-time-stamp)
+ (type-break-format-time timeleft))
+ (setq type-break-time-warning-count
+ (1- type-break-time-warning-count))))))
+ (t
+ (remove-hook 'type-break-post-command-hook 'type-break-time-warning)
+ (setq type-break-warning-countdown-string nil))))
+
+(defun type-break-keystroke-warning ()
+ (cond
+ ((> type-break-keystroke-warning-count 0)
+ (setq type-break-warning-countdown-string
+ (number-to-string (- (cdr type-break-keystroke-threshold)
+ type-break-keystroke-count)))
+ (cond
+ ((eq (selected-window) (minibuffer-window)))
+ ;; Do nothing if the command was just a prefix arg, since that will
+ ;; immediately be followed by some other interactive command.
+ ;; Otherwise, it is particularly annoying for the sit-for below to
+ ;; delay redisplay when one types sequences like `C-u -1 C-l'.
+ ((memq this-command '(digit-argument universal-argument)))
+ ((not type-break-mode-line-message-mode)
+ (sit-for 2)
+ (message "%sWarning: typing break due in %s keystrokes."
+ (type-break-time-stamp)
+ (- (cdr type-break-keystroke-threshold)
+ type-break-keystroke-count))
+ (setq type-break-keystroke-warning-count
+ (1- type-break-keystroke-warning-count)))))
+ (t
+ (remove-hook 'type-break-post-command-hook
+ 'type-break-keystroke-warning)
+ (setq type-break-warning-countdown-string nil))))
+
+(defun type-break-mode-line-countdown-or-break (&optional type)
+ (cond
+ ((not type-break-mode-line-message-mode))
+ ((eq type 'countdown)
+ ;(setq type-break-mode-line-break-message-p nil)
+ (add-hook 'type-break-post-command-hook
+ 'type-break-force-mode-line-update 'append))
+ ((eq type 'break)
+ ;; Alternate
+ (setq type-break-mode-line-break-message-p
+ (not type-break-mode-line-break-message-p))
+ (remove-hook 'type-break-post-command-hook
+ 'type-break-force-mode-line-update))
+ (t
+ (setq type-break-mode-line-break-message-p nil)
+ (setq type-break-warning-countdown-string nil)
+ (remove-hook 'type-break-post-command-hook
+ 'type-break-force-mode-line-update)))
+ (type-break-force-mode-line-update))
+
+\f
+;;;###autoload
+(defun type-break-statistics ()
+ "Print statistics about typing breaks in a temporary buffer.
+This includes the last time a typing break was taken, when the next one is
+scheduled, the keystroke thresholds and the current keystroke count, etc."
+ (interactive)
+ (with-output-to-temp-buffer "*Typing Break Statistics*"
+ (princ (format "Typing break statistics\n-----------------------\n
+Typing break mode is currently %s.
+Interactive query for breaks is %s.
+Warnings of imminent typing breaks in mode line is %s.
+
+Last typing break ended : %s
+Next scheduled typing break : %s\n
+Minimum keystroke threshold : %s
+Maximum keystroke threshold : %s
+Current keystroke count : %s"
+ (if type-break-mode "enabled" "disabled")
+ (if type-break-query-mode "enabled" "disabled")
+ (if type-break-mode-line-message-mode "enabled" "disabled")
+ (if type-break-time-last-break
+ (current-time-string type-break-time-last-break)
+ "never")
+ (if (and type-break-mode type-break-time-next-break)
+ (format "%s\t(%s from now)"
+ (current-time-string type-break-time-next-break)
+ (type-break-format-time
+ (type-break-time-difference
+ (current-time)
+ type-break-time-next-break)))
+ "none scheduled")
+ (or (car type-break-keystroke-threshold) "none")
+ (or (cdr type-break-keystroke-threshold) "none")
+ type-break-keystroke-count))))
+
+;;;###autoload
+(defun type-break-guesstimate-keystroke-threshold (wpm &optional wordlen frac)
+ "Guess values for the minimum/maximum keystroke threshold for typing breaks.
+
+If called interactively, the user is prompted for their guess as to how
+many words per minute they usually type. This value should not be your
+maximum WPM, but your average. Of course, this is harder to gauge since it
+can vary considerably depending on what you are doing. For example, one
+tends to type less when debugging a program as opposed to writing
+documentation. (Perhaps a separate program should be written to estimate
+average typing speed.)
+
+From that, this command sets the values in `type-break-keystroke-threshold'
+based on a fairly simple algorithm involving assumptions about the average
+length of words (5). For the minimum threshold, it uses about a fifth of
+the computed maximum threshold.
+
+When called from Lisp programs, the optional args WORDLEN and FRAC can be
+used to override the default assumption about average word length and the
+fraction of the maximum threshold to which to set the minimum threshold.
+FRAC should be the inverse of the fractional value; for example, a value of
+2 would mean to use one half, a value of 4 would mean to use one quarter, etc."
+ (interactive "NOn average, how many words per minute do you type? ")
+ (let* ((upper (* wpm (or wordlen 5) (/ type-break-interval 60)))
+ (lower (/ upper (or frac 5))))
+ (or type-break-keystroke-threshold
+ (setq type-break-keystroke-threshold (cons nil nil)))
+ (setcar type-break-keystroke-threshold lower)
+ (setcdr type-break-keystroke-threshold upper)
+ (if (interactive-p)
+ (message "min threshold: %d\tmax threshold: %d" lower upper))
+ type-break-keystroke-threshold))
+
+\f
+;;; misc functions
+
+;; Compute the difference, in seconds, between a and b, two structures
+;; similar to those returned by `current-time'.
+;; Use addition rather than logand since that is more robust; the low 16
+;; bits of the seconds might have been incremented, making it more than 16
+;; bits wide.
+(defun type-break-time-difference (a b)
+ (+ (lsh (- (car b) (car a)) 16)
+ (- (car (cdr b)) (car (cdr a)))))
+
+;; Return (in a new list the same in structure to that returned by
+;; `current-time') the sum of the arguments. Each argument may be a time
+;; list or a single integer, a number of seconds.
+;; This function keeps the high and low 16 bits of the seconds properly
+;; balanced so that the lower value never exceeds 16 bits. Otherwise, when
+;; the result is passed to `current-time-string' it will toss some of the
+;; "low" bits and format the time incorrectly.
+(defun type-break-time-sum (&rest tmlist)
+ (let ((high 0)
+ (low 0)
+ (micro 0)
+ tem)
+ (while tmlist
+ (setq tem (car tmlist))
+ (setq tmlist (cdr tmlist))