Mercurial > emacs
changeset 9641:284c46319091
(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.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 21 Oct 1994 20:27:08 +0000 |
parents | 7f70a4773d5e |
children | d857ac857c27 |
files | lisp/=timer.el |
diffstat | 1 files changed, 31 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/=timer.el Fri Oct 21 20:01:17 1994 +0000 +++ b/lisp/=timer.el Fri Oct 21 20:27:08 1994 +0000 @@ -28,9 +28,9 @@ ;;; Code: -;;; The name of the program to run as the timer subprocess. It should -;;; be in exec-directory. -(defconst timer-program "timer") +(defvar timer-program (expand-file-name "timer" exec-directory) + "The name of the program to run as the timer subprocess. +It should normally be in the exec-directory.") (defvar timer-process nil) (defvar timer-alist ()) @@ -40,6 +40,25 @@ ;; rescheduling or people who otherwise expect to use the process frequently "If non-nil, don't exit the timer process when no more events are pending.") +;; Error symbols for timers +(put 'timer-error 'error-conditions '(error timer-error)) +(put 'timer-error 'error-message "Timer error") + +(put 'timer-abnormal-termination + 'error-conditions + '(error timer-error timer-abnormal-termination)) +(put 'timer-abnormal-termination + 'error-message + "Timer exited abnormally--all events cancelled") + +(put 'timer-filter-error + 'error-conditions + '(error timer-error timer-filter-error)) +(put 'timer-filter-error + 'error-message + "Error in timer process filter") + + ;; This should not be necessary, but on some systems, we get ;; unkillable processes without this. ;; It may be a kernel bug, but that's not certain. @@ -82,11 +101,7 @@ (if timer-process (delete-process timer-process)) (setq timer-process (let ((process-connection-type nil)) - ;; Don't search the exec path for the timer program; - ;; we know exactly which one we want. - (start-process "timer" nil - (expand-file-name timer-program - exec-directory))) + (start-process "timer" nil timer-program)) timer-alist nil) (set-process-filter timer-process 'timer-process-filter) (set-process-sentinel timer-process 'timer-process-sentinel) @@ -127,18 +142,20 @@ token (assoc (substring token (match-beginning 3) (match-end 3)) timer-alist) timer-alist (delq token timer-alist)) - (ding 'no-terminate) ; using error function in process filters is rude - (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do)))) + (error "%s for %s; couldn't set at `%s'" error (nth 2 token) do)))) (or timer-alist timer-dont-exit (process-send-eof proc)))) (defun timer-process-sentinel (proc str) (let ((stat (process-status proc))) - (if (eq stat 'stop) (continue-process proc) + (if (eq stat 'stop) + (continue-process proc) ;; if it exited normally, presumably it was intentional. ;; if there were no pending events, who cares that it exited? - (if (or (not timer-alist) (eq stat 'exit)) () - (ding 'no-terminate) - (message "Timer exited abnormally. All events cancelled.")) + (or (null timer-alist) + (eq stat 'exit) + (let ((alist timer-alist)) + (setq timer-process nil timer-alist nil) + (signal 'timer-abnormal-termination (list proc stat str alist)))) ;; Used to set timer-scratch to "", but nothing uses that var. (setq timer-process nil timer-alist nil))))