home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2 / Openstep-4.2-Intel-User.iso / usr / lib / emacs / lisp / time.el < prev    next >
Lisp/Scheme  |  1991-10-05  |  4KB  |  122 lines
  1. ;; Display time and load in mode line of Emacs.
  2. ;; Copyright (C) 1985, 1986, 1987, 1990 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. (defvar display-time-process nil)
  26.  
  27. (defvar display-time-interval 60
  28.   "*Seconds between updates of time in the mode line.")
  29.  
  30. (defvar display-time-string nil)
  31.  
  32. (defun display-time ()
  33.   "Display current time and load level in mode line of each buffer.
  34. Updates automatically every minute.
  35. If display-time-day-and-date is non-nil, the current day and date
  36. are displayed as well."
  37.   (interactive)
  38.   (let ((live (and display-time-process
  39.            (eq (process-status display-time-process) 'run))))
  40.     (if (not live)
  41.     (progn
  42.       (if display-time-process
  43.           (delete-process display-time-process))
  44.       (or global-mode-string (setq global-mode-string '("")))
  45.       (or (memq 'display-time-string global-mode-string)
  46.           (setq global-mode-string
  47.             (append global-mode-string '(display-time-string))))
  48.       (setq display-time-string "")
  49.       (let ((process-connection-type nil))
  50.         (setq display-time-process
  51.           (start-process "display-time" nil
  52.                  (concat exec-directory "wakeup")
  53.                  (int-to-string display-time-interval))))
  54.       (process-kill-without-query display-time-process)
  55.       (set-process-sentinel display-time-process 'display-time-sentinel)
  56.       (set-process-filter display-time-process 'display-time-filter)))))
  57.  
  58. (defun display-time-sentinel (proc reason)
  59.   (or (eq (process-status proc) 'run)
  60.       (setq display-time-string ""))
  61.   ;; Force mode-line updates
  62.   (save-excursion (set-buffer (other-buffer)))
  63.   (set-buffer-modified-p (buffer-modified-p))
  64.   (sit-for 0))
  65.  
  66. (defun display-time-filter (proc string)
  67.   (let ((time (current-time-string))
  68.     (load (condition-case ()
  69.           (if (zerop (car (load-average))) ""
  70.             (format "%03d" (car (load-average))))
  71.         (error
  72.          (condition-case ()
  73.              (unwind-protect
  74.              (save-excursion
  75.                (set-buffer (get-buffer-create " *uptime*"))
  76.                (call-process "/usr/ucb/uptime" nil (current-buffer))
  77.                (goto-char (point-min))
  78.                (search-forward "average: ")
  79.                ;; Get the integer part and fraction part,
  80.                ;; discarding the period.
  81.                ;; (Because code below adds a period.)
  82.                (concat
  83.                 (buffer-substring (point)
  84.                           (progn (forward-word 1) (point)))
  85.                 (buffer-substring (1+ (point))
  86.                           (progn (forward-word 1) (point)))))
  87.                (kill-buffer " *uptime*"))
  88.            (error "")))))
  89.     (mail-spool-file (or display-time-mail-file
  90.                  (getenv "MAIL")
  91.                  (concat rmail-spool-directory
  92.                      (or (getenv "LOGNAME")
  93.                      (getenv "USER")
  94.                      (user-login-name)))))
  95.     hour pm)
  96.     (setq hour (read (substring time 11 13)))
  97.     (setq pm (>= hour 12))
  98.     (if (> hour 12)
  99.     (setq hour (- hour 12))
  100.       (if (= hour 0)
  101.       (setq hour 12)))
  102.     (setq display-time-string
  103.       (concat (format "%d" hour) (substring time 13 16)
  104.           (if pm "pm" "am")
  105.           (if (string= load "")
  106.               ""
  107.             (concat " " (substring load 0 -2) "." (substring load -2)))
  108.           (if (and (file-exists-p mail-spool-file)
  109.                ;; file not empty?
  110.                (> (nth 7 (file-attributes mail-spool-file)) 0))
  111.               " Mail"
  112.             "")))
  113.     ;; Append the date if desired.
  114.     (if display-time-day-and-date
  115.     (setq display-time-string
  116.           (concat (substring time 0 11) display-time-string))))
  117.   ;; Force redisplay of all buffers' mode lines to be considered.
  118.   (save-excursion (set-buffer (other-buffer)))
  119.   (set-buffer-modified-p (buffer-modified-p))
  120.   ;; Do redisplay right now, if no input pending.
  121.   (sit-for 0))
  122.