Mercurial > emacs

comparison lisp/=timer.el @ 9641:284c46319091

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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 6cc76dc79853
children d857ac857c27
comparison
equal deleted inserted replaced
9640:7f70a4773d5e 9641:284c46319091
26 ;; specified times in the future, either as one-shots or periodically. 26 ;; specified times in the future, either as one-shots or periodically.
27 ;; The single entry point is `run-at-time'. 27 ;; The single entry point is `run-at-time'.
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 ())
37 (defvar timer-out "") 37 (defvar timer-out "")
38 (defvar timer-dont-exit nil 38 (defvar timer-dont-exit nil
39 ;; this is useful for functions which will be doing their own erratic 39 ;; this is useful for functions which will be doing their own erratic
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
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
42 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.
46 (defun timer-kill-emacs-hook () 65 (defun timer-kill-emacs-hook ()
80 (cond ((or (not timer-process) 99 (cond ((or (not timer-process)
81 (memq (process-status timer-process) '(exit signal nil))) 100 (memq (process-status timer-process) '(exit signal nil)))
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)
93 (process-kill-without-query timer-process)) 108 (process-kill-without-query timer-process))
94 ((eq (process-status timer-process) 'stop) 109 ((eq (process-status timer-process) 'stop)
125 (setq error (substring token (match-beginning 1) (match-end 1)) 140 (setq error (substring token (match-beginning 1) (match-end 1))
126 do (substring token (match-beginning 2) (match-end 2)) 141 do (substring token (match-beginning 2) (match-end 2))
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
145 (defun cancel-function-timers (function) 162 (defun cancel-function-timers (function)
146 "Cancel all events scheduled by `run-at-time' which would run FUNCTION." 163 "Cancel all events scheduled by `run-at-time' which would run FUNCTION."