1 |
;;; time.el --- display time, load and mail indicator in mode line of Emacs |
;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*- |
2 |
|
|
3 |
;; Copyright (C) 1985, 86, 87, 93, 94, 96, 2000, 2001, 2002 |
;; Copyright (C) 1985, 86, 87, 93, 94, 96, 2000, 2001, 2002, 2003 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Maintainer: FSF |
;; Maintainer: FSF |
39 |
"*File name of mail inbox file, for indicating existence of new mail. |
"*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 |
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." |
default, which is system-dependent, and is the same as used by Rmail." |
42 |
:type '(choice (const :tag "(None)" none) |
:type '(choice (const :tag "None" none) |
43 |
(const :tag "Default" nil) |
(const :tag "Default" nil) |
44 |
(file :format "%v")) |
(file :format "%v")) |
45 |
:group 'display-time) |
:group 'display-time) |
62 |
:group 'display-time) |
:group 'display-time) |
63 |
|
|
64 |
(defcustom display-time-default-load-average 0 |
(defcustom display-time-default-load-average 0 |
65 |
"*Which load-average value will be shown in the mode line. |
"*Which load average value will be shown in the mode line. |
66 |
Almost every system can provide values of load for past 1 minute, past 5 or |
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." |
past 15 minutes. The default is to display 1 minute load average." |
68 |
:type '(choice (const :tag "1 minute load" 0) |
:type '(choice (const :tag "1 minute load" 0) |
69 |
(const :tag "5 minutes load" 1) |
(const :tag "5 minutes load" 1) |
70 |
(const :tag "15 minutes load" 2)) |
(const :tag "15 minutes load" 2) |
71 |
|
(const :tag "None" nil)) |
72 |
:group 'display-time) |
:group 'display-time) |
73 |
|
|
74 |
(defvar display-time-load-average display-time-default-load-average) |
(defvar display-time-load-average nil |
75 |
|
"Load average currently being shown in mode line.") |
76 |
|
|
77 |
(defcustom display-time-load-average-threshold 0.1 |
(defcustom display-time-load-average-threshold 0.1 |
78 |
"*Load-average values below this value won't be shown in the mode line." |
"*Load-average values below this value won't be shown in the mode line." |
119 |
(interactive) |
(interactive) |
120 |
(display-time-mode 1)) |
(display-time-mode 1)) |
121 |
|
|
122 |
(defcustom display-time-mail-face 'mode-line |
;; 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 |
128 |
"Face to use for `display-time-mail-string'. |
"Face to use for `display-time-mail-string'. |
129 |
If `display-time-use-mail-icon' is non-nil, the image's background |
If `display-time-use-mail-icon' is non-nil, the image's |
130 |
colour is the background of this face. Set this to a face other than |
background colour is the background of this face. Set this to |
131 |
`mode-line' to make the mail indicator stand out on a suitable |
make the mail indicator stand out on a colour display." |
|
display." |
|
132 |
:group 'faces |
:group 'faces |
133 |
:group 'display-time |
:group 'display-time |
134 |
:type 'face) |
:version "21.4" |
135 |
|
:type '(choice (const :tag "None" nil) face)) |
136 |
|
|
137 |
(defvar display-time-mail-icon |
(defvar display-time-mail-icon |
138 |
(find-image '((:type xpm :file "letter.xpm" :ascent center) |
(find-image '((:type xpm :file "letter.xpm" :ascent center) |
139 |
(:type xbm :file "letter.xbm" :ascent center))) |
(:type pbm :file "letter.pbm" :ascent center))) |
140 |
"Image specification to offer as the mail indicator on a graphic |
"Image specification to offer as the mail indicator on a graphic display. |
141 |
display. See `display-time-use-mail-icon' and |
See `display-time-use-mail-icon' and `display-time-mail-face'.") |
|
`display-time-mail-face'.") |
|
142 |
|
|
143 |
|
;; Fixme: Default to icon on graphical display? |
144 |
(defcustom display-time-use-mail-icon nil |
(defcustom display-time-use-mail-icon nil |
145 |
"Non-nil means use an icon as the mail indicator on a graphic display. |
"Non-nil means use an icon as the mail indicator on a graphic display. |
146 |
Otherwise use the string \"Mail\". The icon may consume less of the |
Otherwise use `display-time-mail-string'. The icon may consume less |
147 |
mode line. It is specified by `display-time-mail-icon'." |
of the mode line. It is specified by `display-time-mail-icon'." |
148 |
:group 'display-time |
:group 'display-time |
149 |
:type 'boolean) |
:type 'boolean) |
150 |
|
|
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 |
|
|
163 |
(defcustom display-time-format nil |
(defcustom display-time-format nil |
164 |
"*A string specifying the format for displaying the time in the mode line. |
"*A string specifying the format for displaying the time in the mode line. |
165 |
See the function `format-time-string' for an explanation of |
See the function `format-time-string' for an explanation of |
179 |
load |
load |
180 |
(if mail |
(if mail |
181 |
;; Build the string every time to act on customization. |
;; Build the string every time to act on customization. |
182 |
(concat " " |
;; :set-after doesn't help for `customize-option'. I think it |
183 |
(propertize |
;; should. |
184 |
"Mail" |
(concat |
185 |
'display `(when (and display-time-use-mail-icon |
" " |
186 |
(display-graphic-p)) |
(propertize |
187 |
,@display-time-mail-icon |
display-time-mail-string |
188 |
,@(list :background (face-attribute |
'display `(when (and display-time-use-mail-icon |
189 |
display-time-mail-face |
(display-graphic-p)) |
190 |
:background))) |
,@display-time-mail-icon |
191 |
'help-echo "You have new mail; mouse-2: Read mail" |
,@(if (and display-time-mail-face |
192 |
'local-map (make-mode-line-mouse-map 'mouse-2 |
(memq (plist-get (cdr display-time-mail-icon) |
193 |
read-mail-command))) |
: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))) |
203 |
"")) |
"")) |
204 |
"*A list of expressions governing display of the time in the mode line. |
"*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' |
For most purposes, you can control the time format using `display-time-format' |
266 |
size |
size |
267 |
nil))) |
nil))) |
268 |
|
|
|
;; Update the display-time info for the mode line |
|
|
;; but don't redisplay right now. This is used for |
|
|
;; things like Rmail `g' that want to force an update |
|
|
;; which can wait for the next redisplay. |
|
269 |
(defun display-time-update () |
(defun display-time-update () |
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." |
275 |
(let* ((now (current-time)) |
(let* ((now (current-time)) |
276 |
(time (current-time-string now)) |
(time (current-time-string now)) |
277 |
(load (condition-case () |
(load (if (null display-time-load-average) |
278 |
;; Do not show values less than |
"" |
279 |
;; `display-time-load-average-threshold'. |
(condition-case () |
280 |
(if (> (* display-time-load-average-threshold 100) |
;; Do not show values less than |
281 |
(nth display-time-load-average (load-average))) |
;; `display-time-load-average-threshold'. |
282 |
"" |
(if (> (* display-time-load-average-threshold 100) |
283 |
;; The load average number is mysterious, so |
(nth display-time-load-average (load-average))) |
284 |
;; provide some help. |
"" |
285 |
(let ((str (format " %03d" (nth display-time-load-average (load-average))))) |
;; The load average number is mysterious, so |
286 |
(propertize |
;; provide some help. |
287 |
(concat (substring str 0 -2) "." (substring str -2)) |
(let ((str (format " %03d" |
288 |
'local-map (make-mode-line-mouse-map 'mouse-2 |
(nth display-time-load-average |
289 |
'display-time-next-load-average) |
(load-average))))) |
290 |
'help-echo (concat "System load average for past " |
(propertize |
291 |
(if (= 0 display-time-load-average) |
(concat (substring str 0 -2) "." (substring str -2)) |
292 |
"1 minute" |
'local-map (make-mode-line-mouse-map |
293 |
(if (= 1 display-time-load-average) |
'mouse-2 'display-time-next-load-average) |
294 |
"5 minutes" |
'help-echo (concat |
295 |
"15 minutes")) "; mouse-2: next" )))) |
"System load average for past " |
296 |
(error ""))) |
(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")))) |
302 |
|
(error "")))) |
303 |
(mail-spool-file (or display-time-mail-file |
(mail-spool-file (or display-time-mail-file |
304 |
(getenv "MAIL") |
(getenv "MAIL") |
305 |
(concat rmail-spool-directory |
(concat rmail-spool-directory |
314 |
(> (- (nth 1 now) display-time-server-down-time) |
(> (- (nth 1 now) display-time-server-down-time) |
315 |
1200) |
1200) |
316 |
(and (< (nth 1 now) display-time-server-down-time) |
(and (< (nth 1 now) display-time-server-down-time) |
317 |
(> (- (nth 1 now) display-time-server-down-time) |
(> (- (nth 1 now) |
318 |
|
display-time-server-down-time) |
319 |
-64336))) |
-64336))) |
320 |
(let ((start-time (current-time))) |
(let ((start-time (current-time))) |
321 |
(prog1 |
(prog1 |
322 |
(display-time-file-nonempty-p mail-spool-file) |
(display-time-file-nonempty-p mail-spool-file) |
323 |
(if (> (- (nth 1 (current-time)) (nth 1 start-time)) |
(if (> (- (nth 1 (current-time)) |
324 |
|
(nth 1 start-time)) |
325 |
20) |
20) |
326 |
;; Record that mail file is not accessible. |
;; Record that mail file is not accessible. |
327 |
(setq display-time-server-down-time |
(setq display-time-server-down-time |
367 |
are displayed as well. |
are displayed as well. |
368 |
This runs the normal hook `display-time-hook' after each update." |
This runs the normal hook `display-time-hook' after each update." |
369 |
:global t :group 'display-time |
:global t :group 'display-time |
370 |
(and display-time-timer (cancel-timer display-time-timer)) |
(and display-time-timer (cancel-timer display-time-timer)) |
371 |
(setq display-time-timer nil) |
(setq display-time-timer nil) |
372 |
(setq display-time-string "") |
(setq display-time-string "") |
373 |
(or global-mode-string (setq global-mode-string '(""))) |
(or global-mode-string (setq global-mode-string '(""))) |
374 |
(if display-time-mode |
(setq display-time-load-average display-time-default-load-average) |
375 |
(progn |
(if display-time-mode |
376 |
(or (memq 'display-time-string global-mode-string) |
(progn |
377 |
(setq global-mode-string |
(or (memq 'display-time-string global-mode-string) |
378 |
(append global-mode-string '(display-time-string)))) |
(setq global-mode-string |
379 |
;; Set up the time timer. |
(append global-mode-string '(display-time-string)))) |
380 |
(setq display-time-timer |
;; Set up the time timer. |
381 |
(run-at-time t display-time-interval |
(setq display-time-timer |
382 |
'display-time-event-handler)) |
(run-at-time t display-time-interval |
383 |
;; Make the time appear right away. |
'display-time-event-handler)) |
384 |
(display-time-update) |
;; Make the time appear right away. |
385 |
;; When you get new mail, clear "Mail" from the mode line. |
(display-time-update) |
386 |
(add-hook 'rmail-after-get-new-mail-hook |
;; When you get new mail, clear "Mail" from the mode line. |
387 |
'display-time-event-handler)) |
(add-hook 'rmail-after-get-new-mail-hook |
388 |
(remove-hook 'rmail-after-get-new-mail-hook |
'display-time-event-handler)) |
389 |
'display-time-event-handler))) |
(remove-hook 'rmail-after-get-new-mail-hook |
390 |
|
'display-time-event-handler))) |
391 |
|
|
392 |
(provide 'time) |
(provide 'time) |
393 |
|
|