home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / lisp / time.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  7KB  |  170 lines
  1. ;;; time.el --- display time and load in mode line of Emacs.
  2.  
  3. ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. ;;; Commentary:
  24.  
  25. ;;; Facilities to display current time/date and a new-mail indicator
  26. ;;; in the Emacs mode line.  The single entry point is `display-time'.
  27.  
  28. ;;; Code:
  29.  
  30. (defvar display-time-mail-file nil
  31.   "*File name of mail inbox file, for indicating existence of new mail.
  32. Default is system-dependent, and is the same as used by Rmail.")
  33.  
  34. ;;;###autoload
  35. (defvar display-time-day-and-date nil "\
  36. *Non-nil means \\[display-time] should display day and date as well as time.")
  37.  
  38. (defvar display-time-process nil)
  39.  
  40. (defvar display-time-interval 60
  41.   "*Seconds between updates of time in the mode line.")
  42.  
  43. (defvar display-time-24hr-format nil
  44.   "*Non-nill indicates time should be displayed as hh:mm, 0 <= hh <= 23.
  45. Nil means 1 <= hh <= 12, and an AM/PM suffix is used.")
  46.  
  47. (defvar display-time-string nil)
  48.  
  49. (defvar display-time-hook nil
  50.   "* List of functions to be called when the time is updated on the mode line.")
  51.  
  52. (defvar display-time-server-down-time nil
  53.    "Time when mail file's file system was recorded to be down.
  54. If that file system seems to be up, the value is nil.")
  55.  
  56. ;;;###autoload
  57. (defun display-time ()
  58.   "Display current time, load level, and mail flag in mode line of each buffer.
  59. Updates automatically every minute.
  60. If `display-time-day-and-date' is non-nil, the current day and date
  61. are displayed as well.
  62. After each update, `display-time-hook' is run with `run-hooks'."
  63.   (interactive)
  64.   (let ((live (and display-time-process
  65.            (eq (process-status display-time-process) 'run))))
  66.     (if (not live)
  67.     (progn
  68.       (if display-time-process
  69.           (delete-process display-time-process))
  70.       (or global-mode-string (setq global-mode-string '("")))
  71.       (or (memq 'display-time-string global-mode-string)
  72.           (setq global-mode-string
  73.             (append global-mode-string '(display-time-string))))
  74.       (setq display-time-string "")
  75.       ;; Using a pty is wasteful, and the separate session causes
  76.       ;; annoyance sometimes (some systems kill idle sessions).
  77.       (let ((process-connection-type nil))
  78.         (setq display-time-process
  79.           (start-process "display-time" nil
  80.                  (expand-file-name "wakeup" exec-directory)
  81.                  (int-to-string display-time-interval))))
  82.       (process-kill-without-query display-time-process)
  83.       (set-process-sentinel display-time-process 'display-time-sentinel)
  84.       (set-process-filter display-time-process 'display-time-filter)))))
  85.  
  86. (defun display-time-sentinel (proc reason)
  87.   (or (eq (process-status proc) 'run)
  88.       (setq display-time-string ""))
  89.   ;; Force mode-line updates
  90.   (save-excursion (set-buffer (other-buffer)))
  91.   (set-buffer-modified-p (buffer-modified-p))
  92.   (sit-for 0))
  93.  
  94. (defvar display-time-string-forms
  95.   '((if display-time-day-and-date
  96.         (format "%s %s %s " dayname monthname day)
  97.       "")
  98.     (format "%s:%s%s"
  99.             (if display-time-24hr-format 24-hours 12-hours)
  100.             minutes
  101.             (if display-time-24hr-format "" am-pm))
  102.     load
  103.     (if mail " Mail" ""))
  104.   "*A list of expressions governing display of the time in the mode line.
  105. This expression is a list of expressions that can involve the keywords
  106. `load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
  107. `seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
  108. and `time-zone' all alphabetic strings, and `mail' a true/nil value.
  109.  
  110. For example, the form
  111.  
  112.   '((substring year -2) \"/\" month \"/\" day
  113.     " " 24-hours \":\" minutes \":\" seconds
  114.     (if time-zone \" (\") time-zone (if time-zone \")\")
  115.     (if mail \" Mail\" \"\"))
  116.  
  117. would give mode line times like `94/12/30 21:07:48 (UTC)'.")
  118.  
  119. (defun display-time-filter (proc string)
  120.   (let* ((time (current-time-string))
  121.          (load (condition-case ()
  122.                    (if (zerop (car (load-average))) ""
  123.                      (let ((str (format " %03d" (car (load-average)))))
  124.                        (concat (substring str 0 -2) "." (substring str -2))))
  125.                  (error "")))
  126.          (mail-spool-file (or display-time-mail-file
  127.                               (getenv "MAIL")
  128.                               (concat rmail-spool-directory
  129.                                       (or (getenv "LOGNAME")
  130.                                           (getenv "USER")
  131.                                           (user-login-name)))))
  132.          (mail (and (file-exists-p mail-spool-file)
  133.                     (display-time-file-nonempty-p mail-spool-file)))
  134.          (24-hours (substring time 11 13))
  135.          (hour (string-to-int 24-hours))
  136.          (12-hours (int-to-string (if (> hour 12)
  137.                                       (- hour 12)
  138.                                     (if (= hour 0)
  139.                                         12
  140.                                       hour))))
  141.          (am-pm (if (>= hour 12) "pm" "am"))
  142.          (minutes (substring time 14 16))
  143.          (seconds (substring time 17 19))
  144.          (time-zone (car (cdr (current-time-zone))))
  145.          (day (substring time 8 10))
  146.          (year (substring time 20 24))
  147.          (monthname (substring time 4 7))
  148.          (month
  149.           (cdr
  150.            (assoc
  151.             monthname
  152.             '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4")
  153.               ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8")
  154.               ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
  155.          (dayname (substring time 0 3)))
  156.     (setq display-time-string
  157.           (mapconcat 'eval display-time-string-forms "")))
  158.   (run-hooks 'display-time-hook)
  159.   ;; Force redisplay of all buffers' mode lines to be considered.
  160.   (save-excursion (set-buffer (other-buffer)))
  161.   (set-buffer-modified-p (buffer-modified-p))
  162.   ;; Do redisplay right now, if no input pending.
  163.   (sit-for 0))
  164.  
  165. (defun display-time-file-nonempty-p (file)
  166.   (and (file-exists-p file)
  167.        (< 0 (nth 7 (file-attributes (file-chase-links file))))))
  168.  
  169. ;;; time.el ends here
  170.