1;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*-
2
3;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1996, 2000, 2001, 2002,
4;;   2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
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., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, 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 'mode-line
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.
40Non-nil and not a string means don't check for mail; nil means use
41default, which is system-dependent, and is the same as used by Rmail."
42  :type '(choice (const :tag "None" none)
43		 (const :tag "Default" nil)
44		 (file :format "%v"))
45  :group 'display-time)
46
47(defcustom display-time-mail-directory nil
48  "*Name of mail inbox directory, for indicating existence of new mail.
49Any nonempty regular file in the directory is regarded as newly arrived mail.
50If nil, do not check a directory for arriving mail."
51  :type '(choice (const :tag "None" nil)
52		 (directory :format "%v"))
53  :group 'display-time)
54
55(defcustom display-time-mail-function nil
56  "*Function to call, for indicating existence of new mail.
57If nil, that means use the default method: check that the file
58specified by `display-time-mail-file' is nonempty or that the
59directory `display-time-mail-directory' contains nonempty files."
60  :type '(choice (const :tag "Default" nil)
61		 (function))
62  :group 'display-time)
63
64(defcustom display-time-default-load-average 0
65  "*Which load average value will be shown in the mode line.
66Almost every system can provide values of load for past 1 minute, past 5 or
67past 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)
70		 (const :tag "15 minutes load" 2)
71		 (const :tag "None" nil))
72  :group 'display-time)
73
74(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
78  "*Load-average values below this value won't be shown in the mode line."
79  :type 'number
80  :group 'display-time)
81
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.
97A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used."
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.
110If 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.
115This display updates automatically every minute.
116If `display-time-day-and-date' is non-nil, the current day and date
117are displayed as well.
118This runs the normal hook `display-time-hook' after each update."
119  (interactive)
120  (display-time-mode 1))
121
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
128  "Face to use for `display-time-mail-string'.
129If `display-time-use-mail-icon' is non-nil, the image's
130background color is the background of this face.  Set this to
131make the mail indicator stand out on a color display."
132  :group 'mode-line-faces
133  :group 'display-time
134  :version "22.1"
135  :type '(choice (const :tag "None" nil) face))
136
137(defvar display-time-mail-icon
138  (find-image '((:type xpm :file "letter.xpm" :ascent center)
139		(:type pbm :file "letter.pbm" :ascent center)))
140  "Image specification to offer as the mail indicator on a graphic display.
141See `display-time-use-mail-icon' and `display-time-mail-face'.")
142
143;; Fixme: Default to icon on graphical display?
144(defcustom display-time-use-mail-icon nil
145  "Non-nil means use an icon as mail indicator on a graphic display.
146Otherwise use `display-time-mail-string'.  The icon may consume less
147of the mode line.  It is specified by `display-time-mail-icon'."
148  :group 'display-time
149  :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'.
154This can use the Unicode letter character if you can display it."
155  :group 'display-time
156  :version "22.1"
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
164  "*String specifying format for displaying the time in the mode line.
165See the function `format-time-string' for an explanation of
166how to write this string.  If this is nil, the defaults
167depend 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    (propertize
177     (format-time-string (or display-time-format
178			     (if display-time-24hr-format "%H:%M" "%-I:%M%p"))
179			 now)
180     'help-echo (format-time-string "%a %b %e, %Y" now))
181    load
182    (if mail
183	;; Build the string every time to act on customization.
184	;; :set-after doesn't help for `customize-option'.  I think it
185	;; should.
186	(concat
187	 " "
188	 (propertize
189	  display-time-mail-string
190	  'display `(when (and display-time-use-mail-icon
191			       (display-graphic-p))
192		      ,@display-time-mail-icon
193		      ,@(if (and display-time-mail-face
194				 (memq (plist-get (cdr display-time-mail-icon)
195						  :type)
196				       '(pbm xbm)))
197			    (let ((bg (face-attribute display-time-mail-face
198						      :background)))
199			      (if (stringp bg)
200				  (list :background bg)))))
201	  'face display-time-mail-face
202	  'help-echo "You have new mail; mouse-2: Read mail"
203	  'mouse-face 'mode-line-highlight
204	  'local-map (make-mode-line-mouse-map 'mouse-2
205					       read-mail-command)))
206      ""))
207  "*List of expressions governing display of the time in the mode line.
208For most purposes, you can control the time format using `display-time-format'
209which is a more standard interface.
210
211This expression is a list of expressions that can involve the keywords
212`load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
213`seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
214and `time-zone' all alphabetic strings, and `mail' a true/nil value.
215
216For example, the form
217
218  '((substring year -2) \"/\" month \"/\" day
219    \" \" 24-hours \":\" minutes \":\" seconds
220    (if time-zone \" (\") time-zone (if time-zone \")\")
221    (if mail \" Mail\" \"\"))
222
223would give mode line times like `94/12/30 21:07:48 (UTC)'."
224  :type 'sexp
225  :group 'display-time)
226
227(defun display-time-event-handler ()
228  (display-time-update)
229  ;; Do redisplay right now, if no input pending.
230  (sit-for 0)
231  (let* ((current (current-time))
232	 (timer display-time-timer)
233	 ;; Compute the time when this timer will run again, next.
234	 (next-time (timer-relative-time
235		     (list (aref timer 1) (aref timer 2) (aref timer 3))
236		     (* 5 (aref timer 4)) 0)))
237    ;; If the activation time is far in the past,
238    ;; skip executions until we reach a time in the future.
239    ;; This avoids a long pause if Emacs has been suspended for hours.
240    (or (> (nth 0 next-time) (nth 0 current))
241	(and (= (nth 0 next-time) (nth 0 current))
242	     (> (nth 1 next-time) (nth 1 current)))
243	(and (= (nth 0 next-time) (nth 0 current))
244	     (= (nth 1 next-time) (nth 1 current))
245	     (> (nth 2 next-time) (nth 2 current)))
246	(progn
247	  (timer-set-time timer (timer-next-integral-multiple-of-time
248				 current display-time-interval)
249			  display-time-interval)
250	  (timer-activate timer)))))
251
252(defun display-time-next-load-average ()
253  (interactive)
254  (if (= 3 (setq display-time-load-average (1+ display-time-load-average)))
255      (setq display-time-load-average 0))
256  (display-time-update)
257  (sit-for 0))
258
259(defun display-time-mail-check-directory ()
260  (let ((mail-files (directory-files display-time-mail-directory t))
261	(size 0))
262    (while (and mail-files (= size 0))
263      ;; Count size of regular files only.
264      (setq size (+ size (or (and (file-regular-p (car mail-files))
265				  (nth 7 (file-attributes (car mail-files))))
266			     0)))
267      (setq mail-files (cdr mail-files)))
268    (if (> size 0)
269	size
270      nil)))
271
272(defun display-time-update ()
273  "Update the display-time info for the mode line.
274However, don't redisplay right now.
275
276This is used for things like Rmail `g' that want to force an
277update which can wait for the next redisplay."
278  (let* ((now (current-time))
279	 (time (current-time-string now))
280         (load (if (null display-time-load-average)
281		   ""
282		 (condition-case ()
283		     ;; Do not show values less than
284		     ;; `display-time-load-average-threshold'.
285		     (if (> (* display-time-load-average-threshold 100)
286			    (nth display-time-load-average (load-average)))
287			 ""
288		       ;; The load average number is mysterious, so
289		       ;; provide some help.
290		       (let ((str (format " %03d"
291					  (nth display-time-load-average
292					       (load-average)))))
293			 (propertize
294			  (concat (substring str 0 -2) "." (substring str -2))
295			  'local-map (make-mode-line-mouse-map
296				      'mouse-2 'display-time-next-load-average)
297			  'mouse-face 'mode-line-highlight
298			  'help-echo (concat
299				      "System load average for past "
300				      (if (= 0 display-time-load-average)
301					  "1 minute"
302					(if (= 1 display-time-load-average)
303					    "5 minutes"
304					  "15 minutes"))
305				      "; mouse-2: next"))))
306		   (error ""))))
307         (mail-spool-file (or display-time-mail-file
308                              (getenv "MAIL")
309                              (concat rmail-spool-directory
310                                      (user-login-name))))
311	 (mail (or (and display-time-mail-function
312			(funcall display-time-mail-function))
313		   (and display-time-mail-directory
314			(display-time-mail-check-directory))
315		   (and (stringp mail-spool-file)
316			(or (null display-time-server-down-time)
317			    ;; If have been down for 20 min, try again.
318			    (> (- (nth 1 now) display-time-server-down-time)
319			       1200)
320			    (and (< (nth 1 now) display-time-server-down-time)
321				 (> (- (nth 1 now)
322				       display-time-server-down-time)
323				    -64336)))
324			(let ((start-time (current-time)))
325			  (prog1
326			      (display-time-file-nonempty-p mail-spool-file)
327			    (if (> (- (nth 1 (current-time))
328				      (nth 1 start-time))
329				   20)
330				;; Record that mail file is not accessible.
331				(setq display-time-server-down-time
332				      (nth 1 (current-time)))
333			      ;; Record that mail file is accessible.
334			      (setq display-time-server-down-time nil)))))))
335         (24-hours (substring time 11 13))
336         (hour (string-to-number 24-hours))
337         (12-hours (int-to-string (1+ (% (+ hour 11) 12))))
338         (am-pm (if (>= hour 12) "pm" "am"))
339         (minutes (substring time 14 16))
340         (seconds (substring time 17 19))
341         (time-zone (car (cdr (current-time-zone now))))
342         (day (substring time 8 10))
343         (year (substring time 20 24))
344         (monthname (substring time 4 7))
345         (month
346          (cdr
347           (assoc
348            monthname
349            '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4")
350              ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8")
351              ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
352         (dayname (substring time 0 3)))
353    (setq display-time-string
354          (mapconcat 'eval display-time-string-forms ""))
355    ;; This is inside the let binding, but we are not going to document
356    ;; what variables are available.
357    (run-hooks 'display-time-hook))
358  (force-mode-line-update))
359
360(defun display-time-file-nonempty-p (file)
361  (and (file-exists-p file)
362       (< 0 (nth 7 (file-attributes (file-chase-links file))))))
363
364;;;###autoload
365(define-minor-mode display-time-mode
366  "Toggle display of time, load level, and mail flag in mode lines.
367With a numeric arg, enable this display if arg is positive.
368
369When this display is enabled, it updates automatically every minute.
370If `display-time-day-and-date' is non-nil, the current day and date
371are displayed as well.
372This runs the normal hook `display-time-hook' after each update."
373  :global t :group 'display-time
374  (and display-time-timer (cancel-timer display-time-timer))
375  (setq display-time-timer nil)
376  (setq display-time-string "")
377  (or global-mode-string (setq global-mode-string '("")))
378  (setq display-time-load-average display-time-default-load-average)
379  (if display-time-mode
380      (progn
381	(or (memq 'display-time-string global-mode-string)
382	    (setq global-mode-string
383		  (append global-mode-string '(display-time-string))))
384	;; Set up the time timer.
385	(setq display-time-timer
386	      (run-at-time t display-time-interval
387			   'display-time-event-handler))
388	;; Make the time appear right away.
389	(display-time-update)
390	;; When you get new mail, clear "Mail" from the mode line.
391	(add-hook 'rmail-after-get-new-mail-hook
392		  'display-time-event-handler))
393    (remove-hook 'rmail-after-get-new-mail-hook
394		 'display-time-event-handler)))
395
396(provide 'time)
397
398;;; arch-tag: b9c1623f-b5cb-48e4-b650-482a4d23c5a6
399;;; time.el ends here
400