![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to time.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to time.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 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))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.