Path: utzoo!utgpu!jarvis.csri.toronto.edu!cs.utexas.edu!wuarchive!decwrl!ucbvax!UUNET.UU.NET!kjones%talos
From: kjones%talos@UUNET.UU.NET (Kyle Jones)
Newsgroups: comp.emacs
Subject: interval timers for GNU Emacs
Message-ID: <8911282119.AA12476@talos.uu.net>
Date: 28 Nov 89 21:19:20 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Lines: 723

This is a re-release of `timer', a package that provides interval timers
under GNU Emacs Lisp.  This is not a user interface, but rather a
library of functions for Emacs-Lisp programmers to use in other
applications.

No modification of the Emacs sources is required; all function are in
Lisp and a short C program is used to access the system clock.  A demo
program is provided that shows how the timers might be used.

If you grabbed `timer" the first time it was posted and applied the
patch that I sent out shortly thereafter, you can safely ignore this
posting.  There have been no changes to the code since then, however the
documentation has been tweaked in some places for clarity.

Enjoy,

kyle jones   <kjones@talos.uu.net>   ...!uunet!talos!kjones
----------------------------------
#!/bin/sh
# shar:	Shell Archiver  (v1.22)
#
#	Run the following text with /bin/sh to create:
#	  timer.el
#	  timer.c
#	  README
#	  ntime.el
#
sed 's/^X//' << 'SHAR_EOF' > timer.el &&
X;;; Interval timers for GNU Emacs
X;;; Copyright (C) 1988 Kyle E. Jones
X;;;
X;;; Verbatim copies of this file may be freely redistributed.
X;;;
X;;; Modified versions of this file may be redistributed provided that this
X;;; notice remains unchanged, the file contains prominent notice of
X;;; author and time of modifications, and redistribution of the file
X;;; is not further restricted in any way.
X;;;
X;;; This file is distributed `as is', without warranties of any kind.
X
X(provide 'timer)
X
X;; `timer' feature means Emacs-Lisp programers get:
X;;    timerp, timer-value, timer-restart, timer-function,
X;;    set-timer-value, set-timer-restart, set-timer-function
X;;    get-timer, start-timer, read-timer, delete-timer
X;;
X;; Interactive users get these commands:
X;;    edit-timers, list-timers, start-timer
X;;
X;; See the doc strings of these functions for more information.
X
X(defvar timer-list nil
X  "List of all active timers.")
X
X(defvar timer-process nil
X  "Process that drives all timers.")
X
X;; This value is maintained internally; it does not determine timer
X;; granularity.  Timer granularity is 1 second, plus delays due to
X;; system and Emacs internal activity that delay dealing with process
X;; output.
X(defvar timer-process-next-wakeup 1
X  "Timer process will wakeup to service running timers within this
Xmany seconds.")
X
X(defvar timer-edit-map nil
X  "Keymap used when in Timer Edit mode.")
X
X(if timer-edit-map
X    ()
X  (setq timer-edit-map (make-sparse-keymap))
X  (define-key timer-edit-map "s" 'timer-edit-set-field)
X  (define-key timer-edit-map "d" 'timer-edit-delete-timer)
X  (define-key timer-edit-map "q" 'timer-edit-quit)
X  (define-key timer-edit-map "\t" 'timer-edit-next-field)
X  (define-key timer-edit-map " " 'next-line)
X  (define-key timer-edit-map "n" 'next-line)
X  (define-key timer-edit-map "p" 'previous-line)
X  (define-key timer-edit-map "\C-?" 'timer-edit-previous-field)
X  (define-key timer-edit-map "x" 'start-timer)
X  (define-key timer-edit-map "?" 'timer-edit-help))
X  
X(defvar timer-edit-start-marker nil)
X
X;; macros must come first... or byte-compile'd code will throw back its
X;; head and scream.
X
X(defmacro decrement (variable)
X  (list 'setq variable (list '1- variable)))
X
X(defmacro increment (variable)
X  (list 'setq variable (list '1+ variable)))
X
X(defmacro signum (n)
X  (list 'if (list '> n 0) 1
X    (list 'if (list 'zerop n) 0 -1)))
X
X;; Timer access functions should behave as if they were subrs.  These
X;; macros are used to check the arguments to the timer functions and
X;; signal errors appropriately if the arguments are not valid.
X
X(defmacro check-timer (var)
X  "If VAR is not bound to a timer, signal wrong-type-argument.
XThis is a macro."
X  (list 'setq var
X	(list 'if (list 'timerp var) var
X	      (list 'signal ''wrong-type-argument
X		    (list 'list ''timerp var)))))
X
X(defmacro check-timer-coerce-string (var)
X  "If VAR is not bound to a string, look up the timer that it names and
Xbind VAR to it.  Otherwise if VAR is not bound to a timer, signal
Xwrong-type-argument.  This is a macro."
X  (list 'setq var
X	(list 'cond
X	      (list (list 'timerp var) var)
X	      (list (list 'stringp var) (list 'get-timer var))
X	      (list t (list 'signal ''wrong-type-argument
X			    (list 'list ''string-or-timer-p var))))))
X
X(defmacro check-number (var)
X  "If VAR is not bound to a number, signal wrong-type-argument.
XThis is a macro."
X  (list 'setq var
X	(list 'if (list 'numberp var) var
X	      (list 'signal ''wrong-type-argument
X		    (list 'list ''numberp var)))))
X
X(defmacro check-string (var)
X  "If VAR is not bound to a string, signal wrong-type-argument.
XThis is a macro."
X  (list 'setq var
X	(list 'if (list 'stringp var) var
X	      (list 'signal ''wrong-type-argument
X		    (list 'list ''stringp var)))))
X
X;; Functions to access and modify timer attributes.
X
X(defun timerp (obj)
X  "Returns non-nil iff OBJ is a timer."
X  (and (consp obj) (stringp (car obj)) (eq (length obj) 4)))
X
X(defun timer-name (timer)
X  "Returns the name of TIMER."
X  (check-timer timer)
X  (car timer))
X
X(defun timer-value (timer)
X  "Returns the number of seconds until TIMER expires."
X  (check-timer timer)
X  (nth 1 timer))
X
X(defun timer-restart (timer)
X  "Returns the value to which TIMER will be set at restart.
Xnil is returned if this timer doesn't restart."
X  (check-timer timer)
X  (nth 2 timer))
X
X(defun timer-function (timer)
X  "Returns the function of TIMER.
XThis function is called each time TIMER expires."
X  (check-timer timer)
X  (nth 3 timer))
X
X(defun set-timer-value (timer value &optional nowakeup)
X  "Set the timeout value of TIMER to be VALUE.
XTimer will expire is this many seconds.
XReturns VALUE."
X;; Optional third arg NOWAKEUP non-nil means do not wakeup the timer
X;; process to recompute a correct wakeup time, even if it means this
X;; timer will expire late.  timer-process-filter uses this option.
X;; This is not meant for ordinary usage, which is why it is not
X;; mentioned in the doc string.
X  (check-timer timer)
X  (check-number value)
X  (let ((inhibit-quit t))
X    ;; If we're allowed to wakeup the timer process,
X    ;; and the timer process's next wakeup needs to be recomputed,
X    ;; and the timer is running, then we wakeup the timer process.
X    (or (and (not nowakeup) (< value timer-process-next-wakeup)
X	     (get-timer (timer-name timer))
X	     (progn (timer-process-wakeup)
X		    (setcar (cdr timer) value)
X		    (timer-process-wakeup)))
X	(setcar (cdr timer) value))
X    value))
X
X(defun set-timer-restart (timer restart)
X  "Set the restart value of TIMER to be RESTART.
XIf RESTART is nil, TIMER is will not restart when it expires.
XReturns RESTART."
X  (check-timer timer)
X  (if restart (check-number restart))
X  (and restart (< restart 1) (signal 'args-out-of-range (list restart)))
X  (setcar (cdr (cdr timer)) restart))
X
X(defun set-timer-function (timer function)
X  "Set the function of TIMER to be FUNCTION.
XFUNCTION will be called when timer expires.
XReturns FUNCTION."
X  (check-timer timer)
X  (setcar (cdr (cdr (cdr timer))) function))
X
X(defun get-timer (name)
X  "Return timer named NAME, or nil if there is none."
X  (check-string name)
X  (assoc name timer-list))
X
X(defun read-timer (prompt &optional initial-input)
X  "Read the name of a timer from the minibuffer and return the timer
Xassociated with that name.  The user is prompted with PROMPT.
XOptional second arg INITIAL-INPUT non-nil is inserted into the
X  minibuffer as initial user input."
X  (get-timer (completing-read prompt timer-list nil 'confirm initial-input)))
X
X(defun delete-timer (timer)
X  "Deletes TIMER.  TIMER may be a timer or the name of one."
X  (check-timer-coerce-string timer)
X  (setq timer-list (delq timer timer-list)))
X
X(defun start-timer (name function value &optional restart)
X  "Start a timer.
XArgs are NAME, FUNCTION, VALUE &optional RESTART.
XNAME is an identifier for the timer.  It must be a string.  If a timer
X  already exists with this name, NAME will be modified slightly to until
X  it is unique.
XFUNCTION should be a function (or symbol naming one) of no arguments.  It
X  will be called each time the timer expires.  The function can access
X  timer that invoked it through the variable `current-timer'.
XVALUE is the number of seconds until this timer expires.
XOptional fourth arg RESTART non-nil means that this timer should be
X  restarted automatically after its function is called.  Normally a timer
X  is deleted at expiration after its function has returned. 
X  If non-nil RESTART should be a number indicating the value at which the
X  timer should be set at restart time.
XReturns the newly created timer."
X  (interactive
X   (list (completing-read "Start timer: " timer-list)
X	 (read (completing-read "Timer function: " obarray 'fboundp))
X	 (let (value)
X	   (while (not (numberp value))
X	     (setq value (read-from-minibuffer "Timer value: " nil nil t)))
X	   value)
X	 (let ((restart t))
X	   (while (and restart (not (numberp restart)))
X	     (setq restart (read-from-minibuffer "Timer restart: " nil nil t)))
X	   restart)))
X  (check-string name)
X  (check-number value)
X  (if restart (check-number restart))
X  ;; Make proposed timer name unique if it's not already.
X  (let ((oname name)
X	(num 2))
X    (while (get-timer name)
X      (setq name (concat oname "<" num ">"))
X      (increment num)))
X  ;; If there's no timer process, start one now.
X  ;; Otherwise wake up the timer process so that seconds slept before
X  ;; the new timer is created won't be counted against it.
X  (if timer-process
X      (timer-process-wakeup)
X    (timer-process-start))
X  (let ((inhibit-quit t))
X    ;; add the timer to the global list
X    (setq timer-list
X	  (cons (list name value restart function)
X		timer-list))
X    ;; If the timer process is scheduled to wake up too late for the timer
X    ;; we wake it up to calculate a correct wakeup value giving consideration
X    ;; to the newly added timer.
X    (if (< value timer-process-next-wakeup)
X	(timer-process-wakeup)))
X  (car timer-list))
X
X;; User level functions to list and modify existing timers.
X;; Timer Edit major mode, and the editing commands thereof.
X
X(defun list-timers ()
X  "Pop up a buffer containing a list of all timers.
XThe major mode of the buffer is Timer Edit mode.  This major mode provides
Xcommands to manipulate timers; see the documentation for
X`timer-edit-mode' for more information."
X  (interactive)
X  (let* ((buf (get-buffer-create "*Timer List*"))
X	 (opoint (point))
X	 (standard-output buf)
X	 (timers (reverse timer-list)))
X    (set-buffer buf)
X    (timer-edit-mode)
X    (setq buffer-read-only nil)
X    (erase-buffer)
X    (insert "Name                  Value     Restart   Function\n"
X	    "----                  -----     -------   --------")
X    (if (null timer-edit-start-marker)
X	(setq timer-edit-start-marker (point)))
X    (while timers
X      (newline 1)
X      (prin1 (timer-name (car timers)))
X      (tab-to-tab-stop)
X      (prin1 (timer-value (car timers)))
X      (tab-to-tab-stop)
X      (prin1 (timer-restart (car timers)))
X      (tab-to-tab-stop)
X      (prin1 (timer-function (car timers)))
X      (setq timers (cdr timers)))
X    ;; restore point
X    (goto-char opoint)
X    (if (< (point) timer-edit-start-marker)
X	(goto-char timer-edit-start-marker))
X    (setq buffer-read-only t)
X    (display-buffer buf)))
X
X(defun edit-timers ()
X  "Display a list of all timers and select it for editing.
XThe major mode of the buffer containing the listing is Timer Edit mode.
XThis major mode provides commands to manipulate timers; see the documentation
Xfor `timer-edit-mode' for more information."
X  (interactive)
X  ;; since user is editing, make sure displayed data is reasonably up-to-date
X  (if timer-process
X      (timer-process-wakeup))
X  (list-timers)
X  (select-window (get-buffer-window "*Timer List*"))
X  (goto-char timer-edit-start-marker)
X  (if timer-list
X      (progn
X	(forward-sexp 2)
X	(backward-sexp)))
X  (message "type q to quit, ? for help"))
X
X;; no point in making this interactive.
X(defun timer-edit-mode ()
X  "Major mode for manipulating timers.
XAtrributes of running timers are changed by moving the cursor to the
Xdesired field and typing `s' to set that field.  The field will then be
Xset to the value read from the minibuffer.
X
XCommands:
XTAB    move forward a field
XDEL    move backward a field
Xs      set a field
Xd      delete the selected timer
Xx      start a new timer
X?      help"
X  (kill-all-local-variables)
X  (make-local-variable 'tab-stop-list)
X  (setq major-mode 'timer-edit-mode
X	mode-name "Timer Edit"
X	truncate-lines t
X	tab-stop-list '(22 32 42))
X  (abbrev-mode 0)
X  (auto-fill-mode 0)
X  (buffer-flush-undo (current-buffer))
X  (use-local-map timer-edit-map)
X  (set-syntax-table lisp-mode-syntax-table))
X
X(put 'timer-edit-mode 'mode-class 'special)
X
X(defun timer-edit-help ()
X  "Help function for Timer Edit."
X  (interactive)
X  (if (eq last-command 'timer-edit-help)
X      (describe-mode)
X    (message "TAB, DEL select fields, (s)et field, (d)elete timer   (type ? for more help)")))
X
X(defun timer-edit-quit ()
X  "End Timer Edit."
X  (interactive)
X  (bury-buffer (current-buffer))
X  (if (one-window-p t)
X      (switch-to-buffer (other-buffer (current-buffer)))
X    (delete-window)))
X
X(defun timer-edit-set-field ()
X  (interactive)
X  ;; First two lines in list buffer are headers.
X  ;; Cry out against the luser who attempts to change a field there.
X  (if (<= (point) timer-edit-start-marker)
X      (error ""))
X  ;; field-value must be initialized to be something other than a
X  ;; number, symbol, or list.
X  (let (timer field (field-value ""))
X    (setq timer (save-excursion
X		  ;; read the name of the timer from the beginning of
X		  ;; the current line.
X		  (beginning-of-line)
X		  (get-timer (read (current-buffer))))
X	  field (save-excursion
X		  (timer-edit-beginning-of-field)
X		  (let ((opoint (point))
X			(n 0))
X		    ;; count the number of sexprs until we reach the cursor
X		    ;; and use this info to determine which field the user
X		    ;; wants to modify.
X		    (beginning-of-line)
X		    (while (and (>= opoint (point)) (< n 4))
X		      (forward-sexp 2)
X		      (backward-sexp)
X		      (increment n))
X		    (cond ((eq n 1) (error "Cannot change timer name."))
X			  ((eq n 2) 'value)
X			  ((eq n 3) 'restart)
X			  ((eq n 4) 'function)))))
X    (cond ((eq field 'value)
X	   (let ((prompt "Set timer value: "))
X	     (while (not (numberp field-value))
X	       (setq field-value (read-from-minibuffer prompt nil nil t)))))
X	  ((eq field 'restart)
X	   (let ((prompt "Set timer restart: "))
X	     (while (and field-value (not (numberp field-value)))
X	       (setq field-value (read-from-minibuffer prompt nil nil t)))))
X	  ((eq field 'function)
X	   (let ((prompt "Set timer function: "))
X	     (while (not (or (and (symbolp field-value) (fboundp field-value))
X			     (and (consp field-value)
X				  (memq (car field-value) '(lambda macro)))))
X	       (setq field-value
X		     (read (completing-read prompt obarray 'fboundp nil)))))))
X    ;; set the timer field
X    (funcall (intern (concat "set-timer-" (symbol-name field)))
X	     timer field-value)
X    ;; move to beginning of field to be changed
X    (timer-edit-beginning-of-field)
X    ;; modify the list buffer to reflect the change.
X    (let (buffer-read-only kill-ring)
X      (kill-sexp 1)
X      (kill-region (point) (progn (skip-chars-forward " \t") (point)))
X      (prin1 field-value (current-buffer))
X      (if (not (eolp))
X	  (tab-to-tab-stop))
X      (backward-sexp))))
X
X(defun timer-edit-delete-timer ()
X  (interactive)
X  ;; First two lines in list buffer are headers.
X  ;; Cry out against the luser who attempts to change a field there.
X  (if (<= (point) timer-edit-start-marker)
X      (error ""))
X  (delete-timer
X   (read-timer "Delete timer: "
X	       (save-excursion (beginning-of-line) (read (current-buffer)))))
X  ;; update list information
X  (list-timers))
X
X(defun timer-edit-next-field (count)
X  (interactive "p")
X  (timer-edit-beginning-of-field)
X  (cond ((> (signum count) 0)
X	 (while (not (zerop count))
X	   (forward-sexp)
X	   ;; wrap from eob to timer-edit-start-marker
X	   (if (eobp)
X	       (progn
X		 (goto-char timer-edit-start-marker)
X		 (forward-sexp)))
X	   (forward-sexp)
X	   (backward-sexp)
X	   ;; treat fields at beginning of line as if they weren't there.
X	   (if (bolp)
X	       (progn
X		 (forward-sexp 2)
X		 (backward-sexp)))
X	   (decrement count)))
X	((< (signum count) 0)
X	 (while (not (zerop count))
X	   (backward-sexp)
X	   ;; treat fields at beginning of line as if they weren't there.
X	   (if (bolp)
X	       (backward-sexp))
X	   ;; wrap from timer-edit-start-marker to field at eob.
X	   (if (<= (point) timer-edit-start-marker)
X	       (progn
X		 (goto-char (point-max))
X		 (backward-sexp)))
X	   (increment count)))))
X
X(defun timer-edit-previous-field (count)
X  (interactive "p")
X  (timer-edit-next-field (- count)))
X
X(defun timer-edit-beginning-of-field ()
X  (let ((forw-back (save-excursion (forward-sexp) (backward-sexp) (point)))
X	(back (save-excursion (backward-sexp) (point))))
X    (cond ((eq forw-back back) (backward-sexp))
X	  ((eq forw-back (point)) t)
X	  (t (backward-sexp)))))
X
X
X;; internals of the timer implementation.
X
X(defun timer-process-filter (process string)
X  ;; if there are no active timers, return quickly.
X  (if timer-list
X      (let ((time-elapsed (read string))
X	    (timers timer-list)
X	    (timer)
X	    ;; process filters can be hit by stray C-g's from the user,
X	    ;; so we must protect this stuff appropriately.
X	    ;; Quit's are allowed from within timer functions, but we
X	    ;; catch them.
X	    (inhibit-quit t))
X	(setq timer-process-next-wakeup 600)
X	(while timers
X	  (setq timer (car timers))
X	  (set-timer-value timer (- (timer-value timer) time-elapsed) t)
X	  (if (> (timer-value timer) 0)
X	      (setq timer-process-next-wakeup
X		    (min timer-process-next-wakeup (timer-value timer)))
X	    ;; timer has expired, we must call its function.
X	    ;; protect our local vars from the timer function.
X	    ;; allow keyboard quit to occur, but catch and report it.
X	    ;; provide the variable `current-timer' in case the function
X	    ;; is interested.
X	    (condition-case condition-data
X		(let* ((current-timer timer)
X		       timer timers time-elapsed
X		       quit-flag inhibit-quit)
X		  (funcall (timer-function current-timer)))
X	      (error (message "timer \"%s\" signaled: %s" (timer-name timer)
X			      (prin1-to-string condition-data)))
X	      (quit (message "timer \"%s\" quit" (timer-name timer))))
X	    ;; restart the timer if we should, otherwise delete it.
X	    (if (null (timer-restart timer))
X		(delete-timer timer)
X	      (set-timer-value timer (timer-restart timer) t)
X	      (setq timer-process-next-wakeup
X		    (min timer-process-next-wakeup (timer-value timer)))))
X	  (setq timers (cdr timers)))
X	;; if user is editing timers, update displayed info
X	(if (eq major-mode 'timer-edit-mode)
X	    (list-timers)))
X    (setq timer-process-next-wakeup 600))
X    ;; tell timer-process when to wakeup again
X    (process-send-string timer-process
X			 (concat (int-to-string timer-process-next-wakeup)
X				 "\n")))
X
X(defun timer-process-sentinel (process message)
X  (let ((inhibit-quit t))
X    (if (eq (process-status process) 'stop)
X	(continue-process process)
X      ;; not stopped, so it must have died.
X      ;; cleanup first...
X      (delete-process process)
X      (setq timer-process nil)
X      ;; now, if there are any active timers then we need to immediately
X      ;; start another timer process, otherwise we can wait until the next
X      ;; start-timer call,  which will start one automatically.
X      (if (null timer-list)
X	  ()
X;;;     (message "timer process %s... respawning." (substring message 0 -1))
X	(timer-process-start)))))
X
X(defun timer-process-start ()
X  (let ((inhibit-quit t)
X	(process-connection-type nil))
X    (setq timer-process (start-process "timer" nil "timer"))
X    (process-kill-without-query timer-process)
X    (set-process-filter timer-process 'timer-process-filter)
X    (set-process-sentinel timer-process 'timer-process-sentinel)
X    ;; Tell timer process to wake up quickly, so that a correct wakeup
X    ;; time can be computed.  Zero instead of one here loses because of
X    ;; underlying timer implementations that use 0 to mean `disable the
X    ;; timer'.
X    (setq timer-process-next-wakeup 1)
X    (process-send-string timer-process "1\n")))
X
X(defun timer-process-wakeup ()
X  (interrupt-process timer-process)
X  (accept-process-output))
SHAR_EOF
chmod 0664 timer.el || echo "restore of timer.el fails"
sed 's/^X//' << 'SHAR_EOF' > timer.c &&
X/*
X * Timer program for GNU Emacs timer implementation.
X * Copyright (C) 1988 Kyle E. Jones
X *
X * Verbatim copies of this file may be freely redistributed.
X *
X * Modified versions of this file may be redistributed provided that this
X * notice remains unchanged, the file contains prominent notice of
X * author and time of modifications, and redistribution of the file
X * is not further restricted in any way.
X *
X * This file is distributed `as is', without warranties of any kind.
X */
X
X/*
X * #define USG if this is a System V system.
X */
X
X#include <stdio.h>
X#include <signal.h>
X
X#define boolean char
X#define TRUE 1
X#define FALSE 0
X
Xboolean signaled = FALSE;
X
Xwakeup()
X{
X#ifdef USG
X    (void) signal(SIGINT, wakeup);
X    (void) signal(SIGALRM, wakeup);
X#endif
X    signaled = TRUE;
X}
X
Xmain()
X{
X    unsigned sleeptime;
X    long time(), lastwakeup, now;
X    char timebuf[20];
X
X    (void) signal(SIGINT, wakeup);
X    (void) signal(SIGALRM, wakeup);
X
X    (void) time(&lastwakeup);
X
X    /*
X     * 1. read the number of seconds to sleep frmo stdin.
X     * 2. sleep until a SIGALRM or SIGINT arrives.
X     * 3. report the number of seconds actually slept to stdout.
X     * 4. repeat...
X     */
X    while (1) {
X	/* read the number of seconds we should sleep */
X	(void) gets(timebuf);
X	sleeptime = atoi(timebuf);
X	(void) alarm(sleeptime);
X	/* sleep if no signal received since last wakeup */
X	if (! signaled)
X	  (void) pause();
X	signaled = FALSE;
X	/* report the number of seocnds we actually slept */
X	(void) time(&now);
X	(void) sprintf(timebuf, "%d", now - lastwakeup);
X	(void) fputs(timebuf, stdout);
X	(void) fflush(stdout);
X	lastwakeup = now;
X    }
X}
SHAR_EOF
chmod 0664 timer.c || echo "restore of timer.c fails"
sed 's/^X//' << 'SHAR_EOF' > README &&
X								-*-Text-*-
XByte-compile the file timer.el and install it in a Lisp library.
X
XC compile the file timer.c and install the resulting executable in one
Xof the directories in your (or Emacs') search path.  The executable
Xshould be named `timer'.  Use -DUSG if running under System V.  I
Xcouldn't test the code under System V.
X
XA simple example of timer usage appears in the file ntime.el, which
Xcontains a no-frills rewrite of Emacs' time.el.
SHAR_EOF
chmod 0664 README || echo "restore of README fails"
sed 's/^X//' << 'SHAR_EOF' > ntime.el &&
X;; Simple implementation of mode-line/echo-area clock, using timers.
X
X(require 'timer)
X
X(defvar display-time-interval 60
X  "*Number of secods between update of the clock display.")
X
X(defvar display-time-echo-area nil
X  "*Non-nil value means the clock should be displayed in the message echo area,
Xinstead of the mode line.")
X
X(defvar display-time-day-and-date nil
X  "*Non-nil value means the day and date should be displayed along with the
Xusual time of day.")
X
X(defun display-time ()
X  "Display time of day in the mode line or echo area."
X  (interactive)
X  ;; if the "display-time" timer already exists, do nothing.
X  (if (get-timer "display-time")
X      ()
X    ;; If we're not displaying the time in the echo area
X    ;; and the global mode string does not have a non-nil value
X    ;; then initialize the global mode string's value.
X    (or display-time-echo-area
X	global-mode-string
X	(setq global-mode-string '("")))
X    ;; If we're not displaying the time in the echo area
X    ;; and our display variable is not part of the global-mode-string list
X    ;; the we add our variable to the list.  This will make the time
X    ;; appear on the modeline.
X    (or display-time-echo-area
X	(memq 'display-time-string global-mode-string)
X	(setq global-mode-string
X	      (append global-mode-string '(display-time-string))))
X    ;; Display the time initially...
X    (display-time-function)
X    ;; ... and start a timer to do it automatically thereafter.
X    (start-timer "display-time" 'display-time-function
X		 display-time-interval display-time-interval)))
X
X(defun display-time-function ()
X  (let (string)
X    ;; display the day and date if the user requests it.
X    (setq string (substring (current-time-string)
X			    (if display-time-day-and-date 0 11) -8))
X    ;; stuff the time in the echo area if specified,
X    ;; otherwise put it in the modeline, via display-time-string
X    ;; and global-mode-string.
X    (if display-time-echo-area
X	(if (zerop (minibuffer-depth))
X	    (save-excursion
X	      (set-buffer (window-buffer (minibuffer-window)))
X	      (erase-buffer)
X	      (indent-to (- (screen-width) (length string) 1))
X	      (insert string)))
X      (setq display-time-string string)
X      ;; voodoo to fake Emacs into recalculating the mode line displays.
X      (save-excursion (set-buffer (other-buffer)))
X      (set-buffer-modified-p (buffer-modified-p)))))
SHAR_EOF
chmod 0664 ntime.el || echo "restore of ntime.el fails"
exit 0


Brought to you by Super Global Mega Corp .com