home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / time.el < prev    next >
Encoding:
Text File  |  1992-10-22  |  4.2 KB  |  112 lines
  1. ;; Display time and load in mode line of Emacs.
  2. ;; This uses the Lucid GNU Emacs timeout-event mechanism, via a 
  3. ;; version of Kyle Jones' timer package.
  4. ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  5.  
  6. ;; This file is part of GNU Emacs.
  7.  
  8. ;; GNU Emacs is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 1, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. (require 'timer)
  23.  
  24. (defvar display-time-interval 60
  25.   "*Seconds between updates of time in the mode line.")
  26.  
  27. (defvar display-time-echo-area nil
  28.   "*If non-nil, display-time will use the echo area instead of 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. If display-time-echo-area is non-nil, the time is displayed in the
  38. echo area instead of in the mode-line."
  39.   (interactive)
  40.   ;; if the "display-time" timer already exists, nuke it first.
  41.   (let ((old (get-timer "display-time")))
  42.     (if old (delete-timer old)))
  43.   ;; If we're not displaying the time in the echo area
  44.   ;; and the global mode string does not have a non-nil value
  45.   ;; then initialize the global mode string's value.
  46.   (or display-time-echo-area
  47.       global-mode-string
  48.       (setq global-mode-string '("")))
  49.   ;; If we're not displaying the time in the echo area
  50.   ;; and our display variable is not part of the global-mode-string list
  51.   ;; the we add our variable to the list.  This will make the time
  52.   ;; appear on the modeline.
  53.   (or display-time-echo-area
  54.       (memq 'display-time-string global-mode-string)
  55.       (setq global-mode-string
  56.         (append global-mode-string '(display-time-string))))
  57.   ;; Display the time initially...
  58.   (display-time-function)
  59.   ;; ... and start a timer to do it automatically thereafter.
  60.   ;;
  61.   ;; If we wanted to be really clever about this, we could have the timer
  62.   ;; not be automatically restarted, but have it re-add itself each time.
  63.   ;; Then we could look at (current-time-seconds) and arrange for the timer
  64.   ;; to wake up exactly at the minute boundary.  But that's just a little
  65.   ;; more work than it's worth...
  66.   (start-timer "display-time" 'display-time-function
  67.            display-time-interval display-time-interval))
  68.  
  69.  
  70. (defun display-time-function ()
  71.   (let ((time (current-time-string))
  72.     (load (format "%03d" (car (load-average))))
  73.     (mail-spool-file (concat rmail-spool-directory
  74.                  (or (getenv "LOGNAME")
  75.                      (getenv "USER")
  76.                      (user-login-name))))
  77.     hour pm string)
  78.     (setq hour (read (substring time 11 13)))
  79.     (setq pm (>= hour 12))
  80.     (if (> hour 12)
  81.     (setq hour (- hour 12))
  82.       (if (= hour 0)
  83.       (setq hour 12)))
  84.     (setq string
  85.       (concat (format "%d" hour) (substring time 13 16)
  86.           (if pm "pm " "am ")
  87.           (substring load 0 -2) "." (substring load -2)
  88.           (if (and (file-exists-p mail-spool-file)
  89.                ;; file not empty?
  90.                (> (nth 7 (file-attributes mail-spool-file)) 0))
  91.               " Mail"
  92.             "")))
  93.     ;; Append the date if desired.
  94.     (if display-time-day-and-date
  95.     (setq string (concat (substring time 0 11) string)))
  96.     (if display-time-echo-area
  97.     (or (eq (selected-window) (minibuffer-window))
  98.         ;; don't stomp echo-area-buffer if reading from minibuffer now.
  99.         (save-excursion
  100.           (save-window-excursion
  101.         (select-window (minibuffer-window))
  102.         (erase-buffer)
  103.         (indent-to (- (screen-width) (length string) 1))
  104.         (insert string)
  105.         (message (buffer-string)))))
  106.       (setq display-time-string string)
  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.  
  111. (provide 'time)
  112.