-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathPREEMPTIVE
114 lines (95 loc) · 5.18 KB
/
PREEMPTIVE
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(filecreated " 4-Apr-88 12:40:00" {erinyes}<lispusers>medley>preemptive.\;3 5218
|changes| |to:| (fns preemptive preemptive.block)
(vars preemptivecoms)
(variables no-periodic-interrupt-functions)
|previous| |date:| " 4-Apr-88 12:27:36" {erinyes}<lispusers>medley>preemptive.\;2)
; Copyright (c) 1987, 1988 by Xerox Corporation. All rights reserved.
(prettycomprint preemptivecoms)
(rpaqq preemptivecoms ((fns preemptive.block preemptive)
(variables no-periodic-interrupt-functions)
(declare\: donteval@load docopy (p (preemptive ':on)))
(declare\: eval@compile dontcopy (p (or (hasdef 'process 'records)
(eval (sysreclook1 'process)))))
(advise messagedisplayer)
(declare\: donteval@load doeval@compile dontcopy compilervars
(addvars (nlama)
(nlaml)
(lama preemptive)))))
(defineq
(preemptive.block
(lambda nil (* \; "Edited 4-Apr-88 12:26 by drc:")
(cond
((and \\interruptable (uninterruptably
(and (not (|fetch| (process procsystemp) |of| (this.process)
))
(or (eq lastmousebuttons 0)
(progn (getmousestate)
(eq lastmousebuttons 0)))
(prog (name (frame (|fetch| (fx clink)
(\\myalink))))
sampleloop
(cond
((and (litatom (setq name (\\stkname frame)))
(fmemb name no-periodic-interrupt-functions))
(return nil)))
(cond
((not (|fetch| (fx invalidp)
(setq frame (|fetch| (fx clink)
frame))))
(go sampleloop))
(t (return t)))))))
(block)))))
(preemptive
(lambda (state) (* \; "Edited 4-Apr-88 12:37 by drc:")
(prog1 (cond
((eq \\periodic.interrupt 'preemptive.block)
':on)
(t ':off))
(and state (selectq (cl:intern (string state)
'keyword)
((:on)
(setq \\periodic.interrupt.frequency 25)
(setq \\periodic.interrupt 'preemptive.block))
((:off)
(setq \\periodic.interrupt nil))
(error state "not valid argument"))))))
)
(defglobalvar no-periodic-interrupt-functions '(getkey ttwaitforinput getmousestate menu.handler
\\bltshade.display \\bitblt.display
\\bitblt.bitmap \\bltshade.bitmap
\\totopwds \\bitbltsub menu) )
(declare\: donteval@load docopy
(preemptive ':on)
)
(declare\: eval@compile dontcopy
(or (hasdef 'process 'records)
(eval (sysreclook1 'process)))
)
(xcl:reinstall-advice 'messagedisplayer :before '((:last (allow.button.events))))
(readvise messagedisplayer)
(declare\: donteval@load doeval@compile dontcopy compilervars
(addtovar nlama )
(addtovar nlaml )
(addtovar lama preemptive)
)
(prettycomprint preemptivecoms)
(rpaqq preemptivecoms ((fns preemptive.block preemptive)
(variables no-periodic-interrupt-functions)
(declare\: donteval@load docopy (p (preemptive ':on)))
(declare\: eval@compile dontcopy (p (or (hasdef 'process 'records)
(eval (sysreclook1 'process)))))
(advise messagedisplayer)
(declare\: donteval@load doeval@compile dontcopy compilervars
(addvars (nlama)
(nlaml)
(lama)))))
(declare\: donteval@load doeval@compile dontcopy compilervars
(addtovar nlama )
(addtovar nlaml )
(addtovar lama )
)
(putprops preemptive copyright ("Xerox Corporation" 1987 1988))
(declare\: dontcopy
(filemap (nil (1236 3474 (preemptive.block 1246 . 2773) (preemptive 2775 . 3472)))))
stop