home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / time.el < prev    next >
Encoding:
Text File  |  1995-08-22  |  5.6 KB  |  147 lines
  1. ;;; time.el --- display time and load in mode line of Emacs.
  2. ;; Keywords: extensions
  3.  
  4. ;; See also reportmail.el.
  5. ;; This uses the Lucid Emacs timeout-event mechanism, via a version
  6. ;; of Kyle Jones' itimer package.
  7. ;; Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. (require 'itimer)
  26.  
  27. (defvar display-time-mail-file nil
  28.   "*File name of mail inbox file, for indicating existence of new mail.
  29. Default is system-dependent, and is the same as used by Rmail.")
  30.  
  31. ;;;###autoload
  32. (defvar display-time-day-and-date nil "\
  33. *Non-nil means \\[display-time] should display day and date as well as time.")
  34.  
  35. (defvar display-time-interval 60
  36.   "*Seconds between updates of time in the mode line.")
  37.  
  38. (defvar display-time-24hr-format nil
  39.   "*Non-nill indicates time should be displayed as hh:mm, 0 <= hh <= 23.
  40. Nil means 1 <= hh <= 12, and an AM/PM suffix is used.")
  41.  
  42. (defvar display-time-echo-area nil
  43.   "*If non-nil, display-time will use the echo area instead of the mode line.")
  44.  
  45. (defvar display-time-hook nil
  46.   "*List of functions to be called when the time is updated on the mode line.")
  47.  
  48. (defvar display-time-string nil)
  49.  
  50. ;;;###autoload
  51. (defun display-time ()
  52.   "Display current time, load level, and mail flag in mode line of each buffer.
  53. Updates automatically every minute.
  54. If `display-time-day-and-date' is non-nil, the current day and date
  55. are displayed as well.
  56. After each update, `display-time-hook' is run with `run-hooks'.
  57. If `display-time-echo-area' is non-nil, the time is displayed in the
  58. echo area instead of in the mode-line."
  59.   (interactive)
  60.   ;; if the "display-time" itimer already exists, nuke it first.
  61.   (let ((old (get-itimer "display-time")))
  62.     (if old (delete-itimer old)))
  63.   ;; If we're not displaying the time in the echo area
  64.   ;; and the global mode string does not have a non-nil value
  65.   ;; then initialize the global mode string's value.
  66.   (or display-time-echo-area
  67.       global-mode-string
  68.       (setq global-mode-string '("")))
  69.   ;; If we're not displaying the time in the echo area
  70.   ;; and our display variable is not part of the global-mode-string list
  71.   ;; the we add our variable to the list.  This will make the time
  72.   ;; appear on the modeline.
  73.   (or display-time-echo-area
  74.       (memq 'display-time-string global-mode-string)
  75.       (setq global-mode-string
  76.         (append global-mode-string '(display-time-string))))
  77.   ;; Display the time initially...
  78.   (display-time-function)
  79.   ;; ... and start an itimer to do it automatically thereafter.
  80.   ;;
  81.   ;; If we wanted to be really clever about this, we could have the itimer
  82.   ;; not be automatically restarted, but have it re-add itself each time.
  83.   ;; Then we could look at (current-time) and arrange for the itimer to
  84.   ;; wake up exactly at the minute boundary.  But that's just a little
  85.   ;; more work than it's worth...
  86.   (start-itimer "display-time" 'display-time-function
  87.         display-time-interval display-time-interval))
  88.  
  89.  
  90. (defun display-time-function ()
  91.   (let ((time (current-time-string))
  92.     (load (let ((debug-on-error nil) ;fmh
  93.             (stack-trace-on-error nil))
  94.         (condition-case ()
  95.             (if (zerop (car (load-average))) ""
  96.               (let ((str (format " %03d" (car (load-average)))))
  97.             (concat (substring str 0 -2) "." (substring str -2))))
  98.           (error ""))))
  99.     (mail-spool-file (or display-time-mail-file
  100.                  (getenv "MAIL")
  101.                              (concat rmail-spool-directory
  102.                                      (or (getenv "LOGNAME")
  103.                                          (getenv "USER")
  104.                                          (user-login-name)))))
  105.     hour am-pm-flag string)
  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 string
  116.       (concat (format "%d" hour) (substring time 13 16)
  117.           am-pm-flag
  118.           load
  119.           (if (and (file-exists-p mail-spool-file)
  120.                ;; file not empty?
  121.                            (< 0 (nth 7 (file-attributes
  122.                                         (file-chase-links mail-spool-file)))))
  123.               " Mail"
  124.                       "")))
  125.     ;; Append the date if desired.
  126.     (if display-time-day-and-date
  127.     (setq string (concat (substring time 0 11) string)))
  128.     (run-hooks 'display-time-hook)
  129.     (if display-time-echo-area
  130.     (or (> (minibuffer-depth) 0)
  131.         ;; don't stomp echo-area-buffer if reading from minibuffer now.
  132.         (save-excursion
  133.           (save-window-excursion
  134.         (select-window (minibuffer-window))
  135.         (erase-buffer)
  136.         (indent-to (- (screen-width) (length string) 1))
  137.         (insert string)
  138.         (message (buffer-string)))))
  139.       (setq display-time-string string)
  140.       ;; Force redisplay of all buffers' mode lines to be considered.
  141.       (save-excursion (set-buffer (other-buffer)))
  142.       (set-buffer-modified-p (buffer-modified-p))
  143.       ;; Do redisplay right now, if no input pending.
  144.       (sit-for 0))))
  145.  
  146. (provide 'time)
  147.