50395
|
1 ;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*-
|
29706
|
2
|
50395
|
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 96, 2000, 2001, 2002, 2003
|
37364
|
4 ;; Free Software Foundation, Inc.
|
29706
|
5
|
|
6 ;; Maintainer: FSF
|
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
13 ;; any later version.
|
|
14
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
18 ;; GNU General Public License for more details.
|
|
19
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
24
|
|
25 ;;; Commentary:
|
|
26
|
|
27 ;; Facilities to display current time/date and a new-mail indicator
|
|
28 ;; in the Emacs mode line. The single entry point is `display-time'.
|
|
29
|
|
30 ;;; Code:
|
|
31
|
|
32 (defgroup display-time nil
|
|
33 "Display time and load in mode line of Emacs."
|
|
34 :group 'modeline
|
|
35 :group 'mail)
|
|
36
|
|
37
|
|
38 (defcustom display-time-mail-file nil
|
|
39 "*File name of mail inbox file, for indicating existence of new mail.
|
|
40 Non-nil and not a string means don't check for mail. nil means use
|
|
41 default, which is system-dependent, and is the same as used by Rmail."
|
47486
|
42 :type '(choice (const :tag "None" none)
|
29706
|
43 (const :tag "Default" nil)
|
|
44 (file :format "%v"))
|
|
45 :group 'display-time)
|
|
46
|
42998
|
47 (defcustom display-time-mail-directory nil
|
|
48 "*Name of mail inbox directory, for indicating existence of new mail.
|
45041
cbfb6a5db0be
(display-time-mail-directory, display-time-mail-function): Doc fixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
49 Any nonempty regular file in the directory is regarded as newly arrived mail.
|
cbfb6a5db0be
(display-time-mail-directory, display-time-mail-function): Doc fixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
50 If nil, do not check a directory for arriving mail."
|
42998
|
51 :type '(choice (const :tag "None" nil)
|
|
52 (directory :format "%v"))
|
|
53 :group 'display-time)
|
|
54
|
29706
|
55 (defcustom display-time-mail-function nil
|
|
56 "*Function to call, for indicating existence of new mail.
|
45041
cbfb6a5db0be
(display-time-mail-directory, display-time-mail-function): Doc fixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
57 If nil, that means use the default method: check that the file
|
cbfb6a5db0be
(display-time-mail-directory, display-time-mail-function): Doc fixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
58 specified by `display-time-mail-file' is nonempty or that the
|
cbfb6a5db0be
(display-time-mail-directory, display-time-mail-function): Doc fixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
59 directory `display-time-mail-directory' contains nonempty files."
|
29706
|
60 :type '(choice (const :tag "Default" nil)
|
|
61 (function))
|
|
62 :group 'display-time)
|
|
63
|
42261
|
64 (defcustom display-time-default-load-average 0
|
50395
|
65 "*Which load average value will be shown in the mode line.
|
42261
|
66 Almost every system can provide values of load for past 1 minute, past 5 or
|
|
67 past 15 minutes. The default is to display 1 minute load average."
|
|
68 :type '(choice (const :tag "1 minute load" 0)
|
|
69 (const :tag "5 minutes load" 1)
|
47486
|
70 (const :tag "15 minutes load" 2)
|
|
71 (const :tag "None" nil))
|
42261
|
72 :group 'display-time)
|
|
73
|
47486
|
74 (defvar display-time-load-average nil
|
50395
|
75 "Load average currently being shown in mode line.")
|
42261
|
76
|
|
77 (defcustom display-time-load-average-threshold 0.1
|
42494
35eeafd85667
(display-time-load-average-threshold): Fix defcustom (add type and group).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
78 "*Load-average values below this value won't be shown in the mode line."
|
35eeafd85667
(display-time-load-average-threshold): Fix defcustom (add type and group).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
79 :type 'number
|
35eeafd85667
(display-time-load-average-threshold): Fix defcustom (add type and group).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
80 :group 'display-time)
|
42261
|
81
|
29706
|
82 ;;;###autoload
|
|
83 (defcustom display-time-day-and-date nil "\
|
|
84 *Non-nil means \\[display-time] should display day and date as well as time."
|
|
85 :type 'boolean
|
|
86 :group 'display-time)
|
|
87
|
|
88 (defvar display-time-timer nil)
|
|
89
|
|
90 (defcustom display-time-interval 60
|
|
91 "*Seconds between updates of time in the mode line."
|
|
92 :type 'integer
|
|
93 :group 'display-time)
|
|
94
|
|
95 (defcustom display-time-24hr-format nil
|
|
96 "*Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
|
42261
|
97 nil means 1 <= hh <= 12, and an AM/PM suffix is used."
|
29706
|
98 :type 'boolean
|
|
99 :group 'display-time)
|
|
100
|
|
101 (defvar display-time-string nil)
|
|
102
|
|
103 (defcustom display-time-hook nil
|
|
104 "*List of functions to be called when the time is updated on the mode line."
|
|
105 :type 'hook
|
|
106 :group 'display-time)
|
|
107
|
|
108 (defvar display-time-server-down-time nil
|
|
109 "Time when mail file's file system was recorded to be down.
|
|
110 If that file system seems to be up, the value is nil.")
|
|
111
|
|
112 ;;;###autoload
|
|
113 (defun display-time ()
|
|
114 "Enable display of time, load level, and mail flag in mode lines.
|
|
115 This display updates automatically every minute.
|
|
116 If `display-time-day-and-date' is non-nil, the current day and date
|
|
117 are displayed as well.
|
|
118 This runs the normal hook `display-time-hook' after each update."
|
|
119 (interactive)
|
|
120 (display-time-mode 1))
|
|
121
|
50395
|
122 ;; This business used to be simpler when all mode lines had the same
|
|
123 ;; face and the image could just be pbm. Now we try to rely on an xpm
|
|
124 ;; image with a transparent background. Otherwise, set the background
|
|
125 ;; for pbm.
|
|
126
|
|
127 (defcustom display-time-mail-face nil
|
29706
|
128 "Face to use for `display-time-mail-string'.
|
50395
|
129 If `display-time-use-mail-icon' is non-nil, the image's
|
|
130 background colour is the background of this face. Set this to
|
|
131 make the mail indicator stand out on a colour display."
|
29706
|
132 :group 'faces
|
|
133 :group 'display-time
|
50395
|
134 :version "21.4"
|
|
135 :type '(choice (const :tag "None" nil) face))
|
29706
|
136
|
|
137 (defvar display-time-mail-icon
|
42998
|
138 (find-image '((:type xpm :file "letter.xpm" :ascent center)
|
50395
|
139 (:type pbm :file "letter.pbm" :ascent center)))
|
|
140 "Image specification to offer as the mail indicator on a graphic display.
|
|
141 See `display-time-use-mail-icon' and `display-time-mail-face'.")
|
29706
|
142
|
50395
|
143 ;; Fixme: Default to icon on graphical display?
|
29706
|
144 (defcustom display-time-use-mail-icon nil
|
|
145 "Non-nil means use an icon as the mail indicator on a graphic display.
|
50395
|
146 Otherwise use `display-time-mail-string'. The icon may consume less
|
|
147 of the mode line. It is specified by `display-time-mail-icon'."
|
29706
|
148 :group 'display-time
|
|
149 :type 'boolean)
|
|
150
|
50395
|
151 ;; Fixme: maybe default to the character if we can display Unicode.
|
|
152 (defcustom display-time-mail-string "Mail"
|
|
153 "String to use as the mail indicator in `display-time-string-forms'.
|
|
154 This can use the Unicode letter character if you can display it."
|
|
155 :group 'display-time
|
|
156 :version "21.4"
|
|
157 :type '(choice (const "Mail")
|
|
158 ;; Use :tag here because the Lucid menu won't display
|
|
159 ;; multibyte text.
|
|
160 (const :tag "Unicode letter character" "��")
|
|
161 string))
|
|
162
|
29706
|
163 (defcustom display-time-format nil
|
|
164 "*A string specifying the format for displaying the time in the mode line.
|
|
165 See the function `format-time-string' for an explanation of
|
|
166 how to write this string. If this is nil, the defaults
|
|
167 depend on `display-time-day-and-date' and `display-time-24hr-format'."
|
|
168 :type '(choice (const :tag "Default" nil)
|
|
169 string)
|
|
170 :group 'display-time)
|
|
171
|
|
172 (defcustom display-time-string-forms
|
|
173 '((if (and (not display-time-format) display-time-day-and-date)
|
|
174 (format-time-string "%a %b %e " now)
|
|
175 "")
|
|
176 (format-time-string (or display-time-format
|
|
177 (if display-time-24hr-format "%H:%M" "%-I:%M%p"))
|
|
178 now)
|
|
179 load
|
|
180 (if mail
|
|
181 ;; Build the string every time to act on customization.
|
50395
|
182 ;; :set-after doesn't help for `customize-option'. I think it
|
|
183 ;; should.
|
|
184 (concat
|
|
185 " "
|
|
186 (propertize
|
|
187 display-time-mail-string
|
|
188 'display `(when (and display-time-use-mail-icon
|
|
189 (display-graphic-p))
|
|
190 ,@display-time-mail-icon
|
|
191 ,@(if (and display-time-mail-face
|
|
192 (memq (plist-get (cdr display-time-mail-icon)
|
|
193 :type)
|
|
194 '(pbm xbm)))
|
|
195 (let ((bg (face-attribute display-time-mail-face
|
|
196 :background)))
|
|
197 (if (stringp bg)
|
|
198 (list :background bg)))))
|
|
199 'face display-time-mail-face
|
|
200 'help-echo "You have new mail; mouse-2: Read mail"
|
|
201 'local-map (make-mode-line-mouse-map 'mouse-2
|
|
202 read-mail-command)))
|
29706
|
203 ""))
|
|
204 "*A list of expressions governing display of the time in the mode line.
|
|
205 For most purposes, you can control the time format using `display-time-format'
|
|
206 which is a more standard interface.
|
|
207
|
|
208 This expression is a list of expressions that can involve the keywords
|
|
209 `load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
|
|
210 `seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
|
|
211 and `time-zone' all alphabetic strings, and `mail' a true/nil value.
|
|
212
|
|
213 For example, the form
|
|
214
|
|
215 '((substring year -2) \"/\" month \"/\" day
|
|
216 \" \" 24-hours \":\" minutes \":\" seconds
|
|
217 (if time-zone \" (\") time-zone (if time-zone \")\")
|
|
218 (if mail \" Mail\" \"\"))
|
|
219
|
|
220 would give mode line times like `94/12/30 21:07:48 (UTC)'."
|
|
221 :type 'sexp
|
|
222 :group 'display-time)
|
|
223
|
|
224 (defun display-time-event-handler ()
|
|
225 (display-time-update)
|
|
226 ;; Do redisplay right now, if no input pending.
|
|
227 (sit-for 0)
|
|
228 (let* ((current (current-time))
|
|
229 (timer display-time-timer)
|
|
230 ;; Compute the time when this timer will run again, next.
|
|
231 (next-time (timer-relative-time
|
|
232 (list (aref timer 1) (aref timer 2) (aref timer 3))
|
|
233 (* 5 (aref timer 4)) 0)))
|
|
234 ;; If the activation time is far in the past,
|
|
235 ;; skip executions until we reach a time in the future.
|
|
236 ;; This avoids a long pause if Emacs has been suspended for hours.
|
|
237 (or (> (nth 0 next-time) (nth 0 current))
|
|
238 (and (= (nth 0 next-time) (nth 0 current))
|
|
239 (> (nth 1 next-time) (nth 1 current)))
|
|
240 (and (= (nth 0 next-time) (nth 0 current))
|
|
241 (= (nth 1 next-time) (nth 1 current))
|
|
242 (> (nth 2 next-time) (nth 2 current)))
|
|
243 (progn
|
|
244 (timer-set-time timer (timer-next-integral-multiple-of-time
|
|
245 current display-time-interval)
|
|
246 display-time-interval)
|
|
247 (timer-activate timer)))))
|
|
248
|
42261
|
249 (defun display-time-next-load-average ()
|
|
250 (interactive)
|
|
251 (if (= 3 (setq display-time-load-average (1+ display-time-load-average)))
|
|
252 (setq display-time-load-average 0))
|
|
253 (display-time-update)
|
|
254 (sit-for 0))
|
|
255
|
42998
|
256 (defun display-time-mail-check-directory ()
|
|
257 (let ((mail-files (directory-files display-time-mail-directory t))
|
|
258 (size 0))
|
|
259 (while (and mail-files (= size 0))
|
|
260 ;; Count size of regular files only.
|
|
261 (setq size (+ size (or (and (file-regular-p (car mail-files))
|
|
262 (nth 7 (file-attributes (car mail-files))))
|
|
263 0)))
|
|
264 (setq mail-files (cdr mail-files)))
|
|
265 (if (> size 0)
|
|
266 size
|
|
267 nil)))
|
|
268
|
29706
|
269 (defun display-time-update ()
|
50395
|
270 "Update the display-time info for the mode line.
|
|
271 However, don't redisplay right now.
|
|
272
|
|
273 This is used for things like Rmail `g' that want to force an
|
|
274 update which can wait for the next redisplay."
|
29706
|
275 (let* ((now (current-time))
|
|
276 (time (current-time-string now))
|
47486
|
277 (load (if (null display-time-load-average)
|
|
278 ""
|
|
279 (condition-case ()
|
|
280 ;; Do not show values less than
|
|
281 ;; `display-time-load-average-threshold'.
|
|
282 (if (> (* display-time-load-average-threshold 100)
|
|
283 (nth display-time-load-average (load-average)))
|
|
284 ""
|
|
285 ;; The load average number is mysterious, so
|
|
286 ;; provide some help.
|
50395
|
287 (let ((str (format " %03d"
|
|
288 (nth display-time-load-average
|
|
289 (load-average)))))
|
47486
|
290 (propertize
|
|
291 (concat (substring str 0 -2) "." (substring str -2))
|
50395
|
292 'local-map (make-mode-line-mouse-map
|
|
293 'mouse-2 'display-time-next-load-average)
|
|
294 'help-echo (concat
|
|
295 "System load average for past "
|
|
296 (if (= 0 display-time-load-average)
|
|
297 "1 minute"
|
|
298 (if (= 1 display-time-load-average)
|
|
299 "5 minutes"
|
|
300 "15 minutes"))
|
|
301 "; mouse-2: next"))))
|
47486
|
302 (error ""))))
|
29706
|
303 (mail-spool-file (or display-time-mail-file
|
|
304 (getenv "MAIL")
|
|
305 (concat rmail-spool-directory
|
|
306 (user-login-name))))
|
|
307 (mail (or (and display-time-mail-function
|
|
308 (funcall display-time-mail-function))
|
42998
|
309 (and display-time-mail-directory
|
|
310 (display-time-mail-check-directory))
|
29706
|
311 (and (stringp mail-spool-file)
|
|
312 (or (null display-time-server-down-time)
|
|
313 ;; If have been down for 20 min, try again.
|
|
314 (> (- (nth 1 now) display-time-server-down-time)
|
|
315 1200)
|
|
316 (and (< (nth 1 now) display-time-server-down-time)
|
50395
|
317 (> (- (nth 1 now)
|
|
318 display-time-server-down-time)
|
29706
|
319 -64336)))
|
|
320 (let ((start-time (current-time)))
|
|
321 (prog1
|
|
322 (display-time-file-nonempty-p mail-spool-file)
|
50395
|
323 (if (> (- (nth 1 (current-time))
|
|
324 (nth 1 start-time))
|
29706
|
325 20)
|
|
326 ;; Record that mail file is not accessible.
|
|
327 (setq display-time-server-down-time
|
|
328 (nth 1 (current-time)))
|
|
329 ;; Record that mail file is accessible.
|
|
330 (setq display-time-server-down-time nil)))))))
|
|
331 (24-hours (substring time 11 13))
|
|
332 (hour (string-to-int 24-hours))
|
|
333 (12-hours (int-to-string (1+ (% (+ hour 11) 12))))
|
|
334 (am-pm (if (>= hour 12) "pm" "am"))
|
|
335 (minutes (substring time 14 16))
|
|
336 (seconds (substring time 17 19))
|
|
337 (time-zone (car (cdr (current-time-zone now))))
|
|
338 (day (substring time 8 10))
|
|
339 (year (substring time 20 24))
|
|
340 (monthname (substring time 4 7))
|
|
341 (month
|
|
342 (cdr
|
|
343 (assoc
|
|
344 monthname
|
|
345 '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4")
|
|
346 ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8")
|
|
347 ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
|
|
348 (dayname (substring time 0 3)))
|
|
349 (setq display-time-string
|
|
350 (mapconcat 'eval display-time-string-forms ""))
|
|
351 ;; This is inside the let binding, but we are not going to document
|
|
352 ;; what variables are available.
|
|
353 (run-hooks 'display-time-hook))
|
|
354 (force-mode-line-update))
|
|
355
|
|
356 (defun display-time-file-nonempty-p (file)
|
|
357 (and (file-exists-p file)
|
|
358 (< 0 (nth 7 (file-attributes (file-chase-links file))))))
|
|
359
|
31980
|
360 ;;;###autoload
|
|
361 (define-minor-mode display-time-mode
|
|
362 "Toggle display of time, load level, and mail flag in mode lines.
|
|
363 With a numeric arg, enable this display if arg is positive.
|
|
364
|
|
365 When this display is enabled, it updates automatically every minute.
|
|
366 If `display-time-day-and-date' is non-nil, the current day and date
|
|
367 are displayed as well.
|
|
368 This runs the normal hook `display-time-hook' after each update."
|
33197
|
369 :global t :group 'display-time
|
47486
|
370 (and display-time-timer (cancel-timer display-time-timer))
|
|
371 (setq display-time-timer nil)
|
|
372 (setq display-time-string "")
|
|
373 (or global-mode-string (setq global-mode-string '("")))
|
|
374 (setq display-time-load-average display-time-default-load-average)
|
|
375 (if display-time-mode
|
|
376 (progn
|
|
377 (or (memq 'display-time-string global-mode-string)
|
|
378 (setq global-mode-string
|
|
379 (append global-mode-string '(display-time-string))))
|
|
380 ;; Set up the time timer.
|
|
381 (setq display-time-timer
|
|
382 (run-at-time t display-time-interval
|
|
383 'display-time-event-handler))
|
|
384 ;; Make the time appear right away.
|
|
385 (display-time-update)
|
|
386 ;; When you get new mail, clear "Mail" from the mode line.
|
|
387 (add-hook 'rmail-after-get-new-mail-hook
|
|
388 'display-time-event-handler))
|
|
389 (remove-hook 'rmail-after-get-new-mail-hook
|
|
390 'display-time-event-handler)))
|
29706
|
391
|
|
392 (provide 'time)
|
|
393
|
52401
|
394 ;;; arch-tag: b9c1623f-b5cb-48e4-b650-482a4d23c5a6
|
29706
|
395 ;;; time.el ends here
|