Commit | Line | Data |
---|---|---|
d501f516 ER |
1 | ;;; timer.el --- run a function with args at some time in future |
2 | ||
8f1204db | 3 | ;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. |
5cc564a6 | 4 | |
eea8d4ef ER |
5 | ;; Maintainer: FSF |
6 | ||
5cc564a6 | 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 | |
e5167999 | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
5cc564a6 | 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 | |
b578f267 EN |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 | ;; Boston, MA 02111-1307, USA. | |
5cc564a6 | 23 | |
c91c4e6d ER |
24 | ;;; Commentary: |
25 | ||
26 | ;; This package gives you the capability to run Emacs Lisp commands at | |
eb8c3be9 | 27 | ;; specified times in the future, either as one-shots or periodically. |
c91c4e6d ER |
28 | ;; The single entry point is `run-at-time'. |
29 | ||
e5167999 ER |
30 | ;;; Code: |
31 | ||
63afb1f8 RS |
32 | (defvar timer-program (expand-file-name "timer" exec-directory) |
33 | "The name of the program to run as the timer subprocess. | |
34 | It should normally be in the exec-directory.") | |
77328ee1 | 35 | |
5cc564a6 | 36 | (defvar timer-process nil) |
37 | (defvar timer-alist ()) | |
38 | (defvar timer-out "") | |
39 | (defvar timer-dont-exit nil | |
40 | ;; this is useful for functions which will be doing their own erratic | |
41 | ;; rescheduling or people who otherwise expect to use the process frequently | |
42 | "If non-nil, don't exit the timer process when no more events are pending.") | |
43 | ||
63afb1f8 RS |
44 | ;; Error symbols for timers |
45 | (put 'timer-error 'error-conditions '(error timer-error)) | |
46 | (put 'timer-error 'error-message "Timer error") | |
47 | ||
48 | (put 'timer-abnormal-termination | |
49 | 'error-conditions | |
50 | '(error timer-error timer-abnormal-termination)) | |
51 | (put 'timer-abnormal-termination | |
52 | 'error-message | |
53 | "Timer exited abnormally--all events cancelled") | |
54 | ||
55 | (put 'timer-filter-error | |
56 | 'error-conditions | |
57 | '(error timer-error timer-filter-error)) | |
58 | (put 'timer-filter-error | |
59 | 'error-message | |
60 | "Error in timer process filter") | |
61 | ||
62 | ||
e2ec008d RS |
63 | ;; This should not be necessary, but on some systems, we get |
64 | ;; unkillable processes without this. | |
65 | ;; It may be a kernel bug, but that's not certain. | |
66 | (defun timer-kill-emacs-hook () | |
67 | (if timer-process | |
68 | (progn | |
69 | (set-process-sentinel timer-process nil) | |
70 | (set-process-filter timer-process nil) | |
71 | (delete-process timer-process)))) | |
72 | (add-hook 'kill-emacs-hook 'timer-kill-emacs-hook) | |
73 | ||
49116ac0 | 74 | ;;;###autoload |
5cc564a6 | 75 | (defun run-at-time (time repeat function &rest args) |
76 | "Run a function at a time, and optionally on a regular interval. | |
77 | Arguments are TIME, REPEAT, FUNCTION &rest ARGS. | |
16ad0a71 RS |
78 | TIME, a string, can be specified absolutely or relative to now. |
79 | TIME can also be an integer, a number of seconds. | |
5cc564a6 | 80 | REPEAT, an integer number of seconds, is the interval on which to repeat |
b2e609ff | 81 | the call to the function. If REPEAT is nil or 0, call it just once. |
b6341cd1 JB |
82 | |
83 | Absolute times may be specified in a wide variety of formats; | |
84 | Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where | |
16ad0a71 RS |
85 | all fields are numbers, works; the format used by the Unix `date' |
86 | command works too. | |
b6341cd1 JB |
87 | |
88 | Relative times may be specified as a series of numbers followed by units: | |
89 | 1 min denotes one minute from now. | |
90 | min does too. | |
91 | 1 min 5 sec denotes 65 seconds from now. | |
92 | 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year | |
93 | denotes the sum of all the given durations from now." | |
5cc564a6 | 94 | (interactive "sRun at time: \nNRepeat interval: \naFunction: ") |
b2e609ff RS |
95 | (if (equal repeat 0) |
96 | (setq repeat nil)) | |
16ad0a71 RS |
97 | ;; Make TIME a string. |
98 | (if (integerp time) | |
99 | (setq time (format "%d sec" time))) | |
5cc564a6 | 100 | (cond ((or (not timer-process) |
101 | (memq (process-status timer-process) '(exit signal nil))) | |
102 | (if timer-process (delete-process timer-process)) | |
77328ee1 JB |
103 | (setq timer-process |
104 | (let ((process-connection-type nil)) | |
63afb1f8 | 105 | (start-process "timer" nil timer-program)) |
5cc564a6 | 106 | timer-alist nil) |
107 | (set-process-filter timer-process 'timer-process-filter) | |
108 | (set-process-sentinel timer-process 'timer-process-sentinel) | |
109 | (process-kill-without-query timer-process)) | |
110 | ((eq (process-status timer-process) 'stop) | |
111 | (continue-process timer-process))) | |
112 | ;; There should be a living, breathing timer process now | |
16ad0a71 RS |
113 | (let* ((token (concat (current-time-string) "-" (length timer-alist))) |
114 | (elt (list token repeat function args))) | |
a973c898 | 115 | (process-send-string timer-process (concat time "@" token "\n")) |
16ad0a71 RS |
116 | (setq timer-alist (cons elt timer-alist)) |
117 | elt)) | |
118 | ||
119 | (defun cancel-timer (elt) | |
120 | "Cancel a timer previously made with `run-at-time'. | |
121 | The argument should be a value previously returned by `run-at-time'. | |
122 | Cancelling the timer means that nothing special | |
123 | will happen at the specified time." | |
124 | (setcar (cdr elt) nil) | |
125 | (setcar (cdr (cdr elt)) 'ignore)) | |
5cc564a6 | 126 | |
127 | (defun timer-process-filter (proc str) | |
1f66361e RS |
128 | (setq timer-out (concat timer-out str)) |
129 | (let (do token error) | |
130 | (while (string-match "\n" timer-out) | |
131 | (setq token (substring timer-out 0 (match-beginning 0)) | |
132 | do (assoc token timer-alist) | |
133 | timer-out (substring timer-out (match-end 0))) | |
134 | (cond | |
135 | (do | |
136 | (apply (nth 2 do) (nth 3 do)) ; do it | |
137 | (if (natnump (nth 1 do)) ; reschedule it | |
138 | (send-string proc (concat (nth 1 do) " sec@" (car do) "\n")) | |
139 | (setq timer-alist (delq do timer-alist)))) | |
140 | ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token) | |
141 | (setq error (substring token (match-beginning 1) (match-end 1)) | |
142 | do (substring token (match-beginning 2) (match-end 2)) | |
143 | token (assoc (substring token (match-beginning 3) (match-end 3)) | |
144 | timer-alist) | |
145 | timer-alist (delq token timer-alist)) | |
146 | (or timer-alist | |
147 | timer-dont-exit | |
148 | (process-send-eof proc)) | |
149 | ;; Update error message for this particular instance | |
150 | (put 'timer-filter-error | |
151 | 'error-message | |
152 | (format "%s for %s; couldn't set at \"%s\"" | |
153 | error (nth 2 token) do)) | |
154 | (signal 'timer-filter-error (list proc str))))) | |
155 | (or timer-alist timer-dont-exit (process-send-eof proc)))) | |
5cc564a6 | 156 | |
157 | (defun timer-process-sentinel (proc str) | |
158 | (let ((stat (process-status proc))) | |
63afb1f8 RS |
159 | (if (eq stat 'stop) |
160 | (continue-process proc) | |
5cc564a6 | 161 | ;; if it exited normally, presumably it was intentional. |
162 | ;; if there were no pending events, who cares that it exited? | |
63afb1f8 RS |
163 | (or (null timer-alist) |
164 | (eq stat 'exit) | |
165 | (let ((alist timer-alist)) | |
166 | (setq timer-process nil timer-alist nil) | |
167 | (signal 'timer-abnormal-termination (list proc stat str alist)))) | |
1f3a7283 RS |
168 | ;; Used to set timer-scratch to "", but nothing uses that var. |
169 | (setq timer-process nil timer-alist nil)))) | |
5cc564a6 | 170 | |
046c6887 | 171 | (defun cancel-function-timers (function) |
1433a222 | 172 | "Cancel all events scheduled by `run-at-time' which would run FUNCTION." |
046c6887 | 173 | (interactive "aCancel timers of function: ") |
5cc564a6 | 174 | (let ((alist timer-alist)) |
175 | (while alist | |
176 | (if (eq (nth 2 (car alist)) function) | |
177 | (setq timer-alist (delq (car alist) timer-alist))) | |
178 | (setq alist (cdr alist)))) | |
179 | (or timer-alist timer-dont-exit (process-send-eof timer-process))) | |
180 | ||
181 | (provide 'timer) | |
d501f516 ER |
182 | |
183 | ;;; timer.el ends here |