X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/99a33b77e15b9a075024701d060d912b2fd87caf..17e0445be4a6a4f437f4be4924074c90d6477481:/lisp/type-break.el diff --git a/lisp/type-break.el b/lisp/type-break.el index 58022ef881..b4e4be3195 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -1,6 +1,7 @@ -;;; 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-2011 Free Software Foundation, Inc. +;; Copyright (C) 1994-1995, 1997, 2000-2013 Free Software Foundation, +;; Inc. ;; Author: Noah Friedman ;; Maintainer: Noah Friedman @@ -47,7 +48,7 @@ ;; 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. @@ -69,26 +70,11 @@ :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. @@ -98,10 +84,10 @@ rest from typing, then the next typing break is simply rescheduled for later. 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. @@ -109,10 +95,9 @@ 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', 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 @@ -147,6 +132,7 @@ keystroke even though they really require multiple keys to generate them. 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) @@ -218,11 +204,11 @@ key is pressed." :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) + :type 'file) (defvar type-break-post-command-hook '(type-break-check) "Hook run indirectly by `post-command-hook' for typing break functions. @@ -241,7 +227,7 @@ remove themselves after running.") ("" 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 @@ -288,7 +274,7 @@ It will be either \"seconds\" or \"keystrokes\".") ;;;###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. @@ -361,83 +347,70 @@ Finally, a file (named `type-break-file-name') is used to store information 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) + :lighter type-break-mode-line-format + :global t - (let ((already-enabled type-break-mode)) - (setq type-break-mode (>= (prefix-numeric-value prefix) 0)) + (type-break-check-post-command-hook) - (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) + (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)))))) (define-minor-mode type-break-mode-line-message-mode - "Enable or disable warnings in the mode line about typing breaks. + "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. -A negative PREFIX argument disables this mode. -No argument or any non-negative argument enables it. - -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: @@ -445,21 +418,17 @@ 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'" - :global t) + :global t :group 'type-break) (define-minor-mode type-break-query-mode - "Enable or disable warnings in the mode line about typing breaks. + "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. -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. - -The user may also enable or disable this mode simply by setting the -variable of the same name." - :global t) +The user may also enable or disable this mode simply by setting +the variable of the same name." + :global t :group 'type-break) ;;; session file functions @@ -501,12 +470,9 @@ variable of the same name." (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." @@ -584,7 +550,6 @@ as per the function `type-break-schedule'." (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))) @@ -993,12 +958,8 @@ FRAC should be the inverse of the fractional value; for example, a value of ;; 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 @@ -1008,34 +969,12 @@ FRAC should be the inverse of the fractional value; for example, a value of ;; 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)