1;;; timer.el --- run a function with args at some time in future 2 3;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. 4 5;; Maintainer: FSF 6 7;; This file is part of GNU Emacs. 8 9;; GNU Emacs is free software; you can redistribute it and/or modify 10;; it under the terms of the GNU General Public License as published by 11;; the Free Software Foundation; either version 2, or (at your option) 12;; any later version. 13 14;; GNU Emacs is distributed in the hope that it will be useful, 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17;; GNU General Public License for more details. 18 19;; You should have received a copy of the GNU General Public License 20;; along with GNU Emacs; see the file COPYING. If not, write to 21;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22 23;;; Commentary: 24 25;; This package gives you the capability to run Emacs Lisp commands at 26;; specified times in the future, either as one-shots or periodically. 27;; The single entry point is `run-at-time'. 28 29;;; Code: 30 31;;; The name of the program to run as the timer subprocess. It should 32;;; be in exec-directory. 33(defconst timer-program "timer") 34 35(defvar timer-process nil) 36(defvar timer-alist ()) 37(defvar timer-out "") 38(defvar timer-dont-exit nil 39 ;; this is useful for functions which will be doing their own erratic 40 ;; rescheduling or people who otherwise expect to use the process frequently 41 "If non-nil, don't exit the timer process when no more events are pending.") 42 43;; This should not be necessary, but on some systems, we get 44;; unkillable processes without this. 45;; It may be a kernel bug, but that's not certain. 46(defun timer-kill-emacs-hook () 47 (if timer-process 48 (progn 49 (set-process-sentinel timer-process nil) 50 (set-process-filter timer-process nil) 51 (delete-process timer-process)))) 52(add-hook 'kill-emacs-hook 'timer-kill-emacs-hook) 53 54;;;###autoload 55(defun run-at-time (time repeat function &rest args) 56 "Run a function at a time, and optionally on a regular interval. 57Arguments are TIME, REPEAT, FUNCTION &rest ARGS. 58TIME, a string, can be specified absolutely or relative to now. 59TIME can also be an integer, a number of seconds. 60REPEAT, an integer number of seconds, is the interval on which to repeat 61the call to the function. If REPEAT is nil, call it just once. 62 63Absolute times may be specified in a wide variety of formats; 64Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where 65all fields are numbers, works; the format used by the Unix `date' 66command works too. 67 68Relative times may be specified as a series of numbers followed by units: 69 1 min denotes one minute from now. 70 min does too. 71 1 min 5 sec denotes 65 seconds from now. 72 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year 73 denotes the sum of all the given durations from now." 74 (interactive "sRun at time: \nNRepeat interval: \naFunction: ") 75 ;; Make TIME a string. 76 (if (integerp time) 77 (setq time (format "%d sec" time))) 78 (cond ((or (not timer-process) 79 (memq (process-status timer-process) '(exit signal nil))) 80 (if timer-process (delete-process timer-process)) 81 (setq timer-process 82 (let ((process-connection-type nil)) 83 ;; Don't search the exec path for the timer program; 84 ;; we know exactly which one we want. 85 (start-process "timer" nil 86 (expand-file-name timer-program 87 exec-directory))) 88 timer-alist nil) 89 (set-process-filter timer-process 'timer-process-filter) 90 (set-process-sentinel timer-process 'timer-process-sentinel) 91 (process-kill-without-query timer-process)) 92 ((eq (process-status timer-process) 'stop) 93 (continue-process timer-process))) 94 ;; There should be a living, breathing timer process now 95 (let* ((token (concat (current-time-string) "-" (length timer-alist))) 96 (elt (list token repeat function args))) 97 (process-send-string timer-process (concat time "@" token "\n")) 98 (setq timer-alist (cons elt timer-alist)) 99 elt)) 100 101(defun cancel-timer (elt) 102 "Cancel a timer previously made with `run-at-time'. 103The argument should be a value previously returned by `run-at-time'. 104Cancelling the timer means that nothing special 105will happen at the specified time." 106 (setcar (cdr elt) nil) 107 (setcar (cdr (cdr elt)) 'ignore)) 108 109(defun timer-process-filter (proc str) 110 (setq timer-out (concat timer-out str)) 111 (let (do token error) 112 (while (string-match "\n" timer-out) 113 (setq token (substring timer-out 0 (match-beginning 0)) 114 do (assoc token timer-alist) 115 timer-out (substring timer-out (match-end 0))) 116 (cond 117 (do 118 (apply (nth 2 do) (nth 3 do)) ; do it 119 (if (natnump (nth 1 do)) ; reschedule it 120 (send-string proc (concat (nth 1 do) " sec@" (car do) "\n")) 121 (setq timer-alist (delq do timer-alist)))) 122 ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token) 123 (setq error (substring token (match-beginning 1) (match-end 1)) 124 do (substring token (match-beginning 2) (match-end 2)) 125 token (assoc (substring token (match-beginning 3) (match-end 3)) 126 timer-alist) 127 timer-alist (delq token timer-alist)) 128 (ding 'no-terminate) ; using error function in process filters is rude 129 (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do)))) 130 (or timer-alist timer-dont-exit (process-send-eof proc)))) 131 132(defun timer-process-sentinel (proc str) 133 (let ((stat (process-status proc))) 134 (if (eq stat 'stop) (continue-process proc) 135 ;; if it exited normally, presumably it was intentional. 136 ;; if there were no pending events, who cares that it exited? 137 (if (or (not timer-alist) (eq stat 'exit)) () 138 (ding 'no-terminate) 139 (message "Timer exited abnormally. All events cancelled.")) 140 ;; Used to set timer-scratch to "", but nothing uses that var. 141 (setq timer-process nil timer-alist nil)))) 142 143(defun cancel-function-timers (function) 144 "Cancel all events scheduled by `run-at-time' which would run FUNCTION." 145 (interactive "aCancel timers of function: ") 146 (let ((alist timer-alist)) 147 (while alist 148 (if (eq (nth 2 (car alist)) function) 149 (setq timer-alist (delq (car alist) timer-alist))) 150 (setq alist (cdr alist)))) 151 (or timer-alist timer-dont-exit (process-send-eof timer-process))) 152 153(provide 'timer) 154 155;;; timer.el ends here 156