-;;; type-break.el --- encourage rests from typing at appropriate intervals
+;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*-
-;; Copyright (C) 1994, 1995, 1997, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997, 2000-2014 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.
;; 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.
:prefix "type-break"
:group 'keyboard)
-;;;###autoload
-(defcustom type-break-mode nil
- "Toggle typing break mode.
-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)
- (type-break-mode (if value 1 -1)))
- :initialize 'custom-initialize-default
- :type 'boolean
- :group 'type-break
- :require 'type-break)
-
-;;;###autoload
(defcustom type-break-interval (* 60 60)
"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.
If a break is interrupted before this much time elapses, the user will be
asked whether or not really to interrupt the break."
+ :set-after '(type-break-interval)
:type 'integer
:group 'type-break)
-;;;###autoload
(defcustom type-break-good-break-interval nil
"Number of seconds considered to be an adequate explicit typing rest.
length (in seconds) for a break initiated by the command `type-break',
overriding `type-break-good-rest-interval'. This provides querying of
break interruptions when `type-break-good-rest-interval' is nil."
- :type 'integer
+ :type '(choice (const nil) integer)
:group 'type-break)
-;;;###autoload
(defcustom type-break-keystroke-threshold
;; Assuming typing speed is 35wpm (on the average, do you really
;; type more than that in a minute? I spend a lot of time reading mail
The command `type-break-guesstimate-keystroke-threshold' can be used to
guess a reasonably good pair of values for this variable."
+ :set-after '(type-break-interval)
: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.
It should take a string as an argument, the prompt.
:type 'boolean
:group 'type-break)
-(defcustom type-break-file-name (convert-standard-filename "~/.type-break")
+(defcustom type-break-file-name
+ (locate-user-emacs-file "type-break" ".type-break")
"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)
+ :version "24.4" ; added locate-user
+ :type 'file)
(defvar type-break-post-command-hook '(type-break-check)
"Hook run indirectly by `post-command-hook' for typing break functions.
\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
(""
type-break-mode-line-break-message
type-break-mode-line-warning))
- "*Format of messages in the mode line concerning typing breaks.")
+ "Format of messages in the mode line concerning typing breaks.")
(defvar type-break-mode-line-break-message
'(type-break-mode-line-break-message-p
\f
;;;###autoload
-(defun type-break-mode (&optional prefix)
+(define-minor-mode type-break-mode
"Enable or disable typing-break mode.
This is a minor mode, but it is global to all buffers by default.
across Emacs sessions. This provides recovery of the break status between
sessions and after a crash. Manual changes to the file may result in
problems."
- (interactive "P")
- (type-break-check-post-command-hook)
-
- (let ((already-enabled type-break-mode))
- (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
+ :lighter type-break-mode-line-format
+ :global t
- (cond
- ((and already-enabled type-break-mode)
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is already enabled")))
- (type-break-mode
- (when type-break-file-name
- (with-current-buffer (find-file-noselect type-break-file-name 'nowarn)
- (setq buffer-save-without-query t)))
-
- (or global-mode-string
- (setq global-mode-string '("")))
- (or (assq 'type-break-mode-line-message-mode
- minor-mode-alist)
- (setq minor-mode-alist
- (cons type-break-mode-line-format
- minor-mode-alist)))
- (type-break-keystroke-reset)
- (type-break-mode-line-countdown-or-break nil)
-
- (setq type-break-time-last-break
- (or (type-break-get-previous-time)
- (current-time)))
-
- ;; schedule according to break time from session file
- (type-break-schedule
- (let (diff)
- (if (and type-break-time-last-break
- (< (setq diff (type-break-time-difference
- type-break-time-last-break
- (current-time)))
- type-break-interval))
- ;; use the file's value
- (progn
- (setq type-break-keystroke-count
- (type-break-get-previous-count))
- ;; file the time, in case it was read from the auto-save file
- (type-break-file-time type-break-interval-start)
- (setq type-break-interval-start type-break-time-last-break)
- (- type-break-interval diff))
- ;; schedule from now
- (setq type-break-interval-start (current-time))
- (type-break-file-time type-break-interval-start)
- type-break-interval))
- type-break-interval-start
- type-break-interval)
-
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is enabled and set")))
- (t
- (type-break-keystroke-reset)
- (type-break-mode-line-countdown-or-break nil)
- (type-break-cancel-schedule)
- (do-auto-save)
- (when type-break-file-name
- (with-current-buffer (find-file-noselect type-break-file-name
- 'nowarn)
- (set-buffer-modified-p nil)
- (unlock-buffer)
- (kill-this-buffer)))
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is disabled")))))
- type-break-mode)
+ (type-break-check-post-command-hook)
-(defun type-break-mode-line-message-mode (&optional prefix)
- "Enable or disable warnings in the mode line about typing breaks.
+ (cond
+ ;; ((and already-enabled type-break-mode)
+ ;; (and (called-interactively-p 'interactive)
+ ;; (message "Type Break mode is already enabled")))
+ (type-break-mode
+ (when type-break-file-name
+ (with-current-buffer (find-file-noselect type-break-file-name 'nowarn)
+ (setq buffer-save-without-query t)))
+
+ (or global-mode-string (setq global-mode-string '(""))) ;FIXME: Why?
+ (type-break-keystroke-reset)
+ (type-break-mode-line-countdown-or-break nil)
+
+ (setq type-break-time-last-break
+ (or (type-break-get-previous-time)
+ (current-time)))
+
+ ;; Schedule according to break time from session file.
+ (type-break-schedule
+ (let (diff)
+ (if (and type-break-time-last-break
+ (< (setq diff (type-break-time-difference
+ type-break-time-last-break
+ (current-time)))
+ type-break-interval))
+ ;; Use the file's value.
+ (progn
+ (setq type-break-keystroke-count
+ (type-break-get-previous-count))
+ ;; File the time, in case it was read from the auto-save file.
+ (type-break-file-time type-break-interval-start)
+ (setq type-break-interval-start type-break-time-last-break)
+ (- type-break-interval diff))
+ ;; Schedule from now.
+ (setq type-break-interval-start (current-time))
+ (type-break-file-time type-break-interval-start)
+ type-break-interval))
+ type-break-interval-start
+ type-break-interval))
+ (t
+ (type-break-keystroke-reset)
+ (type-break-mode-line-countdown-or-break nil)
+ (type-break-cancel-schedule)
+ (do-auto-save)
+ (when type-break-file-name
+ (with-current-buffer (find-file-noselect type-break-file-name
+ 'nowarn)
+ (set-buffer-modified-p nil)
+ (unlock-buffer)
+ (kill-this-buffer))))))
-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 (called-interactively-p 'interactive)
- (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 :group 'type-break)
+
+(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."
- (interactive "P")
- (setq type-break-query-mode
- (>= (prefix-numeric-value prefix) 0))
- (and (called-interactively-p 'interactive)
- (if type-break-query-mode
- (message "type-break-query-mode is enabled")
- (message "type-break-query-mode is disabled")))
- type-break-query-mode)
+The user may also enable or disable this mode simply by setting
+the variable of the same name."
+ :global t :group 'type-break)
\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."
(unless type-break-terse-messages
(message "Press any key to resume from typing break."))
- (random t)
(let* ((len (length type-break-demo-functions))
(idx (random len))
(fn (nth idx type-break-demo-functions)))
(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."
;; 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)
+ (setq sum (time-add sum (if (integerp tem)
+ (list (floor tem 65536) (mod tem 65536))
+ tem))))
+ sum))
(defun type-break-time-stamp (&optional when)
(if (fboundp 'format-time-string)
(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