1;;; time.el --- display time and load in mode line of Emacs. 2 3;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc. 4 5;; Maintainer: FSF 6 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 11;; the Free Software Foundation; either version 2, or (at your option) 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 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 28;;; Code: 29 30(defvar display-time-mail-file nil 31 "*File name of mail inbox file, for indicating existence of new mail. 32Default is system-dependent, and is the same as used by Rmail.") 33 34;;;###autoload 35(defvar display-time-day-and-date nil "\ 36*Non-nil means \\[display-time] should display day and date as well as time.") 37 38(defvar display-time-process nil) 39 40(defvar display-time-interval 60 41 "*Seconds between updates of time in the mode line.") 42 43(defvar display-time-24hr-format nil 44 "*Non-nill indicates time should be displayed as hh:mm, 0 <= hh <= 23. 45Nil means 1 <= hh <= 12, and an AM/PM suffix is used.") 46 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 52(defvar display-time-server-down-time nil 53 "Time when mail file's file system was recorded to be down. 54If that file system seems to be up, the value is nil.") 55 56;;;###autoload 57(defun display-time () 58 "Display current time, load level, and mail flag in mode line of each buffer. 59Updates automatically every minute. 60If `display-time-day-and-date' is non-nil, the current day and date 61are displayed as well. 62After 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 "") 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)))) 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)) 96 (load (condition-case () 97 (if (zerop (car (load-average))) "" 98 (let ((str (format " %03d" (car (load-average))))) 99 (concat (substring str 0 -2) "." (substring str -2)))) 100 (error ""))) 101 (mail-spool-file (or display-time-mail-file 102 (getenv "MAIL") 103 (concat rmail-spool-directory 104 (user-login-name)))) 105 hour am-pm-flag mail-flag) 106 (setq hour (read (substring time 11 13))) 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 "")) 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 "")) 134 (setq display-time-string 135 (concat (format "%d" hour) (substring time 13 16) 136 am-pm-flag 137 load 138 mail-flag)) 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)) 149 150(defun display-time-file-nonempty-p (file) 151 (and (file-exists-p file) 152 (< 0 (nth 7 (file-attributes (file-chase-links file)))))) 153 154;;; time.el ends here 155