annotate lisp/=timer.el @ 4515:85426a9911c0

Remove, since floor and mod (caesar-region): Replace `%' by `mod' and simplify.
author Paul Eggert <eggert@twinsun.com>
date Tue, 10 Aug 1993 04:14:17 +0000
parents 507f64624555
children 3661fe3c03d7
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
657
fec3f9a1e3e5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
1 ;;; timer.el --- run a function with args at some time in future
fec3f9a1e3e5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
2
1747
aae774aae3de (run-at-time): Use a pipe to talk to the timer process.
Roland McGrath <roland@gnu.org>
parents: 1577
diff changeset
3 ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
840
113281b361ec *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 807
diff changeset
4
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 657
diff changeset
5 ;; Maintainer: FSF
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
6
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
8
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 657
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
12 ;; any later version.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
13
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
17 ;; GNU General Public License for more details.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
18
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
22
2319
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2086
diff changeset
23 ;;; Commentary:
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2086
diff changeset
24
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2086
diff changeset
25 ;; This package gives you the capability to run Emacs Lisp commands at
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3352
diff changeset
26 ;; specified times in the future, either as one-shots or periodically.
2319
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2086
diff changeset
27 ;; The single entry point is `run-at-time'.
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2086
diff changeset
28
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 657
diff changeset
29 ;;; Code:
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 657
diff changeset
30
2447
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
31 ;;; The name of the program to run as the timer subprocess. It should
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
32 ;;; be in exec-directory.
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
33 (defconst timer-program "timer")
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
34
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
35 (defvar timer-process nil)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
36 (defvar timer-alist ())
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
37 (defvar timer-out "")
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
38 (defvar timer-dont-exit nil
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
39 ;; this is useful for functions which will be doing their own erratic
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
40 ;; rescheduling or people who otherwise expect to use the process frequently
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
41 "If non-nil, don't exit the timer process when no more events are pending.")
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
42
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 45
diff changeset
43 ;;;###autoload
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
44 (defun run-at-time (time repeat function &rest args)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
45 "Run a function at a time, and optionally on a regular interval.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
46 Arguments are TIME, REPEAT, FUNCTION &rest ARGS.
2086
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
47 TIME, a string, can be specified absolutely or relative to now.
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
48 TIME can also be an integer, a number of seconds.
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
49 REPEAT, an integer number of seconds, is the interval on which to repeat
1983
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
50 the call to the function. If REPEAT is nil, call it just once.
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
51
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
52 Absolute times may be specified in a wide variety of formats;
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
53 Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where
2086
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
54 all fields are numbers, works; the format used by the Unix `date'
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
55 command works too.
1983
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
56
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
57 Relative times may be specified as a series of numbers followed by units:
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
58 1 min denotes one minute from now.
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
59 min does too.
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
60 1 min 5 sec denotes 65 seconds from now.
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
61 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
62 denotes the sum of all the given durations from now."
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
63 (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
2086
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
64 ;; Make TIME a string.
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
65 (if (integerp time)
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
66 (setq time (format "%d sec" time)))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
67 (cond ((or (not timer-process)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
68 (memq (process-status timer-process) '(exit signal nil)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
69 (if timer-process (delete-process timer-process))
2447
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
70 (setq timer-process
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
71 (let ((process-connection-type nil))
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
72 ;; Don't search the exec path for the timer program;
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
73 ;; we know exactly which one we want.
3352
03a02339361a (run-at-time): Pass args to start-process in right order.
Richard M. Stallman <rms@gnu.org>
parents: 3267
diff changeset
74 (start-process "timer" nil
03a02339361a (run-at-time): Pass args to start-process in right order.
Richard M. Stallman <rms@gnu.org>
parents: 3267
diff changeset
75 (expand-file-name timer-program
03a02339361a (run-at-time): Pass args to start-process in right order.
Richard M. Stallman <rms@gnu.org>
parents: 3267
diff changeset
76 exec-directory)))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
77 timer-alist nil)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
78 (set-process-filter timer-process 'timer-process-filter)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
79 (set-process-sentinel timer-process 'timer-process-sentinel)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
80 (process-kill-without-query timer-process))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
81 ((eq (process-status timer-process) 'stop)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
82 (continue-process timer-process)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
83 ;; There should be a living, breathing timer process now
2086
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
84 (let* ((token (concat (current-time-string) "-" (length timer-alist)))
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
85 (elt (list token repeat function args)))
1753
852bc0022185 Use process-send-string instead of send-string.
Michael I. Bushnell <mib@gnu.org>
parents: 1747
diff changeset
86 (process-send-string timer-process (concat time "@" token "\n"))
2086
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
87 (setq timer-alist (cons elt timer-alist))
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
88 elt))
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
89
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
90 (defun cancel-timer (elt)
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
91 "Cancel a timer previously made with `run-at-time'.
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
92 The argument should be a value previously returned by `run-at-time'.
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
93 Cancelling the timer means that nothing special
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
94 will happen at the specified time."
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
95 (setcar (cdr elt) nil)
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
96 (setcar (cdr (cdr elt)) 'ignore))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
97
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
98 (defun timer-process-filter (proc str)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
99 (setq timer-out (concat timer-out str))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
100 (let (do token error)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
101 (while (string-match "\n" timer-out)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
102 (setq token (substring timer-out 0 (match-beginning 0))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
103 do (assoc token timer-alist)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
104 timer-out (substring timer-out (match-end 0)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
105 (cond
2086
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
106 (do
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
107 (apply (nth 2 do) (nth 3 do)) ; do it
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
108 (if (natnump (nth 1 do)) ; reschedule it
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
109 (send-string proc (concat (nth 1 do) " sec@" (car do) "\n"))
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
110 (setq timer-alist (delq do timer-alist))))
998
61c6983219ff entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
111 ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token)
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
112 (setq error (substring token (match-beginning 1) (match-end 1))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
113 do (substring token (match-beginning 2) (match-end 2))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
114 token (assoc (substring token (match-beginning 3) (match-end 3))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
115 timer-alist)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
116 timer-alist (delq token timer-alist))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
117 (ding 'no-terminate) ; using error function in process filters is rude
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
118 (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do))))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
119 (or timer-alist timer-dont-exit (process-send-eof proc))))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
120
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
121 (defun timer-process-sentinel (proc str)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
122 (let ((stat (process-status proc)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
123 (if (eq stat 'stop) (continue-process proc)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
124 ;; if it exited normally, presumably it was intentional.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
125 ;; if there were no pending events, who cares that it exited?
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
126 (if (or (not timer-alist) (eq stat 'exit)) ()
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
127 (ding 'no-terminate)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
128 (message "Timer exited abnormally. All events cancelled."))
1241
de92360b091b (timer-process-sentinel): Don't set timer-scratch.
Richard M. Stallman <rms@gnu.org>
parents: 1223
diff changeset
129 ;; Used to set timer-scratch to "", but nothing uses that var.
de92360b091b (timer-process-sentinel): Don't set timer-scratch.
Richard M. Stallman <rms@gnu.org>
parents: 1223
diff changeset
130 (setq timer-process nil timer-alist nil))))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
131
3267
ac18ead9965d (cancel-function-timers): Renamed from spurious duplicate
Richard M. Stallman <rms@gnu.org>
parents: 2447
diff changeset
132 (defun cancel-function-timers (function)
1577
a52da8d63ff3 Doc fix.
Christopher Zaborsky <rogue@erratum.com>
parents: 1241
diff changeset
133 "Cancel all events scheduled by `run-at-time' which would run FUNCTION."
3267
ac18ead9965d (cancel-function-timers): Renamed from spurious duplicate
Richard M. Stallman <rms@gnu.org>
parents: 2447
diff changeset
134 (interactive "aCancel timers of function: ")
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
135 (let ((alist timer-alist))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
136 (while alist
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
137 (if (eq (nth 2 (car alist)) function)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
138 (setq timer-alist (delq (car alist) timer-alist)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
139 (setq alist (cdr alist))))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
140 (or timer-alist timer-dont-exit (process-send-eof timer-process)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
141
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
142 (provide 'timer)
657
fec3f9a1e3e5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
143
fec3f9a1e3e5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
144 ;;; timer.el ends here