Merge from origin/emacs-24

[gnu-emacs] / lisp / type-break.el

diff --git a/lisp/type-break.el b/lisp/type-break.el
index c2d834ccfd59c9d5bdfde8e0b86807e06677367c..a3af407bf174a11dc0888736a6af6d86ba5d5583 100644 (file)
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -1,12 +1,10 @@
-;;; 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
 
 ;; 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.
 ;; Created: 1994-07-13
 
 ;; This file is part of GNU Emacs.


@@ -49,7 +47,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
 ;; 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.
 
 ;; this, but I think the health of my hands is far more important than a
 ;; few pages of virtual memory.
 


@@ -71,26 +69,11 @@
   :prefix "type-break"
   :group 'keyboard)
 
   :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)
 
 (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.
 
 (defcustom type-break-good-rest-interval (/ type-break-interval 6)
   "Number of seconds of idle time considered to be an adequate typing rest.
 


@@ -100,10 +83,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."
 
 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)
 
   :type 'integer
   :group 'type-break)
 

-;;;###autoload

 (defcustom type-break-good-break-interval nil
   "Number of seconds considered to be an adequate explicit typing rest.
 
 (defcustom type-break-good-break-interval nil
   "Number of seconds considered to be an adequate explicit typing rest.
 


@@ -111,10 +94,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."
 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)
 
   :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
 (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


@@ -149,16 +131,10 @@ 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."
 
 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)
 
   :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.
 (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.


@@ -227,11 +203,12 @@ key is pressed."
   :type 'boolean
   :group 'type-break)
 
   :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."
   "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.
 
 (defvar type-break-post-command-hook '(type-break-check)
   "Hook run indirectly by `post-command-hook' for typing break functions.


@@ -245,20 +222,12 @@ remove themselves after running.")
 \f
 ;; Mode line frobs
 
 \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))
 (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
 
 (defvar type-break-mode-line-break-message
   '(type-break-mode-line-break-message-p


@@ -305,7 +274,7 @@ It will be either \"seconds\" or \"keystrokes\".")
 
 \f
 ;;;###autoload
 
 \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.
 
   "Enable or disable typing-break mode.
 This is a minor mode, but it is global to all buffers by default.
 


@@ -378,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."
 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:
 
 
 Variables controlling the display of messages in the mode line include:
 


@@ -462,35 +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-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
 
 \f
 ;;; session file functions


@@ -524,7 +462,7 @@ variable of the same name."
            (let ((inhibit-read-only t))
              (goto-char (point-min))
              (forward-line)
            (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
              ))))))
              (insert (format "%s" type-break-keystroke-count))
              ;; file saving is left to auto-save
              ))))))


@@ -532,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."
 (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."
 
 (defun type-break-choose-file ()
   "Return file to read from."


@@ -615,7 +550,6 @@ as per the function `type-break-schedule'."
         (unless type-break-terse-messages
           (message "Press any key to resume from typing break."))
 
         (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)))
         (let* ((len (length type-break-demo-functions))
                (idx (random len))
                (fn (nth idx type-break-demo-functions)))


@@ -670,8 +604,7 @@ INTERVAL is the full length of an interval (defaults to TIME)."
   (type-break-time-warning-schedule time 'reset)
   (type-break-run-at-time (max 1 time) nil 'type-break-alarm)
   (setq type-break-time-next-break
   (type-break-time-warning-schedule time 'reset)
   (type-break-run-at-time (max 1 time) nil 'type-break-alarm)
   (setq type-break-time-next-break

-        (type-break-time-sum (or start (current-time))
-                             (or interval time))))
+        (type-break-time-sum start (or interval time))))

 
 (defun type-break-cancel-schedule ()
   (type-break-cancel-time-warning-schedule)
 
 (defun type-break-cancel-schedule ()
   (type-break-cancel-time-warning-schedule)


@@ -861,7 +794,7 @@ keystroke threshold has been exceeded."
       (quit
        (type-break-schedule type-break-query-interval))))))
 
       (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."
   "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."


@@ -1024,49 +957,15 @@ 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'.
 
 ;; 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)
 (defun type-break-time-difference (a b)

-  (+ (lsh (- (car b) (car a)) 16)
-     (- (car (cdr b)) (car (cdr 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
-;; list or a single integer, a number of seconds.
-;; This function keeps the high and low 16 bits of the seconds properly
-;; balanced so that the lower value never exceeds 16 bits.  Otherwise, when
-;; 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))))))
+  (round (float-time (time-subtract b a))))

 
 

-    (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)))
+;; Return a time value that is the sum of the time-value arguments.
+(defun type-break-time-sum (&rest tmlist)
+  (let ((sum '(0 0)))
+    (dolist (tem tmlist)
+      (setq sum (time-add sum tem)))
+    sum))

 
 (defun type-break-time-stamp (&optional when)
   (if (fboundp 'format-time-string)
 
 (defun type-break-time-stamp (&optional when)
   (if (fboundp 'format-time-string)


@@ -1272,5 +1171,4 @@ With optional non-nil ALL, force redisplay of all mode-lines."
 (if type-break-mode
     (type-break-mode 1))
 
 (if type-break-mode
     (type-break-mode 1))
 

-;; arch-tag: 943a2eb3-07e6-420b-993f-96e4796f5fd0

 ;;; type-break.el ends here
 ;;; type-break.el ends here