timer.el 5.49 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; timer.el --- run a function with args at some time in future

;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
root's avatar
root committed

Eric S. Raymond's avatar
Eric S. Raymond committed
5 6
;; Maintainer: FSF

root's avatar
root committed
7 8 9 10
;; 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
Eric S. Raymond's avatar
Eric S. Raymond committed
;; the Free Software Foundation; either version 2, or (at your option)
root's avatar
root committed
12 13 14 15 16 17 18 19 20 21 22
;; 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
;; 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.

Eric S. Raymond's avatar
Eric S. Raymond committed
23 24
;;; Code:

root's avatar
root committed
25 26 27 28 29 30 31 32
(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.")

Jim Blandy's avatar
Jim Blandy committed
root's avatar
root committed
34 35 36
(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.
37 38
TIME, a string, can be specified absolutely or relative to now.
TIME can also be an integer, a number of seconds.
root's avatar
root committed
REPEAT, an integer number of seconds, is the interval on which to repeat
40 41 42 43
the call to the function.  If REPEAT is nil, call it just once.

Absolute times may be specified in a wide variety of formats;
Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where
44 45
all fields are numbers, works; the format used by the Unix `date'
command works too.
46 47 48 49 50 51 52

Relative times may be specified as a series of numbers followed by units:
  1 min         	denotes one minute from now.
  min			does too.
  1 min 5 sec		denotes 65 seconds from now.
  1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year
			denotes the sum of all the given durations from now."
root's avatar
root committed
  (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
54 55 56
  ;; Make TIME a string.
  (if (integerp time)
      (setq time (format "%d sec" time)))
root's avatar
root committed
57 58 59
  (cond ((or (not timer-process) 
             (memq (process-status timer-process) '(exit signal nil)))
         (if timer-process (delete-process timer-process))
60 61
         (setq timer-process (let ((process-connection-type nil))
			       (start-process "timer" nil "timer"))
root's avatar
root committed
62 63 64 65 66 67 68
               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
69 70
  (let* ((token (concat (current-time-string) "-" (length timer-alist)))
	 (elt (list token repeat function args)))
    (process-send-string timer-process (concat time "@" token "\n"))
72 73 74 75 76 77 78 79 80 81
    (setq timer-alist (cons elt timer-alist))

(defun cancel-timer (elt)
  "Cancel a timer previously made with `run-at-time'.
The argument should be a value previously returned by `run-at-time'.
Cancelling the timer means that nothing special 
will happen at the specified time."
  (setcar (cdr elt) nil)
  (setcar (cdr (cdr elt)) 'ignore))
root's avatar
root committed
82 83 84 85 86 87 88 89 90

(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)))
91 92 93 94 95
	(apply (nth 2 do) (nth 3 do))   ; do it
	(if (natnump (nth 1 do))        ; reschedule it
	    (send-string proc (concat (nth 1 do) " sec@" (car do) "\n"))
	  (setq timer-alist (delq do timer-alist))))
Jim Blandy's avatar
Jim Blandy committed
       ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token)
root's avatar
root committed
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
        (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 (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."))
114 115
      ;; Used to set timer-scratch to "", but nothing uses that var.
      (setq timer-process nil timer-alist nil))))
root's avatar
root committed
116 117

(defun cancel-timer (function)
Christopher Zaborsky's avatar
Christopher Zaborsky committed
  "Cancel all events scheduled by `run-at-time' which would run FUNCTION."
root's avatar
root committed
119 120 121 122 123 124 125 126 127
  (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)
Eric S. Raymond's avatar
Eric S. Raymond committed
128 129

;;; timer.el ends here