]> code.delx.au - gnu-emacs/blobdiff - lisp/time.el
Teach net-utils more iproute2 and nl80211 tools
[gnu-emacs] / lisp / time.el
index 025d3184ef67eff35814a7c9ab375dd63f98487d..651dd56779b2496337913d41053d9fbe55df840d 100644 (file)
@@ -1,9 +1,9 @@
-;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*-
+;;; time.el --- display time, load and mail indicator in mode line of Emacs
 
-;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1996, 2000, 2001, 2002,
-;;   2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2016 Free Software
+;; Foundation, Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 
 ;; This file is part of GNU Emacs.
 
@@ -64,13 +64,14 @@ directory `display-time-mail-directory' contains nonempty files."
 
 (defcustom display-time-default-load-average 0
   "Which load average value will be shown in the mode line.
-Almost every system can provide values of load for past 1 minute, past 5 or
-past 15 minutes.  The default is to display 1 minute load average.
+Almost every system can provide values of load for the past 1 minute,
+past 5 or past 15 minutes.  The default is to display 1-minute load average.
 The value can be one of:
 
   0   => 1 minute load
   1   => 5 minutes load
-  2   => 15 minutes load"
+  2   => 15 minutes load
+  nil => None (do not display the load average)"
   :type '(choice (const :tag "1 minute load" 0)
                 (const :tag "5 minutes load" 1)
                 (const :tag "15 minutes load" 2)
@@ -78,7 +79,10 @@ The value can be one of:
   :group 'display-time)
 
 (defvar display-time-load-average nil
-  "Load average currently being shown in mode line.")
+  "Value of the system's load average currently shown on the mode line.
+See `display-time-default-load-average'.
+
+This is an internal variable; setting it has no effect.")
 
 (defcustom display-time-load-average-threshold 0.1
   "Load-average values below this value won't be shown in the mode line."
@@ -104,7 +108,10 @@ A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used."
   :type 'boolean
   :group 'display-time)
 
-(defvar display-time-string nil)
+(defvar display-time-string nil
+  "String used in mode lines to display a time string.
+It should not be set directly, but is instead updated by the
+`display-time' function.")
 ;;;###autoload(put 'display-time-string 'risky-local-variable t)
 
 (defcustom display-time-hook nil
@@ -156,21 +163,17 @@ LABEL is a string to display as the label of that TIMEZONE's time."
 (defcustom display-time-world-list
   ;; Determine if zoneinfo style timezones are supported by testing that
   ;; America/New York and Europe/London return different timezones.
-  (let (gmt nyt)
-    (set-time-zone-rule "America/New York")
-    (setq nyt (format-time-string "%z"))
-    (set-time-zone-rule "Europe/London")
-    (setq gmt (format-time-string "%z"))
-    (set-time-zone-rule nil)
+  (let ((nyt (format-time-string "%z" nil "America/New_York"))
+        (gmt (format-time-string "%z" nil "Europe/London")))
     (if (string-equal nyt gmt)
         legacy-style-world-list
       zoneinfo-style-world-list))
   "Alist of time zones and places for `display-time-world' to display.
 Each element has the form (TIMEZONE LABEL).
-TIMEZONE should be in the format supported by `set-time-zone-rule' on
-your system.  See the documentation of `zoneinfo-style-world-list' and
-\`legacy-style-world-list' for two widely used formats.
-LABEL is a string to display as the label of that TIMEZONE's time."
+TIMEZONE should be in a format supported by your system.  See the
+documentation of `zoneinfo-style-world-list' and
+`legacy-style-world-list' for two widely used formats.  LABEL is
+a string to display as the label of that TIMEZONE's time."
   :group 'display-time
   :type '(repeat (list string string))
   :version "23.1")
@@ -199,12 +202,6 @@ LABEL is a string to display as the label of that TIMEZONE's time."
   :type 'integer
   :version "23.1")
 
-(defvar display-time-world-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "q" 'kill-this-buffer)
-    map)
-  "Keymap of Display Time World mode.")
-
 ;;;###autoload
 (defun display-time ()
   "Enable display of time, load level, and mail flag in mode lines.
@@ -322,8 +319,6 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'."
 
 (defun display-time-event-handler ()
   (display-time-update)
-  ;; Do redisplay right now, if no input pending.
-  (sit-for 0)
   (let* ((current (current-time))
         (timer display-time-timer)
         ;; Compute the time when this timer will run again, next.
@@ -346,11 +341,12 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'."
          (timer-activate timer)))))
 
 (defun display-time-next-load-average ()
+  "Switch between different load averages in the mode line.
+Switches from the 1 to 5 to 15 minute load average, and then back to 1."
   (interactive)
   (if (= 3 (setq display-time-load-average (1+ display-time-load-average)))
       (setq display-time-load-average 0))
-  (display-time-update)
-  (sit-for 0))
+  (display-time-update))
 
 (defun display-time-mail-check-directory ()
   (let ((mail-files (directory-files display-time-mail-directory t))
@@ -365,6 +361,25 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'."
        size
       nil)))
 
+(with-no-warnings
+  ;; Warnings are suppressed to avoid "global/dynamic var `X' lacks a prefix".
+  (defvar now)
+  (defvar time)
+  (defvar load)
+  (defvar mail)
+  (defvar 24-hours)
+  (defvar hour)
+  (defvar 12-hours)
+  (defvar am-pm)
+  (defvar minutes)
+  (defvar seconds)
+  (defvar time-zone)
+  (defvar day)
+  (defvar year)
+  (defvar monthname)
+  (defvar month)
+  (defvar dayname))
+
 (defun display-time-update ()
   "Update the display-time info for the mode line.
 However, don't redisplay right now.
@@ -404,30 +419,31 @@ update which can wait for the next redisplay."
                               (getenv "MAIL")
                               (concat rmail-spool-directory
                                       (user-login-name))))
