Commit | Line | Data |
---|---|---|
d501f516 ER |
1 | ;;; timer.el --- run a function with args at some time in future |
2 | ||
dffd3124 | 3 | ;; Copyright (C) 1990, 1993 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 | |
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 | ||
c91c4e6d ER |
23 | ;;; Commentary: |
24 | ||
25 | ;; This package gives you the capability to run Emacs Lisp commands at | |
eb8c3be9 | 26 | ;; specified times in the future, either as one-shots or periodically. |
c91c4e6d ER |
27 | ;; The single entry point is `run-at-time'. |
28 | ||
e5167999 ER |
29 | ;;; Code: |
30 | ||
77328ee1 JB |
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 | ||
5cc564a6 | 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 | ||
e2ec008d RS |
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 | ||
49116ac0 | 54 | ;;;###autoload |
5cc564a6 | 55 | (defun run-at-time (time repeat function &rest args) |
56 | "Run a function at a time, and optionally on a regular interval. | |
57 | Arguments are TIME, REPEAT, FUNCTION &rest ARGS. | |
16ad0a71 RS |
58 | TIME, a string, can be specified absolutely or relative to now. |
59 | TIME can also be an integer, a number of seconds. | |
5cc564a6 | 60 | REPEAT, an integer number of seconds, is the interval on which to repeat |
b6341cd1 JB |
61 | the call to the function. If REPEAT is nil, call it just once. |
62 | ||
63 | Absolute times may be specified in a wide variety of formats; | |
64 | Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where | |
16ad0a71 RS |
65 | all fields are numbers, works; the format used by the Unix `date' |
66 | command works too. | |
b6341cd1 JB |
67 | |
68 | Relative 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." | |
5cc564a6 | 74 | (interactive "sRun at time: \nNRepeat interval: \naFunction: ") |
16ad0a71 RS |
75 | ;; Make TIME a string. |
76 | (if (integerp time) | |
77 | (setq time (format "%d sec" time))) | |
5cc564a6 | 78 | (cond ((or (not timer-process) |
79 | (memq (process-status timer-process) '(exit signal nil))) | |
80 | (if timer-process (delete-process timer-process)) | |
77328ee1 JB |
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. | |
43be9218 RS |
85 | (start-process "timer" nil |
86 | (expand-file-name timer-program | |
87 | exec-directory))) | |
5cc564a6 | 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 | |
16ad0a71 RS |
95 | (let* ((token (concat (current-time-string) "-" (length timer-alist))) |
96 | (elt (list token repeat function args))) | |
a973c898 | 97 | (process-send-string timer-process (concat time "@" token "\n")) |
16ad0a71 RS |
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'. | |
103 | The argument should be a value previously returned by `run-at-time'. | |
104 | Cancelling the timer means that nothing special | |
105 | will happen at the specified time." | |
106 | (setcar (cdr elt) nil) | |
107 | (setcar (cdr (cdr elt)) 'ignore)) | |
5cc564a6 | 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 | |
16ad0a71 RS |
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)))) | |
fbfed6f0 | 122 | ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token) |
5cc564a6 | 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.")) | |
1f3a7283 RS |
140 | ;; Used to set timer-scratch to "", but nothing uses that var. |
141 | (setq timer-process nil timer-alist nil)))) | |
5cc564a6 | 142 | |
046c6887 | 143 | (defun cancel-function-timers (function) |
1433a222 | 144 | "Cancel all events scheduled by `run-at-time' which would run FUNCTION." |
046c6887 | 145 | (interactive "aCancel timers of function: ") |
5cc564a6 | 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) | |
d501f516 ER |
154 | |
155 | ;;; timer.el ends here |