annotate lisp/=timer.el @ 12855:2481803f0338

(vip-set-hooks): Use view-mode-hook, not view-hook.
author Karl Heuer <kwzh@gnu.org>
date Mon, 14 Aug 1995 21:56:42 +0000
parents b1ee0b2d3f53
children 83f275dcd93a
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
7300
cc7cd83ccf3f Update copyright.
Karl Heuer <kwzh@gnu.org>
parents: 6693
diff changeset
3 ;; Copyright (C) 1990, 1993, 1994 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
9641
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
31 (defvar timer-program (expand-file-name "timer" exec-directory)
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
32 "The name of the program to run as the timer subprocess.
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
33 It should normally be in the exec-directory.")
2447
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
9641
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
43 ;; Error symbols for timers
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
44 (put 'timer-error 'error-conditions '(error timer-error))
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
45 (put 'timer-error 'error-message "Timer error")
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
46
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
47 (put 'timer-abnormal-termination
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
48 'error-conditions
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
49 '(error timer-error timer-abnormal-termination))
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
50 (put 'timer-abnormal-termination
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
51 'error-message
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
52 "Timer exited abnormally--all events cancelled")
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
53
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
54 (put 'timer-filter-error
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
55 'error-conditions
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
56 '(error timer-error timer-filter-error))
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
57 (put 'timer-filter-error
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
58 'error-message
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
59 "Error in timer process filter")
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
60
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
61
6693
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
62 ;; This should not be necessary, but on some systems, we get
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
63 ;; unkillable processes without this.
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
64 ;; It may be a kernel bug, but that's not certain.
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
65 (defun timer-kill-emacs-hook ()
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
66 (if timer-process
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
67 (progn
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
68 (set-process-sentinel timer-process nil)
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
69 (set-process-filter timer-process nil)
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
70 (delete-process timer-process))))
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
71 (add-hook 'kill-emacs-hook 'timer-kill-emacs-hook)
3661fe3c03d7 (timer-kill-emacs-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
72
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 45
diff changeset
73 ;;;###autoload
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
74 (defun run-at-time (time repeat function &rest args)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
75 "Run a function at a time, and optionally on a regular interval.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
76 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
77 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
78 TIME can also be an integer, a number of seconds.
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
79 REPEAT, an integer number of seconds, is the interval on which to repeat
8044
6cc76dc79853 (run-at-time): If REPEAT is 0, don't repeat.
Richard M. Stallman <rms@gnu.org>
parents: 7300
diff changeset
80 the call to the function. If REPEAT is nil or 0, call it just once.
1983
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
81
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
82 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
83 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
84 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
85 command works too.
1983
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
86
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
87 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
88 1 min denotes one minute from now.
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
89 min does too.
f7da227e3e68 * timer.el (run-at-time): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1753
diff changeset
90 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
91 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
92 denotes the sum of all the given durations from now."
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
93 (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
8044
6cc76dc79853 (run-at-time): If REPEAT is 0, don't repeat.
Richard M. Stallman <rms@gnu.org>
parents: 7300
diff changeset
94 (if (equal repeat 0)
6cc76dc79853 (run-at-time): If REPEAT is 0, don't repeat.
Richard M. Stallman <rms@gnu.org>
parents: 7300
diff changeset
95 (setq repeat nil))
2086
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
96 ;; Make TIME a string.
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
97 (if (integerp time)
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
98 (setq time (format "%d sec" time)))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
99 (cond ((or (not timer-process)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
100 (memq (process-status timer-process) '(exit signal nil)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
101 (if timer-process (delete-process timer-process))
2447
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
102 (setq timer-process
6ff9eee5cdc9 * timer.el (timer-program): New defconst.
Jim Blandy <jimb@redhat.com>
parents: 2319
diff changeset
103 (let ((process-connection-type nil))
9641
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
104 (start-process "timer" nil timer-program))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
105 timer-alist nil)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
106 (set-process-filter timer-process 'timer-process-filter)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
107 (set-process-sentinel timer-process 'timer-process-sentinel)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
108 (process-kill-without-query timer-process))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
109 ((eq (process-status timer-process) 'stop)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
110 (continue-process timer-process)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
111 ;; 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
112 (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
113 (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
114 (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
115 (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
116 elt))
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
117
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
118 (defun cancel-timer (elt)
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
119 "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
120 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
121 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
122 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
123 (setcar (cdr elt) nil)
3daa7f080f2b (run-at-time): Allow an integer as TIME.
Richard M. Stallman <rms@gnu.org>
parents: 1983
diff changeset
124 (setcar (cdr (cdr elt)) 'ignore))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
125
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
126 (defun timer-process-filter (proc str)
10041
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
127 (setq timer-out (concat timer-out str))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
128 (let (do token error)
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
129 (while (string-match "\n" timer-out)
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
130 (setq token (substring timer-out 0 (match-beginning 0))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
131 do (assoc token timer-alist)
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
132 timer-out (substring timer-out (match-end 0)))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
133 (cond
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
134 (do
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
135 (apply (nth 2 do) (nth 3 do)) ; do it
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
136 (if (natnump (nth 1 do)) ; reschedule it
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
137 (send-string proc (concat (nth 1 do) " sec@" (car do) "\n"))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
138 (setq timer-alist (delq do timer-alist))))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
139 ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token)
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
140 (setq error (substring token (match-beginning 1) (match-end 1))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
141 do (substring token (match-beginning 2) (match-end 2))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
142 token (assoc (substring token (match-beginning 3) (match-end 3))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
143 timer-alist)
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
144 timer-alist (delq token timer-alist))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
145 (or timer-alist
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
146 timer-dont-exit
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
147 (process-send-eof proc))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
148 ;; Update error message for this particular instance
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
149 (put 'timer-filter-error
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
150 'error-message
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
151 (format "%s for %s; couldn't set at \"%s\""
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
152 error (nth 2 token) do))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
153 (signal 'timer-filter-error (list proc str)))))
b1ee0b2d3f53 (timer-process-filter): No need for save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 9994
diff changeset
154 (or timer-alist timer-dont-exit (process-send-eof proc))))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
155
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
156 (defun timer-process-sentinel (proc str)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
157 (let ((stat (process-status proc)))
9641
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
158 (if (eq stat 'stop)
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
159 (continue-process proc)
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
160 ;; if it exited normally, presumably it was intentional.
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
161 ;; if there were no pending events, who cares that it exited?
9641
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
162 (or (null timer-alist)
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
163 (eq stat 'exit)
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
164 (let ((alist timer-alist))
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
165 (setq timer-process nil timer-alist nil)
284c46319091 (timer-error, timer-abnormal-termination,
Richard M. Stallman <rms@gnu.org>
parents: 8044
diff changeset
166 (signal 'timer-abnormal-termination (list proc stat str alist))))
1241
de92360b091b (timer-process-sentinel): Don't set timer-scratch.
Richard M. Stallman <rms@gnu.org>
parents: 1223
diff changeset
167 ;; 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
168 (setq timer-process nil timer-alist nil))))
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
169
3267
ac18ead9965d (cancel-function-timers): Renamed from spurious duplicate
Richard M. Stallman <rms@gnu.org>
parents: 2447
diff changeset
170 (defun cancel-function-timers (function)
1577
a52da8d63ff3 Doc fix.
Christopher Zaborsky <rogue@erratum.com>
parents: 1241
diff changeset
171 "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
172 (interactive "aCancel timers of function: ")
45
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
173 (let ((alist timer-alist))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
174 (while alist
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
175 (if (eq (nth 2 (car alist)) function)
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
176 (setq timer-alist (delq (car alist) timer-alist)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
177 (setq alist (cdr alist))))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
178 (or timer-alist timer-dont-exit (process-send-eof timer-process)))
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
179
a55a3ac41924 Initial revision
root <root>
parents:
diff changeset
180 (provide 'timer)
657
fec3f9a1e3e5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
181
fec3f9a1e3e5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
182 ;;; timer.el ends here