-        (mail (or (and display-time-mail-function
-                       (funcall display-time-mail-function))
-                  (and display-time-mail-directory
-                       (display-time-mail-check-directory))
-                  (and (stringp mail-spool-file)
-                       (or (null display-time-server-down-time)
-                           ;; If have been down for 20 min, try again.
-                           (> (- (nth 1 now) display-time-server-down-time)
-                              1200)
-                           (and (< (nth 1 now) display-time-server-down-time)
-                                (> (- (nth 1 now)
-                                      display-time-server-down-time)
-                                   -64336)))
-                       (let ((start-time (current-time)))
-                         (prog1
-                             (display-time-file-nonempty-p mail-spool-file)
-                           (if (> (- (nth 1 (current-time))
-                                     (nth 1 start-time))
-                                  20)
-                               ;; Record that mail file is not accessible.
-                               (setq display-time-server-down-time
-                                     (nth 1 (current-time)))
-                             ;; Record that mail file is accessible.
-                             (setq display-time-server-down-time nil)))))))
+        (mail (cond
+               (display-time-mail-function
+                (funcall display-time-mail-function))
+               (display-time-mail-directory
+                (display-time-mail-check-directory))
+               ((and (stringp mail-spool-file)
+                     (or (null display-time-server-down-time)
+                         ;; If have been down for 20 min, try again.
+                         (> (- (nth 1 now) display-time-server-down-time)
+                            1200)
+                         (and (< (nth 1 now) display-time-server-down-time)
+                              (> (- (nth 1 now)
+                                    display-time-server-down-time)
+                                 -64336))))
+                (let ((start-time (current-time)))
+                  (prog1
+                      (display-time-file-nonempty-p mail-spool-file)
+                    (if (> (- (nth 1 (current-time))
+                              (nth 1 start-time))
+                           20)
+                        ;; Record that mail file is not accessible.
+                        (setq display-time-server-down-time
+                              (nth 1 (current-time)))
+                      ;; Record that mail file is accessible.
+                      (setq display-time-server-down-time nil)))))))
          (24-hours (substring time 11 13))
          (hour (string-to-number 24-hours))
          (12-hours (int-to-string (1+ (% (+ hour 11) 12))))
@@ -436,7 +452,7 @@ update which can wait for the next redisplay."
          (seconds (substring time 17 19))
          (time-zone (car (cdr (current-time-zone now))))
          (day (substring time 8 10))
