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 | |
26 | ;; specified simes in the future, either as one-shots or periodically. | |
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 | ||
49116ac0 | 43 | ;;;###autoload |
5cc564a6 | 44 | (defun run-at-time (time repeat function &rest args) |
45 | "Run a function at a time, and optionally on a regular interval. | |
46 | Arguments are TIME, REPEAT, FUNCTION &rest ARGS. | |
16ad0a71 RS |
47 | TIME, a string, can be specified absolutely or relative to now. |
48 | TIME can also be an integer, a number of seconds. | |
5cc564a6 | 49 | REPEAT, an integer number of seconds, is the interval on which to repeat |
b6341cd1 JB |
50 | the call to the function. If REPEAT is nil, call it just once. |
51 | ||
52 | Absolute times may be specified in a wide variety of formats; | |
53 | Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where | |
16ad0a71 RS |
54 | all fields are numbers, works; the format used by the Unix `date' |
55 | command works too. | |
b6341cd1 JB |
56 | |
57 | Relative times may be specified as a series of numbers followed by units: | |
58 | 1 min denotes one minute from now. | |
59 | min does too. | |
60 | 1 min 5 sec denotes 65 seconds from now. | |
61 | 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year | |
62 | denotes the sum of all the given durations from now." | |
5cc564a6 | 63 | (interactive "sRun at time: \nNRepeat interval: \naFunction: ") |
16ad0a71 RS |
64 | ;; Make TIME a string. |
65 | (if (integerp time) | |
66 | (setq time (format "%d sec" time))) | |
5cc564a6 | 67 | (cond ((or (not timer-process) |
68 | (memq (process-status timer-process) '(exit signal nil))) | |
69 | (if timer-process (delete-process timer-process)) | |
77328ee1 JB |
70 | (setq timer-process |
71 | (let ((process-connection-type nil)) | |
72 | ;; Don't search the exec path for the timer program; | |
73 | ;; we know exactly which one we want. | |
74 | (start-process (expand-file-name timer-program exec-directory) | |
75 | nil "timer")) | |
5cc564a6 | 76 | timer-alist nil) |
77 | (set-process-filter timer-process 'timer-process-filter) | |
78 | (set-process-sentinel timer-process 'timer-process-sentinel) | |
79 | (process-kill-without-query timer-process)) | |
80 | ((eq (process-status timer-process) 'stop) | |
81 | (continue-process timer-process))) | |
82 | ;; There should be a living, breathing timer process now | |
16ad0a71 RS |
83 | (let* ((token (concat (current-time-string) "-" (length timer-alist))) |
84 | (elt (list token repeat function args))) | |
a973c898 | 85 | (process-send-string timer-process (concat time "@" token "\n")) |
16ad0a71 RS |
86 | (setq timer-alist (cons elt timer-alist)) |
87 | elt)) | |
88 | ||
89 | (defun cancel-timer (elt) | |
90 | "Cancel a timer previously made with `run-at-time'. | |
91 | The argument should be a value previously returned by `run-at-time'. | |
92 | Cancelling the timer means that nothing special | |
93 | will happen at the specified time." | |
94 | (setcar (cdr elt) nil) | |
95 | (setcar (cdr (cdr elt)) 'ignore)) | |
5cc564a6 | 96 | |
97 | (defun timer-process-filter (proc str) | |
98 | (setq timer-out (concat timer-out str)) | |
99 | (let (do token error) | |
100 | (while (string-match "\n" timer-out) | |
101 | (setq token (substring timer-out 0 (match-beginning 0)) | |
102 | do (assoc token timer-alist) | |
103 | timer-out (substring timer-out (match-end 0))) | |
104 | (cond | |
16ad0a71 RS |
105 | (do |
106 | (apply (nth 2 do) (nth 3 do)) ; do it | |
107 | (if (natnump (nth 1 do)) ; reschedule it | |
108 | (send-string proc (concat (nth 1 do) " sec@" (car do) "\n")) | |
109 | (setq timer-alist (delq do timer-alist)))) | |
fbfed6f0 | 110 | ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token) |
5cc564a6 | 111 | (setq error (substring token (match-beginning 1) (match-end 1)) |
112 | do (substring token (match-beginning 2) (match-end 2)) | |
113 | token (assoc (substring token (match-beginning 3) (match-end 3)) | |
114 | timer-alist) | |
115 | timer-alist (delq token timer-alist)) | |
116 | (ding 'no-terminate) ; using error function in process filters is rude | |
117 | (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do)))) | |
118 | (or timer-alist timer-dont-exit (process-send-eof proc)))) | |
119 | ||
120 | (defun timer-process-sentinel (proc str) | |
121 | (let ((stat (process-status proc))) | |
122 | (if (eq stat 'stop) (continue-process proc) | |
123 | ;; if it exited normally, presumably it was intentional. | |
124 | ;; if there were no pending events, who cares that it exited? | |
125 | (if (or (not timer-alist) (eq stat 'exit)) () | |
126 | (ding 'no-terminate) | |
127 | (message "Timer exited abnormally. All events cancelled.")) | |
1f3a7283 RS |
128 | ;; Used to set timer-scratch to "", but nothing uses that var. |
129 | (setq timer-process nil timer-alist nil)))) | |
5cc564a6 | 130 | |
131 | (defun cancel-timer (function) | |
1433a222 | 132 | "Cancel all events scheduled by `run-at-time' which would run FUNCTION." |
5cc564a6 | 133 | (interactive "aCancel function: ") |
134 | (let ((alist timer-alist)) | |
135 | (while alist | |
136 | (if (eq (nth 2 (car alist)) function) | |
137 | (setq timer-alist (delq (car alist) timer-alist))) | |
138 | (setq alist (cdr alist)))) | |
139 | (or timer-alist timer-dont-exit (process-send-eof timer-process))) | |
140 | ||
141 | (provide 'timer) | |
d501f516 ER |
142 | |
143 | ;;; timer.el ends here |