1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
;---------------------
; file name is notify.l
;----------------------
;; routines to control the interaction with input from the notifier
;;
;; In order to deal with events from sunview, the following protocol
;; must be observed:
;; sunview notifies the lisp program of events through calling event
;; procs. These event procs should do very little work, perhaps just
;; setting a switch value or two. If an event proc wants to do anything
;; substantial, it should set *notify-command* to an appropriate (non-nil)
;; value, and possibly also set *notify-value* to something,
;; and then it should call notify-stop before returning.
;; The two routines below notice when *notify-command* has been changed
;; and call the user supplied routine passing *notify-command* and
;; *notify-value.
;;
;; The purpose of this is to ensure that the notifier needn't be called
;; recursively.
;;
;(in-package :sunview :nicknames '(:sv) :use '(:lisp :excl))
;(export '(notify-start-loop notify-dispatch-step
; *notify-command*
; *notify-value*))
;(provide :notify)
(defvar *notify-command* nil)
(defvar *notify-value* nil)
(defvar *notify-countdown* 10)
(defun notify-start-loop (handle-command-fcn)
;; loop forever, awaiting events and dispatching to the appropriate
;; user defined function to handle commands.
(while t
(setq *notify-command* nil)
(notify_start) ; process input until a notify-stop is done
(if *notify-command*
(funcall handle-command-fcn *notify-command* *notify-value*))))
(defun notify-dispatch-step (handle-command-fcn rate-of-calling)
;; if it is time to check for an event, do so and then handle
;; any event that may have occurred.
;; the rate-of-calling argument says how often to check for events
;;
(cond ((<= (setq *notify-countdown* (1- *notify-countdown*)) 0)
(setq *notify-command* nil)
(notify_dispatch) ; do one notification
(setq *notify-countdown* rate-of-calling)
(if *notify-command*
(funcall handle-command-fcn
*notify-command*
*notify-value*)))))
|