-         (year (substring time 20 24))
+         (year (format-time-string "%Y" now))
          (monthname (substring time 4 7))
          (month
           (cdr
@@ -451,23 +467,25 @@ update which can wait for the next redisplay."
     ;; This is inside the let binding, but we are not going to document
     ;; what variables are available.
     (run-hooks 'display-time-hook))
-  (force-mode-line-update))
+  (force-mode-line-update 'all))
 
 (defun display-time-file-nonempty-p (file)
-  (and (file-exists-p file)
-       (< 0 (nth 7 (file-attributes (file-chase-links file))))))
+  (let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
+    (and (file-exists-p file)
+        (< 0 (nth 7 (file-attributes (file-chase-links file)))))))
 
 ;;;###autoload
 (define-minor-mode display-time-mode
   "Toggle display of time, load level, and mail flag in mode lines.
-With a numeric arg, enable this display if arg is positive.
-
-When this display is enabled, it updates automatically every minute
-\(you can control the number of seconds between updates by
-customizing `display-time-interval').
-If `display-time-day-and-date' is non-nil, the current day and date
-are displayed as well.
-This runs the normal hook `display-time-hook' after each update."
+With a prefix argument ARG, enable Display Time mode if ARG is
+positive, and disable it otherwise.  If called from Lisp, enable
+it if ARG is omitted or nil.
+
+When Display Time mode is enabled, it updates every minute (you
+can control the number of seconds between updates by customizing
+`display-time-interval').  If `display-time-day-and-date' is
+non-nil, the current day and date are displayed as well.  This
+runs the normal hook `display-time-hook' after each update."
   :global t :group 'display-time
   (and display-time-timer (cancel-timer display-time-timer))
   (setq display-time-timer nil)
@@ -492,41 +510,33 @@ This runs the normal hook `display-time-hook' after each update."
                 'display-time-event-handler)))
 
 
-(defun display-time-world-mode ()
+(define-derived-mode display-time-world-mode special-mode "World clock"
   "Major mode for buffer that displays times in various time zones.
 See `display-time-world'."
-  (interactive)
-  (kill-all-local-variables)
-  (setq
-   major-mode 'display-time-world-mode
-   mode-name "World clock")
-  (use-local-map display-time-world-mode-map))
+  (setq show-trailing-whitespace nil))
 
 (defun display-time-world-display (alist)
   "Replace current buffer text with times in various zones, based on ALIST."
   (let ((inhibit-read-only t)
-       (buffer-undo-list t))
+       (buffer-undo-list t)
+       (now (current-time))
+       (max-width 0)
+       result fmt)
     (erase-buffer)
-    (let ((max-width 0)
-         (result ()))
-      (unwind-protect
-         (dolist (zone alist)
-           (let* ((label (cadr zone))
-                  (width (string-width label)))
-             (set-time-zone-rule (car zone))
-             (setq result
-                   (append result
-                           (list
-                            label width
-                            (format-time-string display-time-world-time-format))))
-             (when (> width max-width)
-               (setq max-width width))))
-       (set-time-zone-rule nil))
-      (while result
-       (insert (pop result)
-               (make-string (1+ (- max-width (pop result))) ?\s)
-               (pop result) "\n")))
-    (delete-backward-char 1)))
+    (dolist (zone alist)
+      (let* ((label (cadr zone))
+            (width (string-width label)))
+       (push (cons label
+                   (format-time-string display-time-world-time-format
+                                       now (car zone)))
+             result)
+       (when (> width max-width)
+         (setq max-width width))))
+    (setq fmt (concat "%-" (int-to-string max-width) "s %s\n"))
+    (dolist (timedata (nreverse result))
+      (insert (format fmt (car timedata) (cdr timedata))))
+    (delete-char -1))
+  (goto-char (point-min)))
 
 ;;;###autoload
 (defun display-time-world ()
@@ -538,10 +548,10 @@ To turn off the world time display, go to that window and type `q'."
              (not (get-buffer display-time-world-buffer-name)))
     (run-at-time t display-time-world-timer-second 'display-time-world-timer))
   (with-current-buffer (get-buffer-create display-time-world-buffer-name)
-    (display-time-world-display display-time-world-list))
-  (pop-to-buffer display-time-world-buffer-name)
-  (fit-window-to-buffer)
-  (display-time-world-mode))
+    (display-time-world-display display-time-world-list)
+    (display-buffer display-time-world-buffer-name
+                   (cons nil '((window-height . fit-window-to-buffer))))
+    (display-time-world-mode)))
 
 (defun display-time-world-timer ()
   (if (get-buffer display-time-world-buffer-name)
@@ -551,7 +561,8 @@ To turn off the world time display, go to that window and type `q'."
     (let ((list timer-list))
       (while list
         (let ((elt (pop list)))
-          (when (equal (symbol-name (aref elt 5)) "display-time-world-timer")
+          (when (equal (symbol-name (timer--function elt))
+                      "display-time-world-timer")
             (cancel-timer elt)))))))
 
 ;;;###autoload
@@ -582,5 +593,4 @@ For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"."
 
 (provide 'time)
 
-;; arch-tag: b9c1623f-b5cb-48e4-b650-482a4d23c5a6
 ;;; time.el ends here