diff options
| author | Richard M. Stallman | 1994-10-21 20:27:08 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-10-21 20:27:08 +0000 |
| commit | 63afb1f89658166ebf4b7743347d6428a26b095a (patch) | |
| tree | 0ab6b25d7b616e7c4a27804ceb031a761337da66 | |
| parent | 872c2845417bdf7dc43e03e10104137a6d61a930 (diff) | |
| download | emacs-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.el | 45 |
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") | 33 | It 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 | ||