lisp/time.el

   1 ;;; time.el --- display time and load in mode line of Emacs.
   2
   3 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 1, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21
  22 (defvar display-time-mail-file nil
  23   "*File name of mail inbox file, for indicating existence of new mail.
  24 Default is system-dependent, and is the same as used by Rmail.")
  25
  26 ;;;###autoload
  27 (defconst display-time-day-and-date nil "\
  28 *Non-nil means \\[display-time] should display day and date as well as time.")
  29
  30 (defvar display-time-process nil)
  31
  32 (defvar display-time-interval 60
  33   "*Seconds between updates of time in the mode line.")
  34
  35 (defvar display-time-24hr-format nil
  36   "Non-nill indicates time should be displayed as hh:mm, 0 <= hh <= 23.
  37 Nil means 1 <= hh <= 12, and an AM/PM suffix is used.")
  38
  39 (defvar display-time-string nil)
  40
  41 (defvar display-time-hook nil
  42   "* List of functions to be called when the time is updated on the mode line.")
  43
  44 ;;;###autoload
  45 (defun display-time ()
  46   "Display current time and load level in mode line of each buffer.
  47 Updates automatically every minute.
  48 If `display-time-day-and-date' is non-nil, the current day and date
  49 are displayed as well.
  50 After each update, `display-time-hook' is run with `run-hooks'."
  51   (interactive)
  52   (let ((live (and display-time-process
  53                    (eq (process-status display-time-process) 'run))))
  54     (if (not live)
  55         (progn
  56           (if display-time-process
  57               (delete-process display-time-process))
  58           (or global-mode-string (setq global-mode-string '("")))
  59           (or (memq 'display-time-string global-mode-string)
  60               (setq global-mode-string
  61                     (append global-mode-string '(display-time-string))))
  62           (setq display-time-string "")
  63           (setq display-time-process
  64                 (start-process "display-time" nil
  65                                (concat exec-directory "wakeup")
  66                                (int-to-string display-time-interval)))
  67           (process-kill-without-query display-time-process)
  68           (set-process-sentinel display-time-process 'display-time-sentinel)
  69           (set-process-filter display-time-process 'display-time-filter)))))
  70
  71 (defun display-time-sentinel (proc reason)
  72   (or (eq (process-status proc) 'run)
  73       (setq display-time-string ""))
  74   ;; Force mode-line updates
  75   (save-excursion (set-buffer (other-buffer)))
  76   (set-buffer-modified-p (buffer-modified-p))
  77   (sit-for 0))
  78
  79 (defun display-time-filter (proc string)
  80   (let ((time (current-time-string))
  81         (load (condition-case ()
  82                   (if (zerop (car (load-average))) ""
  83                     (let ((str (format " %03d" (car (load-average)))))
  84                       (concat (substring str 0 -2) "." (substring str -2))))
  85                 (error "")))
  86         (mail-spool-file (or display-time-mail-file
  87                              (getenv "MAIL")
  88                              (concat rmail-spool-directory
  89                                      (or (getenv "LOGNAME")
  90                                          (getenv "USER")
  91                                          (user-login-name)))))
  92         hour am-pm-flag)
  93     (setq hour (read (substring time 11 13)))
  94     (if (not display-time-24hr-format)
  95         (progn
  96           (setq am-pm-flag (if (>= hour 12) "pm" "am"))
  97           (if (> hour 12)
  98               (setq hour (- hour 12))
  99             (if (= hour 0)
 100                 (setq hour 12))))
 101       (setq am-pm-flag ""))
 102     (setq display-time-string
 103           (concat (format "%d" hour) (substring time 13 16)
 104                   am-pm-flag
 105                   load
 106                   (if (and (file-exists-p mail-spool-file)
 107                            ;; file not empty?
 108                            (display-time-file-nonempty-p mail-spool-file))
 109                       " Mail"
 110                     "")))
 111     ;; Append the date if desired.
 112     (if display-time-day-and-date
 113         (setq display-time-string
 114               (concat (substring time 0 11) display-time-string))))
 115   (run-hooks 'display-time-hook)
 116   ;; Force redisplay of all buffers' mode lines to be considered.
 117   (save-excursion (set-buffer (other-buffer)))
 118   (set-buffer-modified-p (buffer-modified-p))
 119   ;; Do redisplay right now, if no input pending.
 120   (sit-for 0))
 121
 122 (defun display-time-file-nonempty-p (file)
 123   (while (file-symlink-p file)
 124     (setq file (file-symlink-p file)))
 125   (> (nth 7 (file-attributes file)) 0))
 126
 127 ;;; time.el ends here