aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-10-21 20:27:08 +0000
committerRichard M. Stallman1994-10-21 20:27:08 +0000
commit63afb1f89658166ebf4b7743347d6428a26b095a (patch)
tree0ab6b25d7b616e7c4a27804ceb031a761337da66
parent872c2845417bdf7dc43e03e10104137a6d61a930 (diff)
downloademacs-63afb1f89658166ebf4b7743347d6428a26b095a.tar.gz
emacs-63afb1f89658166ebf4b7743347d6428a26b095a.zip
(timer-error, timer-abnormal-termination,
timer-filter-error): New error conditions. (timer-process-filter, timer-process-sentinel): Signal an error, don't just print a message.
-rw-r--r--lisp/timer.el45
1 files changed, 31 insertions, 14 deletions
diff --git a/lisp/timer.el b/lisp/timer.el
index 953b8f6f523..69a68b8db5a 100644
--- a/lisp/timer.el
+++ b/lisp/timer.el
@@ -28,9 +28,9 @@
28 28
29;;; Code: 29;;; Code:
30 30
31;;; The name of the program to run as the timer subprocess. It should 31(defvar timer-program (expand-file-name "timer" exec-directory)
32;;; be in exec-directory. 32 "The name of the program to run as the timer subprocess.
33(defconst timer-program "timer") 33It should normally be in the exec-directory.")
34 34
35(defvar timer-process nil) 35(defvar timer-process nil)
36(defvar timer-alist ()) 36(defvar timer-alist ())
@@ -40,6 +40,25 @@
40 ;; rescheduling or people who otherwise expect to use the process frequently 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.") 41 "If non-nil, don't exit the timer process when no more events are pending.")
42 42
43;; Error symbols for timers
44(put 'timer-error 'error-conditions '(error timer-error))
45(put 'timer-error 'error-message "Timer error")
46
47(put 'timer-abnormal-termination
48 'error-conditions
49 '(error timer-error timer-abnormal-termination))
50(put 'timer-abnormal-termination
51 'error-message
52 "Timer exited abnormally--all events cancelled")
53
54(put 'timer-filter-error
55 'error-conditions
56 '(error timer-error timer-filter-error))
57(put 'timer-filter-error
58 'error-message
59 "Error in timer process filter")
60
61
43;; This should not be necessary, but on some systems, we get 62;; This should not be necessary, but on some systems, we get
44;; unkillable processes without this. 63;; unkillable processes without this.
45;; It may be a kernel bug, but that's not certain. 64;; It may be a kernel bug, but that's not certain.
@@ -82,11 +101,7 @@ Relative times may be specified as a series of numbers followed by units:
82 (if timer-process (delete-process timer-process)) 101 (if timer-process (delete-process timer-process))
83 (setq timer-process 102 (setq timer-process
84 (let ((process-connection-type nil)) 103 (let ((process-connection-type nil))
85 ;; Don't search the exec path for the timer program; 104 (start-process "timer" nil timer-program))
86 ;; we know exactly which one we want.
87 (start-process "timer" nil
88 (expand-file-name timer-program
89 exec-directory)))
90 timer-alist nil) 105 timer-alist nil)
91 (set-process-filter timer-process 'timer-process-filter) 106 (set-process-filter timer-process 'timer-process-filter)
92 (set-process-sentinel timer-process 'timer-process-sentinel) 107 (set-process-sentinel timer-process 'timer-process-sentinel)
@@ -127,18 +142,20 @@ will happen at the specified time."
127 token (assoc (substring token (match-beginning 3) (match-end 3)) 142 token (assoc (substring token (match-beginning 3) (match-end 3))
128 timer-alist) 143 timer-alist)
129 timer-alist (delq token timer-alist)) 144 timer-alist (delq token timer-alist))
130 (ding 'no-terminate) ; using error function in process filters is rude 145 (error "%s for %s; couldn't set at `%s'" error (nth 2 token) do))))
131 (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do))))
132 (or timer-alist timer-dont-exit (process-send-eof proc)))) 146 (or timer-alist timer-dont-exit (process-send-eof proc))))
133 147
134(defun timer-process-sentinel (proc str) 148(defun timer-process-sentinel (proc str)
135 (let ((stat (process-status proc))) 149 (let ((stat (process-status proc)))
136 (if (eq stat 'stop) (continue-process proc) 150 (if (eq stat 'stop)
151 (continue-process proc)
137 ;; if it exited normally, presumably it was intentional. 152 ;; if it exited normally, presumably it was intentional.
138 ;; if there were no pending events, who cares that it exited? 153 ;; if there were no pending events, who cares that it exited?
139 (if (or (not timer-alist) (eq stat 'exit)) () 154 (or (null timer-alist)
140 (ding 'no-terminate) 155 (eq stat 'exit)
141 (message "Timer exited abnormally. All events cancelled.")) 156 (let ((alist timer-alist))
157 (setq timer-process nil timer-alist nil)
158 (signal 'timer-abnormal-termination (list proc stat str alist))))
142 ;; Used to set timer-scratch to "", but nothing uses that var. 159 ;; Used to set timer-scratch to "", but nothing uses that var.
143 (setq timer-process nil timer-alist nil)))) 160 (setq timer-process nil timer-alist nil))))
144 161