procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Real initial revision. (rewrite from hanoi-break.)

Browse source
This commit is contained in:
Noah Friedman 1994-07-14 12:10:27 +00:00
parent 6855329253
commit 458401b6ed
1 changed files with 195 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

246
lisp/type-break.el
View file

@ -1,65 +1,209 @@
;;; 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:
(require 'timer)
;;;###autoload
(defvar hanoi-break-interval (* 60 30)
"*Number of seconds between Hanoi breaks.")
(add-hook 'post-command-hook 'hanoi-break-check t)
(defvar hanoi-break-p nil
"Non-nil if we need a Hanoi break real soon now.")
(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)))
(defvar type-break-interval (* 60 30)
"*Number of seconds between typing breaks.")
;;;###autoload
(defun hanoi-break ()
"Take a Hanoi break, son."
(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.
Any function in this vector should start a demo which ceases as soon as a
key is pressed.")
;; 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.
;; 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)
;;;###autoload
(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))))
;;;###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)))
(provide 'hanoi-break)
(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))))
;; 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*")))))
(provide 'type-break)
(add-hook 'post-command-hook 'type-break-check 'append)
;;; type-break.el ends here