;;; type-break.el --- encourage rests from typing at appropriate intervals
-;; Copyright (C) 1994, 95, 97, 2000, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997, 2000-2011 Free Software Foundation, Inc.
;; Author: Noah Friedman
;; Maintainer: Noah Friedman <friedman@splode.com>
;; Keywords: extensions, timers
-;; Status: Works in GNU Emacs 19.25 or later, some versions of XEmacs
;; Created: 1994-07-13
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; or set the variable of the same name to `t'.
;; This program can truly cons up a storm because of all the calls to
-;; `current-time' (which always returns 3 fresh conses). I'm dismayed by
+;; `current-time' (which always returns fresh conses). I'm dismayed by
;; this, but I think the health of my hands is far more important than a
;; few pages of virtual memory.
See the docstring for the `type-break-mode' command for more information.
Setting this variable directly does not take effect;
use either \\[customize] or the function `type-break-mode'."
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(type-break-mode (if value 1 -1)))
:initialize 'custom-initialize-default
:type 'boolean
;;;###autoload
(defcustom type-break-interval (* 60 60)
- "*Number of seconds between scheduled typing breaks."
+ "Number of seconds between scheduled typing breaks."
:type 'integer
:group 'type-break)
;;;###autoload
(defcustom type-break-good-rest-interval (/ type-break-interval 6)
- "*Number of seconds of idle time considered to be an adequate typing rest.
+ "Number of seconds of idle time considered to be an adequate typing rest.
When this variable is non-nil, Emacs checks the idle time between
keystrokes. If this idle time is long enough to be considered a \"good\"
;;;###autoload
(defcustom type-break-good-break-interval nil
- "*Number of seconds considered to be an adequate explicit typing rest.
+ "Number of seconds considered to be an adequate explicit typing rest.
When this variable is non-nil, its value is considered to be a \"good\"
length (in seconds) for a break initiated by the command `type-break',
(upper (* wpm avg-word-length (/ type-break-interval 60)))
(lower (/ upper 5)))
(cons lower upper))
- "*Upper and lower bound on number of keystrokes for considering typing break.
+ "Upper and lower bound on number of keystrokes for considering typing break.
This structure is a pair of numbers (MIN . MAX).
The first number is the minimum number of keystrokes that must have been
:type 'sexp
:group 'type-break)
-(defcustom type-break-query-mode t
- "*Non-nil means ask whether or not to prompt user for breaks.
-If so, call the function specified in the value of the variable
-`type-break-query-function' to do the asking."
- :type 'boolean
- :group 'type-break)
-
(defcustom type-break-query-function 'yes-or-no-p
- "*Function to use for making query for a typing break.
+ "Function to use for making query for a typing break.
It should take a string as an argument, the prompt.
Usually this should be set to `yes-or-no-p' or `y-or-n-p'.
:group 'type-break)
(defcustom type-break-query-interval 60
- "*Number of seconds between queries to take a break, if put off.
+ "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."
:type 'integer
:group 'type-break)
(defcustom type-break-time-warning-intervals '(300 120 60 30)
- "*List of time intervals for warnings about upcoming typing break.
+ "List of time intervals for warnings about upcoming typing break.
At each of the intervals (specified in seconds) away from a scheduled
typing break, print a warning in the echo area."
:type '(repeat integer)
:group 'type-break)
(defcustom type-break-keystroke-warning-intervals '(300 200 100 50)
- "*List of keystroke measurements for warnings about upcoming typing break.
+ "List of keystroke measurements for warnings about upcoming typing break.
At each of the intervals (specified in keystrokes) away from the upper
keystroke threshold, print a warning in the echo area.
If either this variable or the upper threshold is set, then no warnings
:group 'type-break)
(defcustom type-break-warning-repeat 40
- "*Number of keystrokes for which warnings should be repeated.
+ "Number of keystrokes for which warnings should be repeated.
That is, for each of this many keystrokes the warning is redisplayed
in the echo area to make sure it's really seen."
:type 'integer
:group 'type-break)
(defcustom type-break-time-stamp-format "[%H:%M] "
- "*Timestamp format used to prefix messages.
+ "Timestamp format used to prefix messages.
Format specifiers are as used by `format-time-string'."
:type 'string
:group 'type-break)
(defcustom type-break-demo-functions
'(type-break-demo-boring type-break-demo-life type-break-demo-hanoi)
- "*List of functions to consider running as demos during typing breaks.
+ "List of functions to consider running as demos during typing breaks.
When a typing break begins, one of these functions is selected randomly
to have Emacs do something interesting.
:group 'type-break)
(defcustom type-break-demo-boring-stats nil
- "*Show word per minute and keystroke figures in the Boring demo."
+ "Show word per minute and keystroke figures in the Boring demo."
:type 'boolean
:group 'type-break)
(defcustom type-break-terse-messages nil
- "*Use slightly terser messages."
+ "Use slightly terser messages."
:type 'boolean
:group 'type-break)
(defcustom type-break-file-name (convert-standard-filename "~/.type-break")
- "*Name of file used to save state across sessions.
+ "Name of file used to save state across sessions.
If this is nil, no data will be saved across sessions."
:type 'file
:group 'type-break)
\f
;; Mode line frobs
-(defcustom type-break-mode-line-message-mode nil
- "*Non-nil means put type-break related messages in the mode line.
-Otherwise, messages typically go in the echo area.
-
-See also `type-break-mode-line-format' and its members."
- :type 'boolean
- :group 'type-break)
-
(defvar type-break-mode-line-format
'(type-break-mode-line-message-mode
(""
(cond
((and already-enabled type-break-mode)
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(message "Type Break mode is already enabled")))
(type-break-mode
(when type-break-file-name
type-break-interval-start
type-break-interval)
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(message "Type Break mode is enabled and set")))
(t
(type-break-keystroke-reset)
(set-buffer-modified-p nil)
(unlock-buffer)
(kill-this-buffer)))
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(message "Type Break mode is disabled")))))
type-break-mode)
-(defun type-break-mode-line-message-mode (&optional prefix)
- "Enable or disable warnings in the mode line about typing breaks.
-
-A negative PREFIX argument disables this mode.
-No argument or any non-negative argument enables it.
+(define-minor-mode type-break-mode-line-message-mode
+ "Toggle warnings about typing breaks in the mode line.
+With a prefix argument ARG, enable these warnings if ARG is
+positive, and disable them otherwise. If called from Lisp,
+enable them if ARG is omitted or nil.
-The user may also enable or disable this mode simply by setting the
-variable of the same name.
+The user may also enable or disable this mode simply by setting
+the variable of the same name.
Variables controlling the display of messages in the mode line include:
`global-mode-string'
`type-break-mode-line-break-message'
`type-break-mode-line-warning'"
- (interactive "P")
- (setq type-break-mode-line-message-mode
- (>= (prefix-numeric-value prefix) 0))
- (and (interactive-p)
- (if type-break-mode-line-message-mode
- (message "type-break-mode-line-message-mode is enabled")
- (message "type-break-mode-line-message-mode is disabled")))
- type-break-mode-line-message-mode)
-
-(defun type-break-query-mode (&optional prefix)
- "Enable or disable warnings in the mode line about typing breaks.
-
-When enabled, the user is periodically queried about whether to take a
-typing break at that moment. The function which does this query is
-specified by the variable `type-break-query-function'.
-
-A negative PREFIX argument disables this mode.
-No argument or any non-negative argument enables it.
+ :global t)
-The user may also enable or disable this mode simply by setting the
-variable of the same name."
- (interactive "P")
- (setq type-break-query-mode
- (>= (prefix-numeric-value prefix) 0))
- (and (interactive-p)
- (if type-break-query-mode
- (message "type-break-query-mode is enabled")
- (message "type-break-query-mode is disabled")))
- type-break-query-mode)
+(define-minor-mode type-break-query-mode
+ "Toggle typing break queries.
+With a prefix argument ARG, enable these queries if ARG is
+positive, and disable them otherwise. If called from Lisp,
+enable them if ARG is omitted or nil.
+
+The user may also enable or disable this mode simply by setting
+the variable of the same name."
+ :global t)
\f
;;; session file functions
(let ((inhibit-read-only t))
(goto-char (point-min))
(forward-line)
- (delete-region (point) (save-excursion (end-of-line) (point)))
+ (delete-region (point) (line-end-position))
(insert (format "%s" type-break-keystroke-count))
;; file saving is left to auto-save
))))))
(defun timep (time)
"If TIME is in the format returned by `current-time' then
return TIME, else return nil."
- (and (listp time)
- (eq (length time) 3)
- (integerp (car time))
- (integerp (nth 1 time))
- (integerp (nth 2 time))
- time))
+ (condition-case nil
+ (and (float-time time) time)
+ (error nil)))
(defun type-break-choose-file ()
"Return file to read from."
(if file
(timep ;; returns expected format, else nil
(with-current-buffer (find-file-noselect file 'nowarn)
- (save-excursion
- (goto-char (point-min))
- (read (current-buffer))))))))
+ (condition-case nil
+ (save-excursion
+ (goto-char (point-min))
+ (read (current-buffer)))
+ (end-of-file
+ (error "End of file in `%s'" file))))))))
(defun type-break-get-previous-count ()
"Get previous keystroke count from `type-break-file-name'.
(setq file
(with-current-buffer
(find-file-noselect file 'nowarn)
- (save-excursion
- (goto-char (point-min))
- (forward-line 1)
- (read (current-buffer)))))))
+ (condition-case nil
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line 1)
+ (read (current-buffer)))
+ (end-of-file
+ (error "End of file in `%s'" file)))))))
file
0)))
(quit
(type-break-schedule type-break-query-interval))))))
-(defun type-break-noninteractive-query (&optional ignored-args)
+(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."
(setq type-break-keystroke-threshold (cons nil nil)))
(setcar type-break-keystroke-threshold lower)
(setcdr type-break-keystroke-threshold upper)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "min threshold: %d\tmax threshold: %d" lower upper))
type-break-keystroke-threshold))
;; 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)))))
+ (round (float-time (time-subtract b 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
;; 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))
- (cond
- ((numberp tem)
- (setq low (+ low tem)))
- (t
- (setq high (+ high (or (car tem) 0)))
- (setq low (+ low (or (car (cdr tem)) 0)))
- (setq micro (+ micro (or (car (cdr (cdr tem))) 0))))))
-
- (and (>= micro 1000000)
- (progn
- (setq tem (/ micro 1000000))
- (setq low (+ low tem))
- (setq micro (- micro (* tem 1000000)))))
-
- (setq tem (lsh low -16))
- (and (> tem 0)
- (progn
- (setq low (logand low 65535))
- (setq high (+ high tem))))
-
- (list high low micro)))
+ (let ((sum '(0 0 0)))
+ (dolist (tem tmlist sum)
+ (setq sum (time-add sum (if (integerp tem)
+ (list (floor tem 65536) (mod tem 65536))
+ tem))))))
(defun type-break-time-stamp (&optional when)
(if (fboundp 'format-time-string)
(defun type-break-force-mode-line-update (&optional all)
"Force the mode-line of the current buffer to be redisplayed.
With optional non-nil ALL, force redisplay of all mode-lines."
- (and all (save-excursion (set-buffer (other-buffer))))
+ (and all (with-current-buffer (other-buffer)))
(set-buffer-modified-p (buffer-modified-p)))
;; If an exception occurs in Emacs while running the post command hook, the
\f
;;; Timer wrapper functions
-;;;
-;;; These shield type-break from variations in the interval timer packages
-;;; for different versions of Emacs.
+;;
+;; These shield type-break from variations in the interval timer packages
+;; for different versions of Emacs.
(defun type-break-run-at-time (time repeat function)
(condition-case nil (or (require 'timer) (require 'itimer)) (error nil))
\f
;;; Demo wrappers
+(defun type-break-catch-up-event ()
+ ;; If the last input event is a down-event, read and discard the
+ ;; corresponding up-event too, to avoid triggering another prompt.
+ (and (eventp last-input-event)
+ (memq 'down (event-modifiers last-input-event))
+ (read-event)))
+
;; 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.
(progn
(hanoi (/ (window-width) 8))
;; Wait for user to come back.
- (read-char)
+ (read-event)
+ (type-break-catch-up-event)
(kill-buffer "*Hanoi*"))
(quit
- ;; eat char
- (read-char)
+ (read-event)
+ (type-break-catch-up-event)
(and (get-buffer "*Hanoi*")
(kill-buffer "*Hanoi*")))))
(progn
(life 3)
;; wait for user to return
- (read-char)
+ (read-event)
+ (type-break-catch-up-event)
(kill-buffer "*Life*"))
(life-extinct
(message "%s" (get 'life-extinct 'error-message))
- (sit-for 3)
;; restart demo
(setq continue t))
(quit
+ (type-break-catch-up-event)
(and (get-buffer "*Life*")
(kill-buffer "*Life*")))))))
message))))
(goto-char (point-min))
(sit-for 60))
- (read-char)
+ (read-event)
+ (type-break-catch-up-event)
(kill-buffer buffer-name))
(quit
(and (get-buffer buffer-name)
(if type-break-mode
(type-break-mode 1))
-;;; arch-tag: 943a2eb3-07e6-420b-993f-96e4796f5fd0
;;; type-break.el ends here
HCoop / bpt / emacs.git / blobdiff