Initial revision

2 files changed, 247 insertions, 0 deletions

diff --git a/lib-src/timer.c b/lib-src/timer.c
new file mode 100644
index 00000000000..3af3210f7d0
--- /dev/null
+++ b/lib-src/timer.c
@@ -0,0 +1,155 @@
+#include <stdio.h>
+#include <signal.h>
+#include <fcntl.h>      /* FASYNC */
+#ifdef USG              /* FASYNC for SysV */
+#include <sys/file.h>
+#endif
+#include <sys/time.h>   /* itimer */
+#include <sys/types.h>  /* time_t */
+
+extern int errno;
+extern char *sys_errlist[], *malloc();
+extern time_t time();
+
+#define MAXEVENTS 256
+#define FS 1           /* field seperator for input */
+
+struct event {
+  char *token;
+  time_t reply_at;
+} *events[MAXEVENTS];
+
+int slot;         /* The next open place in the events array */
+int mevent = 0;   /* 1+ the highest event number */
+char *pname;      /* programme name for error messages */
+
+/* Accepts a string of two fields seperated by a ';'
+ * First field is string for getdate, saying when to wake-up.
+ * Second field is a token to identify the request.
+ */
+struct event *
+schedule(str)
+     char *str;
+
+{
+  extern time_t getdate();
+  extern char *strcpy();
+  time_t now;
+  register char *p;
+  static struct event e;
+
+  for(p = str; *p && *p != FS; p++);
+  if (!*p) {
+    (void)fprintf(stderr, "%s: bad input format: %s", pname, str);
+    return((struct event *)NULL);
+  }
+  *p++ = 0;
+  
+  if ((e.reply_at = getdate(str, NULL)) - time(&now) < 0) {
+    (void)fprintf(stderr, "%s: bad time spec: %s%c%s", pname, str, FS, p);
+    return((struct event *)NULL);
+  }
+
+  if ((e.token = malloc((unsigned)strlen(p) + 1)) == NULL) {
+    (void)fprintf(stderr, "%s: malloc %s: %s%c%s",
+                  pname, sys_errlist[errno], str, FS, p);
+    return((struct event *)NULL);
+  }
+  (void)strcpy(e.token,p);
+
+  return(&e);
+}
+
+void
+notify()
+
+{
+  time_t now, tdiff;
+  register int i, newmax = 0;
+  /* I prefer using the interval timer rather than alarm(); the latter
+     could be substituted if portability requires it. */
+  struct itimerval itimer;
+
+  now = time((time_t *)NULL);
+  slot = mevent;
+  itimer.it_interval.tv_sec = itimer.it_interval.tv_usec = 0;
+  itimer.it_value.tv_usec = 0;
+  itimer.it_value.tv_sec = -1;
+
+  for(i=0; i < mevent; i++) {
+    while (events[i] && events[i]->reply_at <= now) {
+      (void)fputs(events[i]->token, stdout);
+      free(events[i]->token);
+      free((char *)events[i]);
+      events[i] = 0;
+    }
+
+    if (events[i]) {
+      newmax = i+1;
+      if ((tdiff = events[i]->reply_at - now) < (time_t)itimer.it_value.tv_sec
+          || itimer.it_value.tv_sec < 0)
+        /* next timeout */
+        itimer.it_value.tv_sec = (long)tdiff;
+    } else {
+      /* Keep slot as the lowest unused events element */
+      if (i < slot) slot = i;
+    }
+  }
+  /* if the array is full to mevent, slot should be the next available spot */
+  if (slot > (mevent = newmax)) slot = mevent;
+  /* If there's no more events, SIGIO should be next wake-up */
+  if (mevent) (void)setitimer(ITIMER_REAL, &itimer, (struct itimerval *)NULL);
+}
+
+void
+getevent()
+
+{
+  extern char *memcpy(), *fgets();
+  struct event *ep;
+  char buf[256];
+
+  /* in principle the itimer should be disabled on entry to this function,
+     but it really doesn't make any important difference if it isn't */
+
+  if (fgets(buf, sizeof(buf), stdin) == NULL) exit(0);
+
+  if (slot == MAXEVENTS)
+    (void)fprintf(stderr, "%s: too many events: %s", pname, buf);
+
+  else {
+    if ((events[slot] = (struct event *)malloc((sizeof(struct event))))
+        == NULL)
+      (void)fprintf(stderr,"%s: malloc %s: %s", pname, sys_errlist[errno],buf);
+
+    else {
+      if ((ep = schedule(buf)) == NULL)
+        free((char *)events[slot]), events[slot] = 0;
+
+      else {
+        (void)memcpy((char *)events[slot],(char *)ep,sizeof(struct event));
+        if (slot == mevent) mevent++;
+      } /* schedule */
+    } /* malloc */
+  } /* limit events */
+  /* timing, timing.  Who knows what this interrupted, or if it said "now"? */
+  notify();
+}
+ 
+/*ARGSUSED*/
+int
+main(argc, argv)
+     int argc;
+     char **argv;
+
+{
+  for (pname = argv[0] + strlen(argv[0]); *pname != '/' && pname != argv[0];
+       pname--);
+  if (*pname == '/') pname++;
+
+  (void)signal(SIGIO, getevent);
+  (void)signal(SIGALRM, notify);
+  (void)fcntl(0, F_SETFL, FASYNC);
+
+  while (1) pause();
+}
diff --git a/lisp/timer.el b/lisp/timer.el
new file mode 100644
index 00000000000..7f71f784de9
--- /dev/null
+++ b/lisp/timer.el
@@ -0,0 +1,92 @@
+;; Run a function with args at some time in future
+;; Copyright (C) 1990 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(defvar timer-process nil)
+(defvar timer-alist ())
+(defvar timer-out "")
+(defvar timer-dont-exit nil
+  ;; this is useful for functions which will be doing their own erratic
+  ;; rescheduling or people who otherwise expect to use the process frequently
+  "If non-nil, don't exit the timer process when no more events are pending.")
+
+(defun run-at-time (time repeat function &rest args)
+  "Run a function at a time, and optionally on a regular interval.
+Arguments are TIME, REPEAT, FUNCTION &rest ARGS.
+TIME, a string,  can be specified absolutely or relative to now.
+REPEAT, an integer number of seconds, is the interval on which to repeat
+the call to the function."
+  (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
+  (cond ((or (not timer-process) 
+             (memq (process-status timer-process) '(exit signal nil)))
+         (if timer-process (delete-process timer-process))
+         (setq timer-process (start-process "timer" nil "timer")
+               timer-alist nil)
+         (set-process-filter   timer-process 'timer-process-filter)
+         (set-process-sentinel timer-process 'timer-process-sentinel)
+         (process-kill-without-query timer-process))
+        ((eq (process-status timer-process) 'stop)
+         (continue-process timer-process)))
+  ;; There should be a living, breathing timer process now
+  (let ((token (concat (current-time-string) "-" (length timer-alist))))
+    (send-string timer-process (concat time "\001" token "\n"))
+    (setq timer-alist (cons (list token repeat function args) timer-alist))))
+
+(defun timer-process-filter (proc str)
+  (setq timer-out (concat timer-out str))
+  (let (do token error)
+    (while (string-match "\n" timer-out)
+      (setq token (substring timer-out 0 (match-beginning 0))
+            do (assoc token timer-alist)
+            timer-out (substring timer-out (match-end 0)))
+      (cond
+       (do (apply (nth 2 do) (nth 3 do))   ; do it
+           (if (natnump (nth 1 do))        ; reschedule it
+               (send-string proc (concat (nth 1 do) " sec\001" (car do) "\n"))
+             (setq timer-alist (delq do timer-alist))))
+       ((string-match "timer: \\([^:]+\\): \\([^\001]*\\)\001\\(.*\\)$" token)
+        (setq error (substring token (match-beginning 1) (match-end 1))
+              do    (substring token (match-beginning 2) (match-end 2))
+              token (assoc (substring token (match-beginning 3) (match-end 3))
+                           timer-alist)
+              timer-alist (delq token timer-alist))
+        (ding 'no-terminate) ; using error function in process filters is rude
+        (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do))))
+    (or timer-alist timer-dont-exit (process-send-eof proc))))
+
+(defun timer-process-sentinel (proc str)
+  (let ((stat (process-status proc)))
+    (if (eq stat 'stop) (continue-process proc)
+      ;; if it exited normally, presumably it was intentional.
+      ;; if there were no pending events, who cares that it exited?
+      (if (or (not timer-alist) (eq stat 'exit)) ()
+        (ding 'no-terminate)
+        (message "Timer exited abnormally.  All events cancelled."))
+      (setq timer-process nil timer-alist nil timer-scratch ""))))
+
+(defun cancel-timer (function)
+  "Cancel all events scheduled by ``run-at-time'' which would run FUNCTION."
+  (interactive "aCancel function: ")
+  (let ((alist timer-alist))
+    (while alist
+      (if (eq (nth 2 (car alist)) function)
+          (setq timer-alist (delq (car alist) timer-alist)))
+      (setq alist (cdr alist))))
+  (or timer-alist timer-dont-exit (process-send-eof timer-process)))
+
+(provide 'timer)