Commit | Line | Data |
---|---|---|
d501f516 ER |
1 | ;;; time.el --- display time and load in mode line of Emacs. |
2 | ||
8f1204db | 3 | ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc. |
9673300a | 4 | |
58142744 ER |
5 | ;; Maintainer: FSF |
6 | ||
9673300a RS |
7 | ;; This file is part of GNU Emacs. |
8 | ||
9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
9673300a RS |
12 | ;; any later version. |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
21 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | ||
c91c4e6d ER |
23 | ;;; Commentary: |
24 | ||
25 | ;;; Facilities to display current time/date and a new-mail indicator | |
26 | ;;; in the Emacs mode line. The single entry point is `display-time'. | |
27 | ||
e5167999 | 28 | ;;; Code: |
9673300a | 29 | |
29975121 RS |
30 | (defvar display-time-mail-file nil |
31 | "*File name of mail inbox file, for indicating existence of new mail. | |
32 | Default is system-dependent, and is the same as used by Rmail.") | |
33 | ||
73fa8346 | 34 | ;;;###autoload |
c636405b | 35 | (defvar display-time-day-and-date nil "\ |
73fa8346 | 36 | *Non-nil means \\[display-time] should display day and date as well as time.") |
7229064d | 37 | |
9673300a RS |
38 | (defvar display-time-process nil) |
39 | ||
40 | (defvar display-time-interval 60 | |
41 | "*Seconds between updates of time in the mode line.") | |
42 | ||
c2be0af4 | 43 | (defvar display-time-24hr-format nil |
ce04ffeb | 44 | "*Non-nill indicates time should be displayed as hh:mm, 0 <= hh <= 23. |
c2be0af4 JB |
45 | Nil means 1 <= hh <= 12, and an AM/PM suffix is used.") |
46 | ||
9673300a RS |
47 | (defvar display-time-string nil) |
48 | ||
49 | (defvar display-time-hook nil | |
50 | "* List of functions to be called when the time is updated on the mode line.") | |
51 | ||
c44565c8 RS |
52 | (defvar display-time-server-down-time nil |
53 | "Time when mail file's file system was recorded to be down. | |
54 | If that file system seems to be up, the value is nil.") | |
55 | ||
7229064d | 56 | ;;;###autoload |
9673300a | 57 | (defun display-time () |
7bbbf29a | 58 | "Display current time, load level, and mail flag in mode line of each buffer. |
9673300a RS |
59 | Updates automatically every minute. |
60 | If `display-time-day-and-date' is non-nil, the current day and date | |
61 | are displayed as well. | |
62 | After each update, `display-time-hook' is run with `run-hooks'." | |
63 | (interactive) | |
64 | (let ((live (and display-time-process | |
65 | (eq (process-status display-time-process) 'run)))) | |
66 | (if (not live) | |
67 | (progn | |
68 | (if display-time-process | |
69 | (delete-process display-time-process)) | |
70 | (or global-mode-string (setq global-mode-string '(""))) | |
71 | (or (memq 'display-time-string global-mode-string) | |
72 | (setq global-mode-string | |
73 | (append global-mode-string '(display-time-string)))) | |
74 | (setq display-time-string "") | |
572986cd RS |
75 | ;; Using a pty is wasteful, and the separate session causes |
76 | ;; annoyance sometimes (some systems kill idle sessions). | |
77 | (let ((process-connection-type nil)) | |
78 | (setq display-time-process | |
79 | (start-process "display-time" nil | |
80 | (expand-file-name "wakeup" exec-directory) | |
81 | (int-to-string display-time-interval)))) | |
9673300a RS |
82 | (process-kill-without-query display-time-process) |
83 | (set-process-sentinel display-time-process 'display-time-sentinel) | |
84 | (set-process-filter display-time-process 'display-time-filter))))) | |
85 | ||
86 | (defun display-time-sentinel (proc reason) | |
87 | (or (eq (process-status proc) 'run) | |
88 | (setq display-time-string "")) | |
89 | ;; Force mode-line updates | |
90 | (save-excursion (set-buffer (other-buffer))) | |
91 | (set-buffer-modified-p (buffer-modified-p)) | |
92 | (sit-for 0)) | |
93 | ||
94 | (defun display-time-filter (proc string) | |
95 | (let ((time (current-time-string)) | |
7229064d RM |
96 | (load (condition-case () |
97 | (if (zerop (car (load-average))) "" | |
c2be0af4 JB |
98 | (let ((str (format " %03d" (car (load-average))))) |
99 | (concat (substring str 0 -2) "." (substring str -2)))) | |
7229064d | 100 | (error ""))) |
29975121 RS |
101 | (mail-spool-file (or display-time-mail-file |
102 | (getenv "MAIL") | |
103 | (concat rmail-spool-directory | |
df00183b | 104 | (user-login-name)))) |
c44565c8 | 105 | hour am-pm-flag mail-flag) |
9673300a | 106 | (setq hour (read (substring time 11 13))) |
c2be0af4 JB |
107 | (if (not display-time-24hr-format) |
108 | (progn | |
109 | (setq am-pm-flag (if (>= hour 12) "pm" "am")) | |
110 | (if (> hour 12) | |
111 | (setq hour (- hour 12)) | |
112 | (if (= hour 0) | |
113 | (setq hour 12)))) | |
114 | (setq am-pm-flag "")) | |
c44565c8 RS |
115 | (setq mail-flag |
116 | (if (and (or (null display-time-server-down-time) | |
117 | ;; If have been down for 20 min, try again. | |
118 | (> (- (nth 1 (current-time)) | |
119 | display-time-server-down-time) | |
120 | 1200)) | |
121 | (let ((start-time (current-time))) | |
122 | (prog1 | |
123 | (display-time-file-nonempty-p mail-spool-file) | |
124 | (if (> (- (nth 1 (current-time)) (nth 1 start-time)) | |
125 | 20) | |
126 | ;; Record that mail file is not accessible. | |
127 | (setq display-time-server-down-time | |
128 | (nth 1 (current-time))) | |
129 | ;; Record that mail file is accessible. | |
130 | (setq display-time-server-down-time nil)) | |
131 | ))) | |
132 | " Mail" | |
133 | "")) | |
9673300a RS |
134 | (setq display-time-string |
135 | (concat (format "%d" hour) (substring time 13 16) | |
c2be0af4 JB |
136 | am-pm-flag |
137 | load | |
c44565c8 | 138 | mail-flag)) |
9673300a RS |
139 | ;; Append the date if desired. |
140 | (if display-time-day-and-date | |
141 | (setq display-time-string | |
142 | (concat (substring time 0 11) display-time-string)))) | |
143 | (run-hooks 'display-time-hook) | |
144 | ;; Force redisplay of all buffers' mode lines to be considered. | |
145 | (save-excursion (set-buffer (other-buffer))) | |
146 | (set-buffer-modified-p (buffer-modified-p)) | |
147 | ;; Do redisplay right now, if no input pending. | |
148 | (sit-for 0)) | |
7229064d RM |
149 | |
150 | (defun display-time-file-nonempty-p (file) | |
c44565c8 RS |
151 | (and (file-exists-p file) |
152 | (< 0 (nth 7 (file-attributes (file-chase-links file)))))) | |
d501f516 ER |
153 | |
154 | ;;; time.el ends here |