+;;; type-break.el --- take breaks from typing
+
+;;; Copyright (C) 1994 Roland McGrath
+;;; Copyright (C) 1994 Noah S. Friedman
+
+;;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
+;;; Roland McGrath <roland@prep.ai.mit.edu>
+;;; Maintainer: friedman@prep.ai.mit.edu
+;;; Keywords: extensions, timer, RSI, CTS, tendinitis, suffering, pain
+;;; Created: 1994-07-13
+
+;;; $Id$
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, you can either send email to this
+;;; program's maintainer or write to: The Free Software Foundation,
+;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Based on Roland McGrath's hanoi-break.el (unreleased).
+;;; The idea for keystroke recording was suggested by
+;;; Mark Ashton <mpashston@gnu.ai.mit.edu>
+
+;;; Code:
+
+\f
(require 'timer)
;;;###autoload
-(defvar hanoi-break-interval (* 60 30)
- "*Number of seconds between Hanoi breaks.")
+(defvar type-break-interval (* 60 30)
+ "*Number of seconds between typing breaks.")
+
+;;;###autoload
+(defvar type-break-delay-interval 60
+ "*Number of seconds between queries to take a break, if put off.
+The user will continue to be prompted at this interval until he or she
+finally submits to taking a typing break.")
+
+;; Assuming average typing speed is 45wpm, default this to the average
+;; number of keystrokes one is likely to type in a break interval.
+;; That way if the user goes through a furious burst of typing activity,
+;; cause a typing break to be required sooner than originally scheduled.
+;;;###autoload
+(defvar type-break-keystroke-interval (* 45 (/ type-break-interval 60))
+ "*Number of keystrokes to record before querying for a typing break.
+If not a number, don't keep track of keystrokes.
+
+Actually, this is not the number of keystrokes per se, but the number of
+interactive commands (including self-inserting characters typed).
+Compound key bindings like C-x C-f count as a single command even though
+that consists of multiple keystrokes.")
+
+;;;###autoload
+(defvar type-break-demo-function-vector
+ [type-break-life type-break-hanoi]
+ "*Vector consisting of functions to run as demos during typing breaks.
+When a typing break begins, one of these functions is selected randomly
+to have emacs do something interesting.
-(add-hook 'post-command-hook 'hanoi-break-check t)
+Any function in this vector should start a demo which ceases as soon as a
+key is pressed.")
-(defvar hanoi-break-p nil
- "Non-nil if we need a Hanoi break real soon now.")
+;; The original motivation for this variable was that in emacs 19.25 (or
+;; perhaps just in unreleased versions of emacs 19.26), the function
+;; keyboard.c:safe_run_hooks wasn't reentrant, so that running yes-or-no-p
+;; from a post-command-hook caused the inferior command loop to wipe out
+;; the original value of the hook. That was fixed, but it occured to me
+;; that some people might prefer y-or-n-p.
+;;;###autoload
+(defvar type-break-query-function 'yes-or-no-p
+ "*Function to use for making query for a typing break.
+Usually this will be `yes-or-no-p' or `y-or-n-p'.")
+
+;; The rest are internal variables. Do not set them yourself.
-(defun hanoi-break-check ()
- "Take a Hanoi break if the time has come."
- (and (not (input-pending-p))
- (prog1 hanoi-break-p
- (setq hanoi-break-p nil))
- (hanoi-break)))
+;; Number of commands (roughly # of keystrokes) recorded since last break.
+(defvar type-break-keystroke-count 0)
+;; Non-nil if we need a typing break soon.
+(defvar type-break-p nil)
+
+\f
;;;###autoload
-(defun hanoi-break ()
- "Take a Hanoi break, son."
+(defun type-break ()
+ "Take a typing break.
+
+If `type-break-delay-interval' seconds have passed since the last typing
+break, or `type-break-keystroke-interval' keystrokes have been recorded
+since the last typing break, ask the user to take a break now.
+
+The user can refuse by answering \"no\", in which case another query will
+be made in `type-break-delay-interval' seconds.
+
+During the typing break, a demo selected from the functions listed in
+`type-break-demo-function-vector' is run."
(interactive)
+ (setq type-break-p nil)
+ (setq type-break-keystroke-count 0)
+ (cancel-type-break)
(save-window-excursion
- (eval (condition-case error
- (if (not (yes-or-no-p "Take a break now? "))
- '(hanoi-break-schedule 60) ; Bug him again in one minute.
- ;; Eat the screen.
- (if (eq (selected-window) (minibuffer-window))
- (other-window 1))
- (delete-other-windows)
- (scroll-right (window-width))
- ;; Send him on his way.
- (message "Take a break, son.")
- (if (get-buffer "*Hanoi*")
- (kill-buffer "*Hanoi*"))
- (condition-case ()
- (progn
- (hanoi (/ (window-width) 8))
- ;; Wait for him to come back.
- (read-char)
- (kill-buffer "*Hanoi*"))
- (quit nil))
- '(hanoi-break-schedule)) ; Schedule next break.
- (quit '(hanoi-break-schedule 60)) ; Bug him again in one minute.
- ;;(error t)
- ))))
+ (condition-case ()
+ (cond
+ ((funcall type-break-query-function "Take a break from typing now? ")
+ ;; Eat the screen.
+ (and (eq (selected-window) (minibuffer-window))
+ (other-window 1))
+ (delete-other-windows)
+ (scroll-right (window-width))
+ (message "Take a break from typing.")
+ (type-break-select)
+ (type-break-schedule))
+ (t
+ (type-break-schedule type-break-delay-interval)))
+ (quit
+ (type-break-schedule type-break-delay-interval)))))
+
+(defun type-break-select ()
+ (random t)
+ (let* ((len (length type-break-demo-function-vector))
+ (idx (random len))
+ (fn (aref type-break-demo-function-vector idx)))
+ (condition-case ()
+ (funcall fn)
+ (error nil))))
+\f
;;;###autoload
-(defun hanoi-break-schedule (&optional time)
- "Schedule a break for ARG seconds from now (default: hanoi-break-interval)."
+(defun type-break-schedule (&optional time)
+ "Schedule a typing break TIME seconds from now.
+If time is not specified, default to type-break-interval."
(interactive (list (and current-prefix-arg
(prefix-numeric-value current-prefix-arg))))
- (or time (setq time hanoi-break-interval))
- (run-at-time time nil 'hanoi-break-soon))
+ (or time (setq time type-break-interval))
+ ;; Remove any old scheduled break
+ (cancel-type-break)
+ (run-at-time time nil 'type-break-soon))
-(defun hanoi-break-soon ()
- "Take a Hanoi break very soon."
- (setq hanoi-break-p t))
-
-(defun cancel-hanoi-break ()
- "Cancel scheduled Hanoi breaks."
+(defun cancel-type-break ()
+ "Cancel scheduled typing breaks."
(interactive)
- (cancel-function-timers 'hanoi-break-soon))
+ (let ((timer-dont-exit t))
+ (cancel-function-timers 'type-break-soon)))
+
+(defun type-break-soon ()
+ "Take a typing break very soon."
+ (setq type-break-p t))
+
+(defun type-break-check ()
+ "Take a typing break if the time has come."
+ (setq type-break-keystroke-count (1+ type-break-keystroke-count))
+ (cond
+ ((input-pending-p))
+ ((or type-break-p
+ (and (natnump type-break-keystroke-interval)
+ (> type-break-keystroke-count type-break-keystroke-interval)))
+ (type-break))))
+
+\f
+;; This is a wrapper around hanoi that calls it with an arg large enough to
+;; make the largest discs possible that will fit in the window.
+;; Also, clean up the *Hanoi* buffer after we're done.
+(defun type-break-hanoi ()
+ "Take a hanoiing typing break."
+ (and (get-buffer "*Hanoi*")
+ (kill-buffer "*Hanoi*"))
+ (condition-case ()
+ (progn
+ (hanoi (/ (window-width) 8))
+ ;; Wait for user to come back.
+ (read-char)
+ (kill-buffer "*Hanoi*"))
+ (quit
+ (and (get-buffer "*Hanoi*")
+ (kill-buffer "*Hanoi*")))))
+
+;; This is a wrapper around life that calls it with a `sleep' arg to make
+;; it run a little more leisurely.
+;; Also, clean up the *Life* buffer after we're done.
+(defun type-break-life ()
+ "Take a typing break and get a life."
+ (and (get-buffer "*Life*")
+ (kill-buffer "*Life*"))
+ (condition-case ()
+ (progn
+ (life 3)
+ ;; Wait for user to come back.
+ (read-char)
+ (kill-buffer "*Life*"))
+ (quit
+ (and (get-buffer "*Life*")
+ (kill-buffer "*Life*")))))
+
+\f
+(provide 'type-break)
+
+(add-hook 'post-command-hook 'type-break-check 'append)
-(provide 'hanoi-break)
+;;; type-break.el ends here
projects / emacs.git / commitdiff