X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c05c21ed109720d66c834a0c5b21ea29416683a6..a3dae87a1b5405d2bffde7c2d829a5dbfc7ff274:/lisp/time.el diff --git a/lisp/time.el b/lisp/time.el index c11f399ae7..f8fea0c64a 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -1,7 +1,7 @@ ;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*- -;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1996, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2011 +;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -87,7 +87,7 @@ The value can be one of: ;;;###autoload (defcustom display-time-day-and-date nil "\ -*Non-nil means \\[display-time] should display day and date as well as time." +Non-nil means \\[display-time] should display day and date as well as time." :type 'boolean :group 'display-time) @@ -156,21 +156,24 @@ 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 ((old-tz (getenv "TZ")) + gmt nyt) + (unwind-protect + (progn + (setenv "TZ" "America/New_York") + (setq nyt (format-time-string "%z")) + (setenv "TZ" "Europe/London") + (setq gmt (format-time-string "%z"))) + (setenv "TZ" old-tz)) (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") @@ -182,7 +185,7 @@ LABEL is a string to display as the label of that TIMEZONE's time." :version "23.1") (defcustom display-time-world-buffer-name "*wclock*" - "Name of the wclock buffer." + "Name of the world clock buffer." :group 'display-time :type 'string :version "23.1") @@ -203,7 +206,7 @@ LABEL is a string to display as the label of that TIMEZONE's time." (let ((map (make-sparse-keymap))) (define-key map "q" 'kill-this-buffer) map) - "Keymap of Display Time World mode") + "Keymap of Display Time World mode.") ;;;###autoload (defun display-time () @@ -365,6 +368,25 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'." size nil))) +(with-no-warnings + ;; Warnings are suppresed 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 +426,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)))) @@ -454,15 +477,18 @@ update which can wait for the next redisplay." (force-mode-line-update)) (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. +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." @@ -490,41 +516,34 @@ 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 nil "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) + (old-tz (getenv "TZ")) + (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-char -1))) + (unwind-protect + (dolist (zone alist) + (let* ((label (cadr zone)) + (width (string-width label))) + (setenv "TZ" (car zone)) + (push (cons label + (format-time-string display-time-world-time-format)) + result) + (when (> width max-width) + (setq max-width width)))) + (setenv "TZ" old-tz)) + (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)) ;;;###autoload (defun display-time-world () @@ -580,5 +599,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