![[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.