aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/time.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/time.el')
-rw-r--r--lisp/time.el294
1 files changed, 154 insertions, 140 deletions
diff --git a/lisp/time.el b/lisp/time.el
index 44fd1a7e337..96b49ddabdd 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -25,8 +25,7 @@
25;; Facilities to display current time/date and a new-mail indicator 25;; Facilities to display current time/date and a new-mail indicator
26;; in the Emacs mode line. The entry point is `display-time'. 26;; in the Emacs mode line. The entry point is `display-time'.
27 27
28;; Display time world in a buffer, the entry point is 28;; Use `world-clock' to display world clock in a buffer.
29;; `display-time-world'.
30 29
31;;; Code: 30;;; Code:
32 31
@@ -35,23 +34,20 @@
35 :group 'mode-line 34 :group 'mode-line
36 :group 'mail) 35 :group 'mail)
37 36
38
39(defcustom display-time-mail-file nil 37(defcustom display-time-mail-file nil
40 "File name of mail inbox file, for indicating existence of new mail. 38 "File name of mail inbox file, for indicating existence of new mail.
41Non-nil and not a string means don't check for mail; nil means use 39Non-nil and not a string means don't check for mail; nil means use
42default, which is system-dependent, and is the same as used by Rmail." 40default, which is system-dependent, and is the same as used by Rmail."
43 :type '(choice (const :tag "None" none) 41 :type '(choice (const :tag "None" none)
44 (const :tag "Default" nil) 42 (const :tag "Default" nil)
45 (file :format "%v")) 43 (file :format "%v")))
46 :group 'display-time)
47 44
48(defcustom display-time-mail-directory nil 45(defcustom display-time-mail-directory nil
49 "Name of mail inbox directory, for indicating existence of new mail. 46 "Name of mail inbox directory, for indicating existence of new mail.
50Any nonempty regular file in the directory is regarded as newly arrived mail. 47Any nonempty regular file in the directory is regarded as newly arrived mail.
51If nil, do not check a directory for arriving mail." 48If nil, do not check a directory for arriving mail."
52 :type '(choice (const :tag "None" nil) 49 :type '(choice (const :tag "None" nil)
53 (directory :format "%v")) 50 (directory :format "%v")))
54 :group 'display-time)
55 51
56(defcustom display-time-mail-function nil 52(defcustom display-time-mail-function nil
57 "Function to call, for indicating existence of new mail. 53 "Function to call, for indicating existence of new mail.
@@ -59,8 +55,7 @@ If nil, that means use the default method: check that the file
59specified by `display-time-mail-file' is nonempty or that the 55specified by `display-time-mail-file' is nonempty or that the
60directory `display-time-mail-directory' contains nonempty files." 56directory `display-time-mail-directory' contains nonempty files."
61 :type '(choice (const :tag "Default" nil) 57 :type '(choice (const :tag "Default" nil)
62 (function)) 58 (function)))
63 :group 'display-time)
64 59
65(defcustom display-time-default-load-average 0 60(defcustom display-time-default-load-average 0
66 "Which load average value will be shown in the mode line. 61 "Which load average value will be shown in the mode line.
@@ -75,8 +70,7 @@ The value can be one of:
75 :type '(choice (const :tag "1 minute load" 0) 70 :type '(choice (const :tag "1 minute load" 0)
76 (const :tag "5 minutes load" 1) 71 (const :tag "5 minutes load" 1)
77 (const :tag "15 minutes load" 2) 72 (const :tag "15 minutes load" 2)
78 (const :tag "None" nil)) 73 (const :tag "None" nil)))
79 :group 'display-time)
80 74
81(defvar display-time-load-average nil 75(defvar display-time-load-average nil
82 "Value of the system's load average currently shown on the mode line. 76 "Value of the system's load average currently shown on the mode line.
@@ -86,27 +80,23 @@ This is an internal variable; setting it has no effect.")
86 80
87(defcustom display-time-load-average-threshold 0.1 81(defcustom display-time-load-average-threshold 0.1
88 "Load-average values below this value won't be shown in the mode line." 82 "Load-average values below this value won't be shown in the mode line."
89 :type 'number 83 :type 'number)
90 :group 'display-time)
91 84
92;;;###autoload 85;;;###autoload
93(defcustom display-time-day-and-date nil "\ 86(defcustom display-time-day-and-date nil "\
94Non-nil means \\[display-time] should display day and date as well as time." 87Non-nil means \\[display-time] should display day and date as well as time."
95 :type 'boolean 88 :type 'boolean)
96 :group 'display-time)
97 89
98(defvar display-time-timer nil) 90(defvar display-time-timer nil)
99 91
100(defcustom display-time-interval 60 92(defcustom display-time-interval 60
101 "Seconds between updates of time in the mode line." 93 "Seconds between updates of time in the mode line."
102 :type 'integer 94 :type 'integer)
103 :group 'display-time)
104 95
105(defcustom display-time-24hr-format nil 96(defcustom display-time-24hr-format nil
106 "Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. 97 "Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
107A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used." 98A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used."
108 :type 'boolean 99 :type 'boolean)
109 :group 'display-time)
110 100
111(defvar display-time-string nil 101(defvar display-time-string nil
112 "String used in mode lines to display a time string. 102 "String used in mode lines to display a time string.
@@ -116,103 +106,12 @@ It should not be set directly, but is instead updated by the
116 106
117(defcustom display-time-hook nil 107(defcustom display-time-hook nil
118 "List of functions to be called when the time is updated on the mode line." 108 "List of functions to be called when the time is updated on the mode line."
119 :type 'hook 109 :type 'hook)
120 :group 'display-time)
121 110
122(defvar display-time-server-down-time nil 111(defvar display-time-server-down-time nil
123 "Time when mail file's file system was recorded to be down. 112 "Time when mail file's file system was recorded to be down.
124If that file system seems to be up, the value is nil.") 113If that file system seems to be up, the value is nil.")
125 114
126(defcustom zoneinfo-style-world-list
127 '(("America/Los_Angeles" "Seattle")
128 ("America/New_York" "New York")
129 ("Europe/London" "London")
130 ("Europe/Paris" "Paris")
131 ("Asia/Calcutta" "Bangalore")
132 ("Asia/Tokyo" "Tokyo"))
133 "Alist of zoneinfo-style time zones and places for `display-time-world'.
134Each element has the form (TIMEZONE LABEL).
135TIMEZONE should be a string of the form AREA/LOCATION, where AREA is
136the name of a region -- a continent or ocean, and LOCATION is the name
137of a specific location, e.g., a city, within that region.
138LABEL is a string to display as the label of that TIMEZONE's time."
139 :group 'display-time
140 :type '(repeat (list string string))
141 :version "23.1")
142
143(defcustom legacy-style-world-list
144 '(("PST8PDT" "Seattle")
145 ("EST5EDT" "New York")
146 ("GMT0BST" "London")
147 ("CET-1CDT" "Paris")
148 ("IST-5:30" "Bangalore")
149 ("JST-9" "Tokyo"))
150 "Alist of traditional-style time zones and places for `display-time-world'.
151Each element has the form (TIMEZONE LABEL).
152TIMEZONE should be a string of the form:
153
154 std[+|-]offset[dst[offset][,date[/time],date[/time]]]
155
156See the documentation of the TZ environment variable on your system,
157for more details about the format of TIMEZONE.
158LABEL is a string to display as the label of that TIMEZONE's time."
159 :group 'display-time
160 :type '(repeat (list string string))
161 :version "23.1")
162
163(defcustom display-time-world-list t
164 "Alist of time zones and places for `display-time-world' to display.
165Each element has the form (TIMEZONE LABEL).
166TIMEZONE should be in a format supported by your system. See the
167documentation of `zoneinfo-style-world-list' and
168`legacy-style-world-list' for two widely used formats. LABEL is
169a string to display as the label of that TIMEZONE's time.
170
171If the value is t instead of an alist, use the value of
172`zoneinfo-style-world-list' if it works on this platform, and of
173`legacy-style-world-list' otherwise."
174
175 :group 'display-time
176 :type '(choice (const :tag "Default" t)
177 (repeat :tag "List of zones and labels"
178 (list (string :tag "Zone") (string :tag "Label"))))
179 :version "23.1")
180
181(defun time--display-world-list ()
182 (if (listp display-time-world-list)
183 display-time-world-list
184 ;; Determine if zoneinfo style timezones are supported by testing that
185 ;; America/New York and Europe/London return different timezones.
186 (let ((nyt (format-time-string "%z" nil "America/New_York"))
187 (gmt (format-time-string "%z" nil "Europe/London")))
188 (if (string-equal nyt gmt)
189 legacy-style-world-list
190 zoneinfo-style-world-list))))
191
192(defcustom display-time-world-time-format "%A %d %B %R %Z"
193 "Format of the time displayed, see `format-time-string'."
194 :group 'display-time
195 :type 'string
196 :version "23.1")
197
198(defcustom display-time-world-buffer-name "*wclock*"
199 "Name of the world clock buffer."
200 :group 'display-time
201 :type 'string
202 :version "23.1")
203
204(defcustom display-time-world-timer-enable t
205 "If non-nil, a timer will update the world clock."
206 :group 'display-time
207 :type 'boolean
208 :version "23.1")
209
210(defcustom display-time-world-timer-second 60
211 "Interval in seconds for updating the world clock."
212 :group 'display-time
213 :type 'integer
214 :version "23.1")
215
216;;;###autoload 115;;;###autoload
217(defun display-time () 116(defun display-time ()
218 "Enable display of time, load level, and mail flag in mode lines. 117 "Enable display of time, load level, and mail flag in mode lines.
@@ -249,14 +148,12 @@ See `display-time-use-mail-icon' and `display-time-mail-face'.")
249 "Non-nil means use an icon as mail indicator on a graphic display. 148 "Non-nil means use an icon as mail indicator on a graphic display.
250Otherwise use `display-time-mail-string'. The icon may consume less 149Otherwise use `display-time-mail-string'. The icon may consume less
251of the mode line. It is specified by `display-time-mail-icon'." 150of the mode line. It is specified by `display-time-mail-icon'."
252 :group 'display-time
253 :type 'boolean) 151 :type 'boolean)
254 152
255;; Fixme: maybe default to the character if we can display Unicode. 153;; Fixme: maybe default to the character if we can display Unicode.
256(defcustom display-time-mail-string "Mail" 154(defcustom display-time-mail-string "Mail"
257 "String to use as the mail indicator in `display-time-string-forms'. 155 "String to use as the mail indicator in `display-time-string-forms'.
258This can use the Unicode letter character if you can display it." 156This can use the Unicode letter character if you can display it."
259 :group 'display-time
260 :version "22.1" 157 :version "22.1"
261 :type '(choice (const "Mail") 158 :type '(choice (const "Mail")
262 ;; Use :tag here because the Lucid menu won't display 159 ;; Use :tag here because the Lucid menu won't display
@@ -270,8 +167,7 @@ See the function `format-time-string' for an explanation of
270how to write this string. If this is nil, the defaults 167how to write this string. If this is nil, the defaults
271depend on `display-time-day-and-date' and `display-time-24hr-format'." 168depend on `display-time-day-and-date' and `display-time-24hr-format'."
272 :type '(choice (const :tag "Default" nil) 169 :type '(choice (const :tag "Default" nil)
273 string) 170 string))
274 :group 'display-time)
275 171
276(defcustom display-time-string-forms 172(defcustom display-time-string-forms
277 '((if (and (not display-time-format) display-time-day-and-date) 173 '((if (and (not display-time-format) display-time-day-and-date)
@@ -325,8 +221,7 @@ For example:
325 (if mail \" Mail\" \"\")) 221 (if mail \" Mail\" \"\"))
326 222
327would give mode line times like `94/12/30 21:07:48 (UTC)'." 223would give mode line times like `94/12/30 21:07:48 (UTC)'."
328 :type '(repeat sexp) 224 :type '(repeat sexp))
329 :group 'display-time)
330 225
331(defun display-time-event-handler () 226(defun display-time-event-handler ()
332 (display-time-update) 227 (display-time-update)
@@ -508,13 +403,129 @@ runs the normal hook `display-time-hook' after each update."
508 (remove-hook 'rmail-after-get-new-mail-hook 403 (remove-hook 'rmail-after-get-new-mail-hook
509 'display-time-event-handler))) 404 'display-time-event-handler)))
510 405
406
407;;; Obsolete names
408
409(define-obsolete-variable-alias 'display-time-world-list
410 'world-clock-list "28.1")
411(define-obsolete-variable-alias 'display-time-world-time-format
412 'world-clock-time-format "28.1")
413(define-obsolete-variable-alias 'display-time-world-buffer-name
414 'world-clock-buffer-name "28.1")
415(define-obsolete-variable-alias 'display-time-world-timer-enable
416 'world-clock-timer-enable "28.1")
417(define-obsolete-variable-alias 'display-time-world-timer-second
418 'world-clock-timer-second "28.1")
419
420(define-obsolete-function-alias 'display-time-world-mode
421 #'world-clock-mode "28.1")
422(define-obsolete-function-alias 'display-time-world-display
423 #'world-clock-display "28.1")
424(define-obsolete-function-alias 'display-time-world
425 #'world-clock "28.1")
426(define-obsolete-function-alias 'display-time-world-timer
427 #'world-clock-update "28.1")
428
429
430;;; World clock
431
432(defgroup world-clock nil
433 "Display a world clock."
434 :group 'display-time)
435
436(defcustom zoneinfo-style-world-list
437 '(("America/Los_Angeles" "Seattle")
438 ("America/New_York" "New York")
439 ("Europe/London" "London")
440 ("Europe/Paris" "Paris")
441 ("Asia/Calcutta" "Bangalore")
442 ("Asia/Tokyo" "Tokyo"))
443 "Alist of zoneinfo-style time zones and places for `world-clock'.
444Each element has the form (TIMEZONE LABEL).
445TIMEZONE should be a string of the form AREA/LOCATION, where AREA is
446the name of a region -- a continent or ocean, and LOCATION is the name
447of a specific location, e.g., a city, within that region.
448LABEL is a string to display as the label of that TIMEZONE's time."
449 :type '(repeat (list string string))
450 :version "23.1")
451
452(defcustom legacy-style-world-list
453 '(("PST8PDT" "Seattle")
454 ("EST5EDT" "New York")
455 ("GMT0BST" "London")
456 ("CET-1CDT" "Paris")
457 ("IST-5:30" "Bangalore")
458 ("JST-9" "Tokyo"))
459 "Alist of traditional-style time zones and places for `world-clock'.
460Each element has the form (TIMEZONE LABEL).
461TIMEZONE should be a string of the form:
462
463 std[+|-]offset[dst[offset][,date[/time],date[/time]]]
464
465See the documentation of the TZ environment variable on your system,
466for more details about the format of TIMEZONE.
467LABEL is a string to display as the label of that TIMEZONE's time."
468 :type '(repeat (list string string))
469 :version "23.1")
470
471(defcustom world-clock-list t
472 "Alist of time zones and places for `world-clock' to display.
473Each element has the form (TIMEZONE LABEL).
474TIMEZONE should be in a format supported by your system. See the
475documentation of `zoneinfo-style-world-list' and
476`legacy-style-world-list' for two widely used formats. LABEL is
477a string to display as the label of that TIMEZONE's time.
478
479If the value is t instead of an alist, use the value of
480`zoneinfo-style-world-list' if it works on this platform, and of
481`legacy-style-world-list' otherwise."
482 :type '(choice (const :tag "Default" t)
483 (repeat :tag "List of zones and labels"
484 (list (string :tag "Zone") (string :tag "Label"))))
485 :version "28.1")
486
487(defun time--display-world-list ()
488 (if (listp world-clock-list)
489 world-clock-list
490 ;; Determine if zoneinfo style timezones are supported by testing that
491 ;; America/New York and Europe/London return different timezones.
492 (let ((nyt (format-time-string "%z" nil "America/New_York"))
493 (gmt (format-time-string "%z" nil "Europe/London")))
494 (if (string-equal nyt gmt)
495 legacy-style-world-list
496 zoneinfo-style-world-list))))
497
498(defcustom world-clock-time-format "%A %d %B %R %Z"
499 "Time format for `world-clock', see `format-time-string'."
500 :type 'string
501 :version "28.1")
502
503(defcustom world-clock-buffer-name "*wclock*"
504 "Name of the `world-clock' buffer."
505 :type 'string
506 :version "28.1")
507
508(defcustom world-clock-timer-enable t
509 "If non-nil, a timer will update the `world-clock' buffer."
510 :type 'boolean
511 :version "28.1")
512
513(defcustom world-clock-timer-second 60
514 "Interval in seconds for updating the `world-clock' buffer."
515 :type 'integer
516 :version "28.1")
517
518(defface world-clock-label
519 '((t :inherit font-lock-variable-name-face))
520 "Face for time zone label in `world-clock' buffer.")
511 521
512(define-derived-mode display-time-world-mode special-mode "World clock" 522(define-derived-mode world-clock-mode special-mode "World clock"
513 "Major mode for buffer that displays times in various time zones. 523 "Major mode for buffer that displays times in various time zones.
514See `display-time-world'." 524See `world-clock'."
525 (setq revert-buffer-function #'world-clock-update)
515 (setq show-trailing-whitespace nil)) 526 (setq show-trailing-whitespace nil))
516 527
517(defun display-time-world-display (alist) 528(defun world-clock-display (alist)
518 "Replace current buffer text with times in various zones, based on ALIST." 529 "Replace current buffer text with times in various zones, based on ALIST."
519 (let ((inhibit-read-only t) 530 (let ((inhibit-read-only t)
520 (buffer-undo-list t) 531 (buffer-undo-list t)
@@ -526,42 +537,45 @@ See `display-time-world'."
526 (let* ((label (cadr zone)) 537 (let* ((label (cadr zone))
527 (width (string-width label))) 538 (width (string-width label)))
528 (push (cons label 539 (push (cons label
529 (format-time-string display-time-world-time-format 540 (format-time-string world-clock-time-format
530 now (car zone))) 541 now (car zone)))
531 result) 542 result)
532 (when (> width max-width) 543 (when (> width max-width)
533 (setq max-width width)))) 544 (setq max-width width))))
534 (setq fmt (concat "%-" (int-to-string max-width) "s %s\n")) 545 (setq fmt (concat "%-" (int-to-string max-width) "s %s\n"))
535 (dolist (timedata (nreverse result)) 546 (dolist (timedata (nreverse result))
536 (insert (format fmt (car timedata) (cdr timedata)))) 547 (insert (format fmt
548 (propertize (car timedata)
549 'face 'world-clock-label)
550 (cdr timedata))))
537 (delete-char -1)) 551 (delete-char -1))
538 (goto-char (point-min))) 552 (goto-char (point-min)))
539 553
540;;;###autoload 554;;;###autoload
541(defun display-time-world () 555(defun world-clock ()
542 "Enable updating display of times in various time zones. 556 "Display a world clock buffer with times in various time zones.
543`display-time-world-list' specifies the zones. 557The variable `world-clock-list' specifies which time zones to use.
544To turn off the world time display, go to that window and type `q'." 558To turn off the world time display, go to the window and type `\\[quit-window]'."
545 (interactive) 559 (interactive)
546 (when (and display-time-world-timer-enable 560 (when (and world-clock-timer-enable
547 (not (get-buffer display-time-world-buffer-name))) 561 (not (get-buffer world-clock-buffer-name)))
548 (run-at-time t display-time-world-timer-second 'display-time-world-timer)) 562 (run-at-time t world-clock-timer-second #'world-clock-update))
549 (with-current-buffer (get-buffer-create display-time-world-buffer-name) 563 (pop-to-buffer world-clock-buffer-name)
550 (display-time-world-display (time--display-world-list)) 564 (world-clock-display (time--display-world-list))
551 (display-buffer display-time-world-buffer-name 565 (world-clock-mode)
552 (cons nil '((window-height . fit-window-to-buffer)))) 566 (fit-window-to-buffer))
553 (display-time-world-mode))) 567
554 568(defun world-clock-update (&optional _arg _noconfirm)
555(defun display-time-world-timer () 569 "Update the `world-clock' buffer."
556 (if (get-buffer display-time-world-buffer-name) 570 (if (get-buffer world-clock-buffer-name)
557 (with-current-buffer (get-buffer display-time-world-buffer-name) 571 (with-current-buffer (get-buffer world-clock-buffer-name)
558 (display-time-world-display (time--display-world-list))) 572 (world-clock-display (time--display-world-list)))
559 ;; cancel timer 573 ;; cancel timer
560 (let ((list timer-list)) 574 (let ((list timer-list))
561 (while list 575 (while list
562 (let ((elt (pop list))) 576 (let ((elt (pop list)))
563 (when (equal (symbol-name (timer--function elt)) 577 (when (equal (symbol-name (timer--function elt))
564 "display-time-world-timer") 578 "world-clock-update")
565 (cancel-timer elt))))))) 579 (cancel-timer elt)))))))
566 580
567;;;###autoload 581;;;###autoload