lisp/time.el

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