Mercurial > emacs
comparison lisp/play/doctor.el @ 111406:86b26e5fe3fc
Silence doctor.el compilation.
* lisp/play/doctor.el: Give all local variables a prefix. Update callers.
(doc$, doctor-put-meaning): Use backquote.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Fri, 05 Nov 2010 00:41:47 -0700 |
parents | 1d1d5d9bd884 |
children | 417b1e4d63cd |
comparison
equal
deleted
inserted
replaced
111405:942097a71997 | 111406:86b26e5fe3fc |
---|---|
27 ;; phrase-production techniques similar to the classic ELIZA demonstration | 27 ;; phrase-production techniques similar to the classic ELIZA demonstration |
28 ;; of pseudo-AI. | 28 ;; of pseudo-AI. |
29 | 29 |
30 ;;; Code: | 30 ;;; Code: |
31 | 31 |
32 (defvar **mad**) (defvar *debug*) (defvar *print-space*) | 32 (defvar doctor--**mad**) |
33 (defvar *print-upcase*) (defvar abuselst) (defvar abusewords) | 33 (defvar doctor--*print-space*) |
34 (defvar account) (defvar afraidof) (defvar arerelated) | 34 (defvar doctor--*print-upcase*) |
35 (defvar areyou) (defvar bak) (defvar beclst) | 35 (defvar doctor--abuselst) |
36 (defvar bother) (defvar bye) (defvar canyou) | 36 (defvar doctor--abusewords) |
37 (defvar chatlst) (defvar continue) (defvar deathlst) | 37 (defvar doctor--afraidof) |
38 (defvar describe) (defvar drnk) (defvar drugs) | 38 (defvar doctor--arerelated) |
39 (defvar eliza-flag) (defvar elizalst) (defvar famlst) | 39 (defvar doctor--areyou) |
40 (defvar feared) (defvar fears) (defvar feelings-about) | 40 (defvar doctor--bak) |
41 (defvar foullst) (defvar found) (defvar hello) | 41 (defvar doctor--beclst) |
42 (defvar history) (defvar howareyoulst) (defvar howdyflag) | 42 (defvar doctor--bother) |
43 (defvar huhlst) (defvar ibelieve) (defvar improve) | 43 (defvar doctor--bye) |
44 (defvar inter) (defvar isee) (defvar isrelated) | 44 (defvar doctor--canyou) ; unused? |
45 (defvar lincount) (defvar longhuhlst) (defvar lover) | 45 (defvar doctor--chatlst) |
46 (defvar machlst) (defvar mathlst) (defvar maybe) | 46 (defvar doctor--continue) |
47 (defvar moods) (defvar neglst) (defvar obj) | 47 (defvar doctor--deathlst) |
48 (defvar object) (defvar owner) (defvar please) | 48 (defvar doctor--describe) |
49 (defvar problems) (defvar qlist) (defvar random-adjective) | 49 (defvar doctor--drnk) |
50 (defvar relation) (defvar remlst) (defvar repetitive-shortness) | 50 (defvar doctor--drugs) |
51 (defvar replist) (defvar rms-flag) (defvar schoollst) | 51 (defvar doctor--eliza-flag) |
52 (defvar sent) (defvar sexlst) (defvar shortbeclst) | 52 (defvar doctor--elizalst) |
53 (defvar shortlst) (defvar something) (defvar sportslst) | 53 (defvar doctor--famlst) |
54 (defvar stallmanlst) (defvar states) (defvar subj) | 54 (defvar doctor--feared) |
55 (defvar suicide-flag) (defvar sure) (defvar thing) | 55 (defvar doctor--fears) |
56 (defvar things) (defvar thlst) (defvar toklst) | 56 (defvar doctor--feelings-about) |
57 (defvar typos) (defvar verb) (defvar want) | 57 (defvar doctor--foullst) |
58 (defvar whatwhen) (defvar whereoutp) (defvar whysay) | 58 (defvar doctor-found) |
59 (defvar whywant) (defvar zippy-flag) (defvar zippylst) | 59 (defvar doctor--hello) |
60 (defvar doctor--history) | |
61 (defvar doctor--howareyoulst) | |
62 (defvar doctor--howdyflag) | |
63 (defvar doctor--huhlst) | |
64 (defvar doctor--ibelieve) | |
65 (defvar doctor--improve) | |
66 (defvar doctor--inter) | |
67 (defvar doctor--isee) | |
68 (defvar doctor--isrelated) | |
69 (defvar doctor--lincount) | |
70 (defvar doctor--longhuhlst) | |
71 (defvar doctor--lover) | |
72 (defvar doctor--machlst) | |
73 (defvar doctor--mathlst) | |
74 (defvar doctor--maybe) | |
75 (defvar doctor--moods) | |
76 (defvar doctor--neglst) | |
77 (defvar doctor-obj) | |
78 (defvar doctor-object) | |
79 (defvar doctor-owner) | |
80 (defvar doctor--please) | |
81 (defvar doctor--problems) | |
82 (defvar doctor--qlist) | |
83 (defvar doctor--random-adjective) | |
84 (defvar doctor--relation) | |
85 (defvar doctor--remlst) | |
86 (defvar doctor--repetitive-shortness) | |
87 (defvar doctor--replist) | |
88 (defvar doctor--rms-flag) | |
89 (defvar doctor--schoollst) | |
90 (defvar doctor-sent) | |
91 (defvar doctor--sexlst) | |
92 (defvar doctor--shortbeclst) | |
93 (defvar doctor--shortlst) | |
94 (defvar doctor--something) | |
95 (defvar doctor--sportslst) | |
96 (defvar doctor--stallmanlst) | |
97 (defvar doctor--states) | |
98 (defvar doctor-subj) | |
99 (defvar doctor--suicide-flag) | |
100 (defvar doctor--sure) | |
101 (defvar doctor--thing) | |
102 (defvar doctor--things) | |
103 (defvar doctor--thlst) | |
104 (defvar doctor--toklst) | |
105 (defvar doctor--typos) | |
106 (defvar doctor-verb) | |
107 (defvar doctor--want) | |
108 (defvar doctor--whatwhen) | |
109 (defvar doctor--whereoutp) | |
110 (defvar doctor--whysay) | |
111 (defvar doctor--whywant) | |
112 (defvar doctor--zippy-flag) | |
113 (defvar doctor--zippylst) | |
60 | 114 |
61 (defun doc// (x) x) | 115 (defun doc// (x) x) |
62 | 116 |
63 (defmacro doc$ (what) | 117 (defmacro doc$ (what) |
64 "quoted arg form of doctor-$" | 118 "quoted arg form of doctor-$" |
65 (list 'doctor-$ (list 'quote what))) | 119 `(doctor-$ ',what)) |
66 | 120 |
67 (defun doctor-$ (what) | 121 (defun doctor-$ (what) |
68 "Return the car of a list, rotating the list each time" | 122 "Return the car of a list, rotating the list each time" |
69 (let* ((vv (symbol-value what)) | 123 (let* ((vv (symbol-value what)) |
70 (first (car vv)) | 124 (first (car vv)) |
84 except that RET when point is after a newline, or LFD at any time, | 138 except that RET when point is after a newline, or LFD at any time, |
85 reads the sentence before point, and prints the Doctor's answer." | 139 reads the sentence before point, and prints the Doctor's answer." |
86 (make-doctor-variables) | 140 (make-doctor-variables) |
87 (turn-on-auto-fill) | 141 (turn-on-auto-fill) |
88 (doctor-type '(i am the psychotherapist \. | 142 (doctor-type '(i am the psychotherapist \. |
89 (doc$ please) (doc$ describe) your (doc$ problems) \. | 143 (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \. |
90 each time you are finished talking, type \R\E\T twice \.)) | 144 each time you are finished talking, type \R\E\T twice \.)) |
91 (insert "\n")) | 145 (insert "\n")) |
92 | 146 |
93 (defun make-doctor-variables () | 147 (defun make-doctor-variables () |
94 (make-local-variable 'typos) | 148 (set (make-local-variable 'doctor--typos) |
95 (setq typos | 149 (mapcar (lambda (x) |
96 (mapcar (function (lambda (x) | 150 (put (car x) 'doctor-correction (cadr x)) |
97 (put (car x) 'doctor-correction (cadr x)) | 151 (put (cadr x) 'doctor-expansion (car (cddr x))) |
98 (put (cadr x) 'doctor-expansion (car (cddr x))) | 152 (car x)) |
99 (car x))) | 153 '((theyll they\'ll (they will)) |
100 '((theyll they\'ll (they will)) | 154 (theyre they\'re (they are)) |
101 (theyre they\'re (they are)) | 155 (hes he\'s (he is)) |
102 (hes he\'s (he is)) | 156 (he7s he\'s (he is)) |
103 (he7s he\'s (he is)) | 157 (im i\'m (you are)) |
104 (im i\'m (you are)) | 158 (i7m i\'m (you are)) |
105 (i7m i\'m (you are)) | 159 (isa is\ a (is a)) |
106 (isa is\ a (is a)) | 160 (thier their (their)) |
107 (thier their (their)) | 161 (dont don\'t (do not)) |
108 (dont don\'t (do not)) | 162 (don7t don\'t (do not)) |
109 (don7t don\'t (do not)) | 163 (you7re you\'re (i am)) |
110 (you7re you\'re (i am)) | 164 (you7ve you\'ve (i have)) |
111 (you7ve you\'ve (i have)) | 165 (you7ll you\'ll (i will))))) |
112 (you7ll you\'ll (i will))))) | 166 (set (make-local-variable 'doctor-found) nil) |
113 (make-local-variable 'found) | 167 (set (make-local-variable 'doctor-owner) nil) |
114 (setq found nil) | 168 (set (make-local-variable 'doctor--history) nil) |
115 (make-local-variable 'owner) | 169 (set (make-local-variable 'doctor--inter) '((well\,) |
116 (setq owner nil) | 170 (hmmm \.\.\.\ so\,) |
117 (make-local-variable 'history) | 171 (so) |
118 (setq history nil) | 172 (\.\.\.and) |
119 (make-local-variable '*debug*) | 173 (then))) |
120 (setq *debug* nil) | 174 (set (make-local-variable 'doctor--continue) '((continue) |
121 (make-local-variable 'inter) | 175 (proceed) |
122 (setq inter | 176 (go on) |
123 '((well\,) | 177 (keep going))) |
124 (hmmm \.\.\.\ so\,) | 178 (set (make-local-variable 'doctor--relation) |
125 (so) | 179 '((your relationship with) |
126 (\.\.\.and) | 180 (something you remember about) |
127 (then))) | 181 (your feelings toward) |
128 (make-local-variable 'continue) | 182 (some experiences you have had with) |
129 (setq continue | 183 (how you feel about))) |
130 '((continue) | 184 (set (make-local-variable 'doctor--fears) |
131 (proceed) | 185 '(((doc$ doctor--whysay) you are (doc$ doctor--afraidof) (doc// doctor--feared) \?) |
132 (go on) | 186 (you seem terrified by (doc// doctor--feared) \.) |
133 (keep going) )) | 187 (when did you first feel (doc$ doctor--afraidof) (doc// doctor--feared) \?))) |
134 (make-local-variable 'relation) | 188 (set (make-local-variable 'doctor--sure) '((sure) |
135 (setq relation | 189 (positive) |
136 '((your relationship with) | 190 (certain) |
137 (something you remember about) | 191 (absolutely sure))) |
138 (your feelings toward) | 192 (set (make-local-variable 'doctor--afraidof) '((afraid of) |
139 (some experiences you have had with) | 193 (frightened by) |
140 (how you feel about))) | 194 (scared of))) |
141 (make-local-variable 'fears) | 195 (set (make-local-variable 'doctor--areyou) '((are you) |
142 (setq fears '( ((doc$ whysay) you are (doc$ afraidof) (doc// feared) \?) | 196 (have you been) |
143 (you seem terrified by (doc// feared) \.) | 197 (have you been))) |
144 (when did you first feel (doc$ afraidof) (doc// feared) \?) )) | 198 (set (make-local-variable 'doctor--isrelated) |
145 (make-local-variable 'sure) | 199 '((has something to do with) |
146 (setq sure '((sure)(positive)(certain)(absolutely sure))) | 200 (is related to) |
147 (make-local-variable 'afraidof) | 201 (could be the reason for) |
148 (setq afraidof '( (afraid of) (frightened by) (scared of) )) | 202 (is caused by) |
149 (make-local-variable 'areyou) | 203 (is because of))) |
150 (setq areyou '( (are you)(have you been)(have you been) )) | 204 (set (make-local-variable 'doctor--arerelated) '((have something to do with) |
151 (make-local-variable 'isrelated) | 205 (are related to) |
152 (setq isrelated '( (has something to do with)(is related to) | 206 (could have caused) |
153 (could be the reason for) (is caused by)(is because of))) | 207 (could be the reason for) |
154 (make-local-variable 'arerelated) | 208 (are caused by) |
155 (setq arerelated '((have something to do with)(are related to) | 209 (are because of))) |
156 (could have caused)(could be the reason for) (are caused by) | 210 (set (make-local-variable 'doctor--moods) |
157 (are because of))) | 211 '(((doc$ doctor--areyou) (doc// doctor-found) often \?) |
158 (make-local-variable 'moods) | 212 (what causes you to be (doc// doctor-found) \?) |
159 (setq moods '( ((doc$ areyou)(doc// found) often \?) | 213 ((doc$ doctor--whysay) you are (doc// doctor-found) \?))) |
160 (what causes you to be (doc// found) \?) | 214 (set (make-local-variable 'doctor--maybe) '((maybe) |
161 ((doc$ whysay) you are (doc// found) \?) )) | 215 (perhaps) |
162 (make-local-variable 'maybe) | 216 (possibly))) |
163 (setq maybe | 217 (set (make-local-variable 'doctor--whatwhen) '((what happened when) |
164 '((maybe) | 218 (what would happen if))) |
165 (perhaps) | 219 (set (make-local-variable 'doctor--hello) '((how do you do \?) |
166 (possibly))) | 220 (hello \.) |
167 (make-local-variable 'whatwhen) | 221 (howdy!) |
168 (setq whatwhen | 222 (hello \.) |
169 '((what happened when) | 223 (hi \.) |
170 (what would happen if))) | 224 (hi there \.))) |
171 (make-local-variable 'hello) | 225 (set (make-local-variable 'doctor--drnk) |
172 (setq hello | 226 '((do you drink a lot of (doc// doctor-found) \?) |
173 '((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.))) | 227 (do you get drunk often \?) |
174 (make-local-variable 'drnk) | 228 ((doc$ doctor--describe) your drinking habits \.))) |
175 (setq drnk | 229 (set (make-local-variable 'doctor--drugs) |
176 '((do you drink a lot of (doc// found) \?) | 230 '((do you use (doc// doctor-found) often \?) |
177 (do you get drunk often \?) | 231 ((doc$ doctor--areyou) addicted to (doc// doctor-found) \?) |
178 ((doc$ describe) your drinking habits \.) )) | 232 (do you realize that drugs can be very harmful \?) |
179 (make-local-variable 'drugs) | 233 ((doc$ doctor--maybe) you should try to quit using (doc// doctor-found) \.))) |
180 (setq drugs '( (do you use (doc// found) often \?)((doc$ areyou) | 234 (set (make-local-variable 'doctor--whywant) |
181 addicted to (doc// found) \?)(do you realize that drugs can | 235 '(((doc$ doctor--whysay) (doc// doctor-subj) might (doc$ doctor--want) (doc// doctor-obj) \?) |
182 be very harmful \?)((doc$ maybe) you should try to quit using (doc// found) | 236 (how does it feel to want \?) |
183 \.))) | 237 (why should (doc// doctor-subj) get (doc// doctor-obj) \?) |
184 (make-local-variable 'whywant) | 238 (when did (doc// doctor-subj) first (doc$ doctor--want) (doc// doctor-obj) \?) |
185 (setq whywant '( ((doc$ whysay) (doc// subj) might (doc$ want) (doc// obj) \?) | 239 ((doc$ doctor--areyou) obsessed with (doc// doctor-obj) \?) |
186 (how does it feel to want \?) | 240 (why should i give (doc// doctor-obj) to (doc// doctor-subj) \?) |
187 (why should (doc// subj) get (doc// obj) \?) | 241 (have you ever gotten (doc// doctor-obj) \?))) |
188 (when did (doc// subj) first (doc$ want) (doc// obj) \?) | 242 (set (make-local-variable 'doctor--canyou) |
189 ((doc$ areyou) obsessed with (doc// obj) \?) | 243 '((of course i can \.) |
190 (why should i give (doc// obj) to (doc// subj) \?) | 244 (why should i \?) |
191 (have you ever gotten (doc// obj) \?) )) | 245 (what makes you think i would even want to \?) |
192 (make-local-variable 'canyou) | 246 (i am the doctor\, i can do anything i damn please \.) |
193 (setq canyou '((of course i can \.) | 247 (not really\, it\'s not up to me \.) |
194 (why should i \?) | 248 (depends\, how important is it \?) |
195 (what makes you think i would even want to \?) | 249 (i could\, but i don\'t think it would be a wise thing to do \.) |
196 (i am the doctor\, i can do anything i damn please \.) | 250 (can you \?) |
197 (not really\, it\'s not up to me \.) | 251 (maybe i can\, maybe i can\'t \.\.\.) |
198 (depends\, how important is it \?) | 252 (i don\'t think i should do that \.))) |
199 (i could\, but i don\'t think it would be a wise thing to do \.) | 253 (set (make-local-variable 'doctor--want) '((want) (desire) (wish) (want) (hope))) |
200 (can you \?) | 254 (set (make-local-variable 'doctor--shortlst) |
201 (maybe i can\, maybe i can\'t \.\.\.) | 255 '((can you elaborate on that \?) |
202 (i don\'t think i should do that \.))) | 256 ((doc$ doctor--please) continue \.) |
203 (make-local-variable 'want) | 257 (go on\, don\'t be afraid \.) |
204 (setq want '( (want) (desire) (wish) (want) (hope) )) | 258 (i need a little more detail please \.) |
205 (make-local-variable 'shortlst) | 259 (you\'re being a bit brief\, (doc$ doctor--please) go into detail \.) |
206 (setq shortlst | 260 (can you be more explicit \?) |
207 '((can you elaborate on that \?) | 261 (and \?) |
208 ((doc$ please) continue \.) | 262 ((doc$ doctor--please) go into more detail \?) |
209 (go on\, don\'t be afraid \.) | 263 (you aren\'t being very talkative today\!) |
210 (i need a little more detail please \.) | 264 (is that all there is to it \?) |
211 (you\'re being a bit brief\, (doc$ please) go into detail \.) | 265 (why must you respond so briefly \?))) |
212 (can you be more explicit \?) | 266 (set (make-local-variable 'doctor--famlst) |
213 (and \?) | 267 '((tell me (doc$ doctor--something) about (doc// doctor-owner) family \.) |
214 ((doc$ please) go into more detail \?) | 268 (you seem to dwell on (doc// doctor-owner) family \.) |
215 (you aren\'t being very talkative today\!) | 269 ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?))) |
216 (is that all there is to it \?) | 270 (set (make-local-variable 'doctor--huhlst) |
217 (why must you respond so briefly \?))) | 271 '(((doc$ doctor--whysay)(doc// doctor-sent) \?) |
218 | 272 (is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?))) |
219 (make-local-variable 'famlst) | 273 (set (make-local-variable 'doctor--longhuhlst) |
220 (setq famlst | 274 '(((doc$ doctor--whysay) that \?) |
221 '((tell me (doc$ something) about (doc// owner) family \.) | 275 (i don\'t understand \.) |
222 (you seem to dwell on (doc// owner) family \.) | 276 ((doc$ doctor--thlst)) |
223 ((doc$ areyou) hung up on (doc// owner) family \?))) | 277 ((doc$ doctor--areyou) (doc$ doctor--afraidof) that \?))) |
224 (make-local-variable 'huhlst) | 278 (set (make-local-variable 'doctor--feelings-about) '((feelings about) |
225 (setq huhlst | 279 (apprehensions toward) |
226 '(((doc$ whysay)(doc// sent) \?) | 280 (thoughts on) |
227 (is it because of (doc$ things) that you say (doc// sent) \?) )) | 281 (emotions toward))) |
228 (make-local-variable 'longhuhlst) | 282 (set (make-local-variable 'doctor--random-adjective) |
229 (setq longhuhlst | 283 '((vivid) |
230 '(((doc$ whysay) that \?) | 284 (emotionally stimulating) |
231 (i don\'t understand \.) | 285 (exciting) |
232 ((doc$ thlst)) | 286 (boring) |
233 ((doc$ areyou) (doc$ afraidof) that \?))) | 287 (interesting) |
234 (make-local-variable 'feelings-about) | 288 (recent) |
235 (setq feelings-about | 289 (random) ; how can we omit this? |
236 '((feelings about) | 290 (unusual) |
237 (apprehensions toward) | 291 (shocking) |
238 (thoughts on) | 292 (embarrassing))) |
239 (emotions toward))) | 293 (set (make-local-variable 'doctor--whysay) '((why do you say) |
240 (make-local-variable 'random-adjective) | 294 (what makes you believe) |
241 (setq random-adjective | 295 (are you sure that) |
242 '((vivid) | 296 (do you really think) |
243 (emotionally stimulating) | 297 (what makes you think))) |
244 (exciting) | 298 (set (make-local-variable 'doctor--isee) '((i see \.\.\.) |
245 (boring) | 299 (yes\,) |
246 (interesting) | 300 (i understand \.) |
247 (recent) | 301 (oh \.) )) |
248 (random) ;How can we omit this? | 302 (set (make-local-variable 'doctor--please) '((please\,) |
249 (unusual) | 303 (i would appreciate it if you would) |
250 (shocking) | 304 (perhaps you could) |
251 (embarrassing))) | 305 (please\,) |
252 (make-local-variable 'whysay) | 306 (would you please) |
253 (setq whysay | 307 (why don\'t you) |
254 '((why do you say) | 308 (could you))) |
255 (what makes you believe) | 309 (set (make-local-variable 'doctor--bye) |
256 (are you sure that) | 310 '((my secretary will send you a bill \.) |
257 (do you really think) | 311 (bye bye \.) |
258 (what makes you think) )) | 312 (see ya \.) |
259 (make-local-variable 'isee) | 313 (ok\, talk to you some other time \.) |
260 (setq isee | 314 (talk to you later \.) |
261 '((i see \.\.\.) | 315 (ok\, have fun \.) |
262 (yes\,) | 316 (ciao \.))) |
263 (i understand \.) | 317 (set (make-local-variable 'doctor--something) '((something) |
264 (oh \.) )) | 318 (more) |
265 (make-local-variable 'please) | 319 (how you feel))) |
266 (setq please | 320 (set (make-local-variable 'doctor--thing) '((your life) |
267 '((please\,) | 321 (your sex life))) |
268 (i would appreciate it if you would) | 322 (set (make-local-variable 'doctor--things) '((your plans) |
269 (perhaps you could) | 323 (the people you hang around with) |
270 (please\,) | 324 (problems at school) |
271 (would you please) | 325 (any hobbies you have) |
272 (why don\'t you) | 326 (hangups you have) |
273 (could you))) | 327 (your inhibitions) |
274 (make-local-variable 'bye) | 328 (some problems in your childhood) |
275 (setq bye | 329 (some problems at home))) |
276 '((my secretary will send you a bill \.) | 330 (set (make-local-variable 'doctor--describe) '((describe) |
277 (bye bye \.) | 331 (tell me about) |
278 (see ya \.) | 332 (talk about) |
279 (ok\, talk to you some other time \.) | 333 (discuss) |
280 (talk to you later \.) | 334 (tell me more about) |
281 (ok\, have fun \.) | 335 (elaborate on))) |
282 (ciao \.))) | 336 (set (make-local-variable 'doctor--ibelieve) |
283 (make-local-variable 'something) | 337 '((i believe) (i think) (i have a feeling) (it seems to me that) |
284 (setq something | 338 (it looks like))) |
285 '((something) | 339 (set (make-local-variable 'doctor--problems) '((problems) |
286 (more) | 340 (inhibitions) |
287 (how you feel))) | 341 (hangups) |
288 (make-local-variable 'thing) | 342 (difficulties) |
289 (setq thing | 343 (anxieties) |
290 '((your life) | 344 (frustrations))) |
291 (your sex life))) | 345 (set (make-local-variable 'doctor--bother) '((does it bother you that) |
292 (make-local-variable 'things) | 346 (are you annoyed that) |
293 (setq things | 347 (did you ever regret) |
294 '((your plans) | 348 (are you sorry) |
295 (the people you hang around with) | 349 (are you satisfied with the fact that))) |
296 (problems at school) | 350 (set (make-local-variable 'doctor--machlst) |
297 (any hobbies you have) | 351 '((you have your mind on (doc// doctor-found) \, it seems \.) |
298 (hangups you have) | 352 (you think too much about (doc// doctor-found) \.) |
299 (your inhibitions) | 353 (you should try taking your mind off of (doc// doctor-found)\.) |
300 (some problems in your childhood) | 354 (are you a computer hacker \?))) |
301 (some problems at home))) | 355 (set (make-local-variable 'doctor--qlist) |
302 (make-local-variable 'describe) | 356 '((what do you think \?) |
303 (setq describe | 357 (i\'ll ask the questions\, if you don\'t mind!) |
304 '((describe) | 358 (i could ask the same thing myself \.) |
305 (tell me about) | 359 ((doc$ doctor--please) allow me to do the questioning \.) |
306 (talk about) | 360 (i have asked myself that question many times \.) |
307 (discuss) | 361 ((doc$ doctor--please) try to answer that question yourself \.))) |
308 (tell me more about) | 362 (set (make-local-variable 'doctor--foullst) |
309 (elaborate on))) | 363 '(((doc$ doctor--please) watch your tongue!) |
310 (make-local-variable 'ibelieve) | 364 ((doc$ doctor--please) avoid such unwholesome thoughts \.) |
311 (setq ibelieve | 365 ((doc$ doctor--please) get your mind out of the gutter \.) |
312 '((i believe) (i think) (i have a feeling) (it seems to me that) | 366 (such lewdness is not appreciated \.))) |
313 (it looks like))) | 367 (set (make-local-variable 'doctor--deathlst) |
314 (make-local-variable 'problems) | 368 '((this is not a healthy way of thinking \.) |
315 (setq problems '( (problems) | 369 ((doc$ doctor--bother) you\, too\, may die someday \?) |
316 (inhibitions) | 370 (i am worried by your obsession with this topic!) |
317 (hangups) | 371 (did you watch a lot of crime and violence on television as a child \?))) |
318 (difficulties) | 372 (set (make-local-variable 'doctor--sexlst) |
319 (anxieties) | 373 '(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?) |
320 (frustrations) )) | 374 ((doc$ doctor--describe)(doc$ doctor--something) about your sexual history \.) |
321 (make-local-variable 'bother) | 375 ((doc$ doctor--please)(doc$ doctor--describe) your sex life \.\.\.) |
322 (setq bother | 376 ((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.) |
323 '((does it bother you that) | 377 ((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.) |
324 (are you annoyed that) | 378 ((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?))) |
325 (did you ever regret) | 379 (set (make-local-variable 'doctor--neglst) '((why not \?) |
326 (are you sorry) | 380 ((doc$ doctor--bother) i ask that \?) |
327 (are you satisfied with the fact that))) | 381 (why not \?) |
328 (make-local-variable 'machlst) | 382 (why not \?) |
329 (setq machlst | 383 (how come \?) |
330 '((you have your mind on (doc// found) \, it seems \.) | 384 ((doc$ doctor--bother) i ask that \?))) |
331 (you think too much about (doc// found) \.) | 385 (set (make-local-variable 'doctor--beclst) |
332 (you should try taking your mind off of (doc// found)\.) | 386 '((is it because (doc// doctor-sent) that you came to me \?) |
333 (are you a computer hacker \?))) | 387 ((doc$ doctor--bother)(doc// doctor-sent) \?) |
334 (make-local-variable 'qlist) | 388 (when did you first know that (doc// doctor-sent) \?) |
335 (setq qlist | 389 (is the fact that (doc// doctor-sent) the real reason \?) |
336 '((what do you think \?) | 390 (does the fact that (doc// doctor-sent) explain anything else \?) |
337 (i\'ll ask the questions\, if you don\'t mind!) | 391 ((doc$ doctor--areyou)(doc$ doctor--sure)(doc// doctor-sent) \? ))) |
338 (i could ask the same thing myself \.) | 392 (set (make-local-variable 'doctor--shortbeclst) |
339 ((doc$ please) allow me to do the questioning \.) | 393 '(((doc$ doctor--bother) i ask you that \?) |
340 (i have asked myself that question many times \.) | 394 (that\'s not much of an answer!) |
341 ((doc$ please) try to answer that question yourself \.))) | 395 ((doc$ doctor--inter) why won\'t you talk about it \?) |
342 (make-local-variable 'foullst) | 396 (speak up!) |
343 (setq foullst | 397 ((doc$ doctor--areyou) (doc$ doctor--afraidof) talking about it \?) |
344 '(((doc$ please) watch your tongue!) | 398 (don\'t be (doc$ doctor--afraidof) elaborating \.) |
345 ((doc$ please) avoid such unwholesome thoughts \.) | 399 ((doc$ doctor--please) go into more detail \.))) |
346 ((doc$ please) get your mind out of the gutter \.) | 400 (set (make-local-variable 'doctor--thlst) |
347 (such lewdness is not appreciated \.))) | 401 '(((doc$ doctor--maybe)(doc$ doctor--thing)(doc$ doctor--isrelated) this \.) |
348 (make-local-variable 'deathlst) | 402 ((doc$ doctor--maybe)(doc$ doctor--things)(doc$ doctor--arerelated) this \.) |
349 (setq deathlst | 403 (is it because of (doc$ doctor--things) that you are going through all this \?) |
350 '((this is not a healthy way of thinking \.) | 404 (how do you reconcile (doc$ doctor--things) \? ) |
351 ((doc$ bother) you\, too\, may die someday \?) | 405 ((doc$ doctor--maybe) this (doc$ doctor--isrelated)(doc$ doctor--things) \?))) |
352 (i am worried by your obsession with this topic!) | 406 (set (make-local-variable 'doctor--remlst) |
353 (did you watch a lot of crime and violence on television as a child \?)) | 407 '((earlier you said (doc$ doctor--history) \?) |
354 ) | 408 (you mentioned that (doc$ doctor--history) \?) |
355 (make-local-variable 'sexlst) | 409 ((doc$ doctor--whysay)(doc$ doctor--history) \? ))) |
356 (setq sexlst | 410 (set (make-local-variable 'doctor--toklst) |
357 '(((doc$ areyou) (doc$ afraidof) sex \?) | 411 '((is this how you relax \?) |
358 ((doc$ describe)(doc$ something) about your sexual history \.) | 412 (how long have you been smoking grass \?) |
359 ((doc$ please)(doc$ describe) your sex life \.\.\.) | 413 ((doc$ doctor--areyou) (doc$ doctor--afraidof) of being drawn to using harder stuff \?))) |
360 ((doc$ describe) your (doc$ feelings-about) your sexual partner \.) | 414 (set (make-local-variable 'doctor--states) |
361 ((doc$ describe) your most (doc$ random-adjective) sexual experience \.) | 415 '((do you get (doc// doctor-found) often \?) |
362 ((doc$ areyou) satisfied with (doc// lover) \.\.\. \?))) | 416 (do you enjoy being (doc// doctor-found) \?) |
363 (make-local-variable 'neglst) | 417 (what makes you (doc// doctor-found) \?) |
364 (setq neglst | 418 (how often (doc$ doctor--areyou)(doc// doctor-found) \?) |
365 '((why not \?) | 419 (when were you last (doc// doctor-found) \?))) |
366 ((doc$ bother) i ask that \?) | 420 (set (make-local-variable 'doctor--replist) '((i . (you)) |
367 (why not \?) | 421 (my . (your)) |
368 (why not \?) | 422 (me . (you)) |
369 (how come \?) | 423 (you . (me)) |
370 ((doc$ bother) i ask that \?))) | 424 (your . (my)) |
371 (make-local-variable 'beclst) | 425 (mine . (yours)) |
372 (setq beclst '( | 426 (yours . (mine)) |
373 (is it because (doc// sent) that you came to me \?) | 427 (our . (your)) |
374 ((doc$ bother)(doc// sent) \?) | 428 (ours . (yours)) |
375 (when did you first know that (doc// sent) \?) | 429 (we . (you)) |
376 (is the fact that (doc// sent) the real reason \?) | 430 (dunno . (do not know)) |
377 (does the fact that (doc// sent) explain anything else \?) | 431 ;; (yes . ()) |
378 ((doc$ areyou)(doc$ sure)(doc// sent) \? ) )) | 432 (no\, . ()) |
379 (make-local-variable 'shortbeclst) | 433 (yes\, . ()) |
380 (setq shortbeclst '( | 434 (ya . (i)) |
381 ((doc$ bother) i ask you that \?) | 435 (aint . (am not)) |
382 (that\'s not much of an answer!) | 436 (wanna . (want to)) |
383 ((doc$ inter) why won\'t you talk about it \?) | 437 (gimme . (give me)) |
384 (speak up!) | 438 (gotta . (have to)) |
385 ((doc$ areyou) (doc$ afraidof) talking about it \?) | 439 (gonna . (going to)) |
386 (don\'t be (doc$ afraidof) elaborating \.) | 440 (never . (not ever)) |
387 ((doc$ please) go into more detail \.))) | 441 (doesn\'t . (does not)) |
388 (make-local-variable 'thlst) | 442 (don\'t . (do not)) |
389 (setq thlst '( | 443 (aren\'t . (are not)) |
390 ((doc$ maybe)(doc$ thing)(doc$ isrelated) this \.) | 444 (isn\'t . (is not)) |
391 ((doc$ maybe)(doc$ things)(doc$ arerelated) this \.) | 445 (won\'t . (will not)) |
392 (is it because of (doc$ things) that you are going through all this \?) | 446 (can\'t . (cannot)) |
393 (how do you reconcile (doc$ things) \? ) | 447 (haven\'t . (have not)) |
394 ((doc$ maybe) this (doc$ isrelated)(doc$ things) \?) )) | 448 (i\'m . (you are)) |
395 (make-local-variable 'remlst) | 449 (ourselves . (yourselves)) |
396 (setq remlst '( (earlier you said (doc$ history) \?) | 450 (myself . (yourself)) |
397 (you mentioned that (doc$ history) \?) | 451 (yourself . (myself)) |
398 ((doc$ whysay)(doc$ history) \? ) )) | 452 (you\'re . (i am)) |
399 (make-local-variable 'toklst) | 453 (you\'ve . (i have)) |
400 (setq toklst | 454 (i\'ve . (you have)) |
401 '((is this how you relax \?) | 455 (i\'ll . (you will)) |
402 (how long have you been smoking grass \?) | 456 (you\'ll . (i shall)) |
403 ((doc$ areyou) (doc$ afraidof) of being drawn to using harder stuff \?))) | 457 (i\'d . (you would)) |
404 (make-local-variable 'states) | 458 (you\'d . (i would)) |
405 (setq states | 459 (here . (there)) |
406 '((do you get (doc// found) often \?) | 460 (please . ()) |
407 (do you enjoy being (doc// found) \?) | 461 (eh\, . ()) |
408 (what makes you (doc// found) \?) | 462 (eh . ()) |
409 (how often (doc$ areyou)(doc// found) \?) | 463 (oh\, . ()) |
410 (when were you last (doc// found) \?))) | 464 (oh . ()) |
411 (make-local-variable 'replist) | 465 (shouldn\'t . (should not)) |
412 (setq replist | 466 (wouldn\'t . (would not)) |
413 '((i . (you)) | 467 (won\'t . (will not)) |
414 (my . (your)) | 468 (hasn\'t . (has not)))) |
415 (me . (you)) | 469 (set (make-local-variable 'doctor--stallmanlst) |
416 (you . (me)) | 470 '(((doc$ doctor--describe) your (doc$ doctor--feelings-about) him \.) |
417 (your . (my)) | 471 ((doc$ doctor--areyou) a friend of Stallman \?) |
418 (mine . (yours)) | 472 ((doc$ doctor--bother) Stallman is (doc$ doctor--random-adjective) \?) |
419 (yours . (mine)) | 473 ((doc$ doctor--ibelieve) you are (doc$ doctor--afraidof) him \.))) |
420 (our . (your)) | 474 (set (make-local-variable 'doctor--schoollst) |
421 (ours . (yours)) | 475 '(((doc$ doctor--describe) your (doc// doctor-found) \.) |
422 (we . (you)) | 476 ((doc$ doctor--bother) your grades could (doc$ doctor--improve) \?) |
423 (dunno . (do not know)) | 477 ((doc$ doctor--areyou) (doc$ doctor--afraidof) (doc// doctor-found) \?) |
424 ;; (yes . ()) | 478 ((doc$ doctor--maybe) this (doc$ doctor--isrelated) to your attitude \.) |
425 (no\, . ()) | 479 ((doc$ doctor--areyou) absent often \?) |
426 (yes\, . ()) | 480 ((doc$ doctor--maybe) you should study (doc$ doctor--something) \.))) |
427 (ya . (i)) | 481 (set (make-local-variable 'doctor--improve) |
428 (aint . (am not)) | 482 '((improve) (be better) (be improved) (be higher))) |
429 (wanna . (want to)) | 483 (set (make-local-variable 'doctor--elizalst) |
430 (gimme . (give me)) | 484 '(((doc$ doctor--areyou) (doc$ doctor--sure) \?) |
431 (gotta . (have to)) | 485 ((doc$ doctor--ibelieve) you have (doc$ doctor--problems) with (doc// doctor-found) \.) |
432 (gonna . (going to)) | 486 ((doc$ doctor--whysay) (doc// doctor-sent) \?))) |
433 (never . (not ever)) | 487 (set (make-local-variable 'doctor--sportslst) |
434 (doesn\'t . (does not)) | 488 '((tell me (doc$ doctor--something) about (doc// doctor-found) \.) |
435 (don\'t . (do not)) | 489 ((doc$ doctor--describe) (doc$ doctor--relation) (doc// doctor-found) \.) |
436 (aren\'t . (are not)) | 490 (do you find (doc// doctor-found) (doc$ doctor--random-adjective) \?))) |
437 (isn\'t . (is not)) | 491 (set (make-local-variable 'doctor--mathlst) |
438 (won\'t . (will not)) | 492 '(((doc$ doctor--describe) (doc$ doctor--something) about math \.) |
439 (can\'t . (cannot)) | 493 ((doc$ doctor--maybe) your (doc$ doctor--problems) (doc$ doctor--arerelated) (doc// doctor-found) \.) |
440 (haven\'t . (have not)) | 494 (i don\'t know much (doc// doctor-found) \, but (doc$ doctor--continue) |
441 (i\'m . (you are)) | 495 anyway \.))) |
442 (ourselves . (yourselves)) | 496 (set (make-local-variable 'doctor--zippylst) |
443 (myself . (yourself)) | 497 '(((doc$ doctor--areyou) Zippy \?) |
444 (yourself . (myself)) | 498 ((doc$ doctor--ibelieve) you have some serious (doc$ doctor--problems) \.) |
445 (you\'re . (i am)) | 499 ((doc$ doctor--bother) you are a pinhead \?))) |
446 (you\'ve . (i have)) | 500 (set (make-local-variable 'doctor--chatlst) |
447 (i\'ve . (you have)) | 501 '(((doc$ doctor--maybe) we could chat \.) |
448 (i\'ll . (you will)) | 502 ((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--something) about chat mode \.) |
449 (you\'ll . (i shall)) | 503 ((doc$ doctor--bother) our discussion is so (doc$ doctor--random-adjective) \?))) |
450 (i\'d . (you would)) | 504 (set (make-local-variable 'doctor--abuselst) |
451 (you\'d . (i would)) | 505 '(((doc$ doctor--please) try to be less abusive \.) |
452 (here . (there)) | 506 ((doc$ doctor--describe) why you call me (doc// doctor-found) \.) |
453 (please . ()) | 507 (i\'ve had enough of you!))) |
454 (eh\, . ()) | 508 (set (make-local-variable 'doctor--abusewords) |
455 (eh . ()) | 509 '(boring bozo clown clumsy cretin dumb dummy |
456 (oh\, . ()) | 510 fool foolish gnerd gnurd idiot jerk |
457 (oh . ()) | 511 lose loser louse lousy luse luser |
458 (shouldn\'t . (should not)) | 512 moron nerd nurd oaf oafish reek |
459 (wouldn\'t . (would not)) | 513 stink stupid tool toolish twit)) |
460 (won\'t . (will not)) | 514 (set (make-local-variable 'doctor--howareyoulst) |
461 (hasn\'t . (has not)))) | 515 '((how are you) (hows it going) (hows it going eh) |
462 (make-local-variable 'stallmanlst) | 516 (how\'s it going) (how\'s it going eh) (how goes it) |
463 (setq stallmanlst '( | 517 (whats up) (whats new) (what\'s up) (what\'s new) |
464 ((doc$ describe) your (doc$ feelings-about) him \.) | 518 (howre you) (how\'re you) (how\'s everything) |
465 ((doc$ areyou) a friend of Stallman \?) | 519 (how is everything) (how do you do) |
466 ((doc$ bother) Stallman is (doc$ random-adjective) \?) | 520 (how\'s it hanging) (que pasa) |
467 ((doc$ ibelieve) you are (doc$ afraidof) him \.))) | 521 (how are you doing) (what do you say))) |
468 (make-local-variable 'schoollst) | 522 (set (make-local-variable 'doctor--whereoutp) '(huh remem rthing)) |
469 (setq schoollst '( | 523 (set (make-local-variable 'doctor-subj) nil) |
470 ((doc$ describe) your (doc// found) \.) | 524 (set (make-local-variable 'doctor-verb) nil) |
471 ((doc$ bother) your grades could (doc$ improve) \?) | 525 (set (make-local-variable 'doctor-obj) nil) |
472 ((doc$ areyou) (doc$ afraidof) (doc// found) \?) | 526 (set (make-local-variable 'doctor--feared) nil) |
473 ((doc$ maybe) this (doc$ isrelated) to your attitude \.) | 527 (set (make-local-variable 'doctor--repetitive-shortness) '(0 . 0)) |
474 ((doc$ areyou) absent often \?) | 528 (set (make-local-variable 'doctor--**mad**) nil) |
475 ((doc$ maybe) you should study (doc$ something) \.))) | 529 (set (make-local-variable 'doctor--rms-flag) nil) |
476 (make-local-variable 'improve) | 530 (set (make-local-variable 'doctor--eliza-flag) nil) |
477 (setq improve '((improve) (be better) (be improved) (be higher))) | 531 (set (make-local-variable 'doctor--zippy-flag) nil) |
478 (make-local-variable 'elizalst) | 532 (set (make-local-variable 'doctor--suicide-flag) nil) |
479 (setq elizalst '( | 533 (set (make-local-variable 'doctor--lover) '(your partner)) |
480 ((doc$ areyou) (doc$ sure) \?) | 534 (set (make-local-variable 'doctor--bak) nil) |
481 ((doc$ ibelieve) you have (doc$ problems) with (doc// found) \.) | 535 (set (make-local-variable 'doctor--lincount) 0) |
482 ((doc$ whysay) (doc// sent) \?))) | 536 (set (make-local-variable 'doctor--*print-upcase*) nil) |
483 (make-local-variable 'sportslst) | 537 (set (make-local-variable 'doctor--*print-space*) nil) |
484 (setq sportslst '( | 538 (set (make-local-variable 'doctor--howdyflag) nil) |
485 (tell me (doc$ something) about (doc// found) \.) | 539 (set (make-local-variable 'doctor-object) nil)) |
486 ((doc$ describe) (doc$ relation) (doc// found) \.) | |
487 (do you find (doc// found) (doc$ random-adjective) \?))) | |
488 (make-local-variable 'mathlst) | |
489 (setq mathlst '( | |
490 ((doc$ describe) (doc$ something) about math \.) | |
491 ((doc$ maybe) your (doc$ problems) (doc$ arerelated) (doc// found) \.) | |
492 (i don\'t know much (doc// found) \, but (doc$ continue) | |
493 anyway \.))) | |
494 (make-local-variable 'zippylst) | |
495 (setq zippylst '( | |
496 ((doc$ areyou) Zippy \?) | |
497 ((doc$ ibelieve) you have some serious (doc$ problems) \.) | |
498 ((doc$ bother) you are a pinhead \?))) | |
499 (make-local-variable 'chatlst) | |
500 (setq chatlst '( | |
501 ((doc$ maybe) we could chat \.) | |
502 ((doc$ please) (doc$ describe) (doc$ something) about chat mode \.) | |
503 ((doc$ bother) our discussion is so (doc$ random-adjective) \?))) | |
504 (make-local-variable 'abuselst) | |
505 (setq abuselst '( | |
506 ((doc$ please) try to be less abusive \.) | |
507 ((doc$ describe) why you call me (doc// found) \.) | |
508 (i\'ve had enough of you!))) | |
509 (make-local-variable 'abusewords) | |
510 (setq abusewords '(boring bozo clown clumsy cretin dumb dummy | |
511 fool foolish gnerd gnurd idiot jerk | |
512 lose loser louse lousy luse luser | |
513 moron nerd nurd oaf oafish reek | |
514 stink stupid tool toolish twit)) | |
515 (make-local-variable 'howareyoulst) | |
516 (setq howareyoulst '((how are you) (hows it going) (hows it going eh) | |
517 (how\'s it going) (how\'s it going eh) (how goes it) | |
518 (whats up) (whats new) (what\'s up) (what\'s new) | |
519 (howre you) (how\'re you) (how\'s everything) | |
520 (how is everything) (how do you do) | |
521 (how\'s it hanging) (que pasa) | |
522 (how are you doing) (what do you say))) | |
523 (make-local-variable 'whereoutp) | |
524 (setq whereoutp '( huh remem rthing ) ) | |
525 (make-local-variable 'subj) | |
526 (setq subj nil) | |
527 (make-local-variable 'verb) | |
528 (setq verb nil) | |
529 (make-local-variable 'obj) | |
530 (setq obj nil) | |
531 (make-local-variable 'feared) | |
532 (setq feared nil) | |
533 (make-local-variable 'repetitive-shortness) | |
534 (setq repetitive-shortness '(0 . 0)) | |
535 (make-local-variable '**mad**) | |
536 (setq **mad** nil) | |
537 (make-local-variable 'rms-flag) | |
538 (setq rms-flag nil) | |
539 (make-local-variable 'eliza-flag) | |
540 (setq eliza-flag nil) | |
541 (make-local-variable 'zippy-flag) | |
542 (setq zippy-flag nil) | |
543 (make-local-variable 'suicide-flag) | |
544 (setq suicide-flag nil) | |
545 (make-local-variable 'lover) | |
546 (setq lover '(your partner)) | |
547 (make-local-variable 'bak) | |
548 (setq bak nil) | |
549 (make-local-variable 'lincount) | |
550 (setq lincount 0) | |
551 (make-local-variable '*print-upcase*) | |
552 (setq *print-upcase* nil) | |
553 (make-local-variable '*print-space*) | |
554 (setq *print-space* nil) | |
555 (make-local-variable 'howdyflag) | |
556 (setq howdyflag nil) | |
557 (make-local-variable 'object) | |
558 (setq object nil)) | |
559 | 540 |
560 ;; Define equivalence classes of words that get treated alike. | 541 ;; Define equivalence classes of words that get treated alike. |
561 | 542 |
562 (defun doctor-meaning (x) (get x 'doctor-meaning)) | 543 (defun doctor-meaning (x) (get x 'doctor-meaning)) |
563 | 544 |
564 (defmacro doctor-put-meaning (symb val) | 545 (defmacro doctor-put-meaning (symb val) |
565 "Store the base meaning of a word on the property list." | 546 "Store the base meaning of a word on the property list." |
566 (list 'put (list 'quote symb) ''doctor-meaning val)) | 547 `(put ',symb 'doctor-meaning ,val)) |
567 | 548 |
568 (doctor-put-meaning howdy 'howdy) | 549 (doctor-put-meaning howdy 'howdy) |
569 (doctor-put-meaning hi 'howdy) | 550 (doctor-put-meaning hi 'howdy) |
570 (doctor-put-meaning greetings 'howdy) | 551 (doctor-put-meaning greetings 'howdy) |
571 (doctor-put-meaning hello 'howdy) | 552 (doctor-put-meaning hello 'howdy) |
853 (defun doctor-read-print nil | 834 (defun doctor-read-print nil |
854 "top level loop" | 835 "top level loop" |
855 (interactive) | 836 (interactive) |
856 (let ((sent (doctor-readin))) | 837 (let ((sent (doctor-readin))) |
857 (insert "\n") | 838 (insert "\n") |
858 (setq lincount (1+ lincount)) | 839 (setq doctor--lincount (1+ doctor--lincount)) |
859 (doctor-doc sent) | 840 (doctor-doc sent) |
860 (insert "\n") | 841 (insert "\n") |
861 (setq bak sent))) | 842 (setq doctor--bak sent))) |
862 | 843 |
863 (defun doctor-readin nil | 844 (defun doctor-readin nil |
864 "Read a sentence. Return it as a list of words." | 845 "Read a sentence. Return it as a list of words." |
865 (let (sentence) | 846 (let (sentence) |
866 (backward-sentence 1) | 847 (backward-sentence 1) |
876 (point))))) | 857 (point))))) |
877 (re-search-forward "\\Sw*"))) | 858 (re-search-forward "\\Sw*"))) |
878 | 859 |
879 ;; Main processing function for sentences that have been read. | 860 ;; Main processing function for sentences that have been read. |
880 | 861 |
881 (defun doctor-doc (sent) | 862 (defun doctor-doc (doctor-sent) |
882 (cond | 863 (cond |
883 ((equal sent '(foo)) | 864 ((equal doctor-sent '(foo)) |
884 (doctor-type '(bar! (doc$ please)(doc$ continue) \.))) | 865 (doctor-type '(bar! (doc$ doctor--please)(doc$ doctor--continue) \.))) |
885 ((member sent howareyoulst) | 866 ((member doctor-sent doctor--howareyoulst) |
886 (doctor-type '(i\'m ok \. (doc$ describe) yourself \.))) | 867 (doctor-type '(i\'m ok \. (doc$ doctor--describe) yourself \.))) |
887 ((or (member sent '((good bye) (see you later) (i quit) (so long) | 868 ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long) |
888 (go away) (get lost))) | 869 (go away) (get lost))) |
889 (memq (car sent) | 870 (memq (car doctor-sent) |
890 '(bye halt break quit done exit goodbye | 871 '(bye halt break quit done exit goodbye |
891 bye\, stop pause goodbye\, stop pause))) | 872 bye\, stop pause goodbye\, stop pause))) |
892 (doctor-type (doc$ bye))) | 873 (doctor-type (doc$ doctor--bye))) |
893 ((and (eq (car sent) 'you) | 874 ((and (eq (car doctor-sent) 'you) |
894 (memq (cadr sent) abusewords)) | 875 (memq (cadr doctor-sent) doctor--abusewords)) |
895 (setq found (cadr sent)) | 876 (setq doctor-found (cadr doctor-sent)) |
896 (doctor-type (doc$ abuselst))) | 877 (doctor-type (doc$ doctor--abuselst))) |
897 ((eq (car sent) 'whatmeans) | 878 ((eq (car doctor-sent) 'whatmeans) |
898 (doctor-def (cadr sent))) | 879 (doctor-def (cadr doctor-sent))) |
899 ((equal sent '(parse)) | 880 ((equal doctor-sent '(parse)) |
900 (doctor-type (list 'subj '= subj ", " | 881 (doctor-type (list 'subj '= doctor-subj ", " |
901 'verb '= verb "\n" | 882 'verb '= doctor-verb "\n" |
902 'object 'phrase '= obj "," | 883 'object 'phrase '= doctor-obj "," |
903 'noun 'form '= object "\n" | 884 'noun 'form '= doctor-object "\n" |
904 'current 'keyword 'is found | 885 'current 'keyword 'is doctor-found |
905 ", " | 886 ", " |
906 'most 'recent 'possessive | 887 'most 'recent 'possessive |
907 'is owner "\n" | 888 'is doctor-owner "\n" |
908 'sentence 'used 'was | 889 'sentence 'used 'was |
909 "..." | 890 "..." |
910 '(doc// bak)))) | 891 '(doc// doctor--bak)))) |
911 ((memq (car sent) '(are is do has have how when where who why)) | 892 ((memq (car doctor-sent) '(are is do has have how when where who why)) |
912 (doctor-type (doc$ qlist))) | 893 (doctor-type (doc$ doctor--qlist))) |
913 ;; ((eq (car sent) 'forget) | 894 ;; ((eq (car doctor-sent) 'forget) |
914 ;; (set (cadr sent) nil) | 895 ;; (set (cadr doctor-sent) nil) |
915 ;; (doctor-type '((doc$ isee)(doc$ please) | 896 ;; (doctor-type '((doc$ doctor--isee)(doc$ doctor--please) |
916 ;; (doc$ continue)\.))) | 897 ;; (doc$ doctor--continue)\.))) |
917 (t | 898 (t |
918 (if (doctor-defq sent) (doctor-define sent found)) | 899 (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found)) |
919 (if (> (length sent) 12)(setq sent (doctor-shorten sent))) | 900 (if (> (length doctor-sent) 12)(setq doctor-sent (doctor-shorten doctor-sent))) |
920 (setq sent (doctor-correct-spelling (doctor-replace sent replist))) | 901 (setq doctor-sent (doctor-correct-spelling (doctor-replace doctor-sent doctor--replist))) |
921 (cond ((and (not (memq 'me sent))(not (memq 'i sent)) | 902 (cond ((and (not (memq 'me doctor-sent))(not (memq 'i doctor-sent)) |
922 (memq 'am sent)) | 903 (memq 'am doctor-sent)) |
923 (setq sent (doctor-replace sent '((am . (are))))))) | 904 (setq doctor-sent (doctor-replace doctor-sent '((am . (are))))))) |
924 (cond ((equal (car sent) 'yow) (doctor-zippy)) | 905 (cond ((equal (car doctor-sent) 'yow) (doctor-zippy)) |
925 ((< (length sent) 2) | 906 ((< (length doctor-sent) 2) |
926 (cond ((eq (doctor-meaning (car sent)) 'howdy) | 907 (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy) |
927 (doctor-howdy)) | 908 (doctor-howdy)) |
928 (t (doctor-short)))) | 909 (t (doctor-short)))) |
929 (t | 910 (t |
930 (if (memq 'am sent) | 911 (if (memq 'am doctor-sent) |
931 (setq sent (doctor-replace sent '((me . (i)))))) | 912 (setq doctor-sent (doctor-replace doctor-sent '((me . (i)))))) |
932 (setq sent (doctor-fixup sent)) | 913 (setq doctor-sent (doctor-fixup doctor-sent)) |
933 (if (and (eq (car sent) 'do) (eq (cadr sent) 'not)) | 914 (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not)) |
934 (cond ((zerop (random 3)) | 915 (cond ((zerop (random 3)) |
935 (doctor-type '(are you (doc$ afraidof) that \?))) | 916 (doctor-type '(are you (doc$ doctor--afraidof) that \?))) |
936 ((zerop (random 2)) | 917 ((zerop (random 2)) |
937 (doctor-type '(don\'t tell me what to do \. i am the | 918 (doctor-type '(don\'t tell me what to do \. i am the |
938 doctor here!)) | 919 doctor here!)) |
939 (doctor-rthing)) | 920 (doctor-rthing)) |
940 (t | 921 (t |
941 (doctor-type '((doc$ whysay) that i shouldn\'t | 922 (doctor-type '((doc$ doctor--whysay) that i shouldn\'t |
942 (cddr sent) | 923 (cddr doctor-sent) |
943 \?)))) | 924 \?)))) |
944 (doctor-go (doctor-wherego sent)))))))) | 925 (doctor-go (doctor-wherego doctor-sent)))))))) |
945 | 926 |
946 ;; Things done to process sentences once read. | 927 ;; Things done to process sentences once read. |
947 | 928 |
948 (defun doctor-correct-spelling (sent) | 929 (defun doctor-correct-spelling (sent) |
949 "Correct the spelling and expand each word in sentence." | 930 "Correct the spelling and expand each word in sentence." |
950 (if sent | 931 (if sent |
951 (apply 'append (mapcar (lambda (word) | 932 (apply 'append (mapcar (lambda (word) |
952 (if (memq word typos) | 933 (if (memq word doctor--typos) |
953 (get (get word 'doctor-correction) 'doctor-expansion) | 934 (get (get word 'doctor-correction) |
935 'doctor-expansion) | |
954 (list word))) | 936 (list word))) |
955 sent)))) | 937 sent)))) |
956 | 938 |
957 (defun doctor-shorten (sent) | 939 (defun doctor-shorten (sent) |
958 "Make a sentence manageably short using a few hacks." | 940 "Make a sentence manageably short using a few hacks." |
970 retval)) | 952 retval)) |
971 | 953 |
972 (defun doctor-define (sent found) | 954 (defun doctor-define (sent found) |
973 (doctor-svo sent found 1 nil) | 955 (doctor-svo sent found 1 nil) |
974 (and | 956 (and |
975 (doctor-nounp subj) | 957 (doctor-nounp doctor-subj) |
976 (not (doctor-pronounp subj)) | 958 (not (doctor-pronounp doctor-subj)) |
977 subj | 959 doctor-subj |
978 (doctor-meaning object) | 960 (doctor-meaning doctor-object) |
979 (put subj 'doctor-meaning (doctor-meaning object)) | 961 (put doctor-subj 'doctor-meaning (doctor-meaning doctor-object)) |
980 t)) | 962 t)) |
981 | 963 |
982 (defun doctor-defq (sent) | 964 (defun doctor-defq (sent) |
983 "Set global var FOUND to first keyword found in sentence SENT." | 965 "Set global var DOCTOR-FOUND to first keyword found in sentence SENT." |
984 (setq found nil) | 966 (setq doctor-found nil) |
985 (let ((temp '(means applies mean refers refer related | 967 (let ((temp '(means applies mean refers refer related |
986 similar defined associated linked like same))) | 968 similar defined associated linked like same))) |
987 (while temp | 969 (while temp |
988 (if (memq (car temp) sent) | 970 (if (memq (car temp) sent) |
989 (setq found (car temp) | 971 (setq doctor-found (car temp) |
990 temp nil) | 972 temp nil) |
991 (setq temp (cdr temp))))) | 973 (setq temp (cdr temp))))) |
992 found) | 974 doctor-found) |
993 | 975 |
994 (defun doctor-def (x) | 976 (defun doctor-def (x) |
995 (progn | 977 (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me)) |
996 (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me)) | 978 nil) |
997 nil)) | |
998 | 979 |
999 (defun doctor-forget () | 980 (defun doctor-forget () |
1000 "Delete the last element of the history list." | 981 "Delete the last element of the history list." |
1001 (setq history (reverse (cdr (reverse history))))) | 982 (setq doctor--history (reverse (cdr (reverse doctor--history))))) |
1002 | 983 |
1003 (defun doctor-query (x) | 984 (defun doctor-query (x) |
1004 "Prompt for a line of input from the minibuffer until a noun or verb is seen. | 985 "Prompt for a line of input from the minibuffer until a noun or verb is seen. |
1005 Put dialogue in buffer." | 986 Put dialogue in buffer." |
1006 (let (a | 987 (let (a |
1024 ((setq a (cdr a)))))) | 1005 ((setq a (cdr a)))))) |
1025 retval)) | 1006 retval)) |
1026 | 1007 |
1027 (defun doctor-subjsearch (sent key type) | 1008 (defun doctor-subjsearch (sent key type) |
1028 "Search for the subject of a sentence SENT, looking for the noun closest | 1009 "Search for the subject of a sentence SENT, looking for the noun closest |
1029 to and preceding KEY by at least TYPE words. Set global variable subj to | 1010 to and preceding KEY by at least TYPE words. Set global variable doctor-subj to |
1030 the subject noun, and return the portion of the sentence following it." | 1011 the subject noun, and return the portion of the sentence following it." |
1031 (let ((i (- (length sent) (length (memq key sent)) type))) | 1012 (let ((i (- (length sent) (length (memq key sent)) type))) |
1032 (while (and (> i -1) (not (doctor-nounp (nth i sent)))) | 1013 (while (and (> i -1) (not (doctor-nounp (nth i sent)))) |
1033 (setq i (1- i))) | 1014 (setq i (1- i))) |
1034 (cond ((> i -1) | 1015 (cond ((> i -1) |
1035 (setq subj (nth i sent)) | 1016 (setq doctor-subj (nth i sent)) |
1036 (nthcdr (1+ i) sent)) | 1017 (nthcdr (1+ i) sent)) |
1037 (t | 1018 (t |
1038 (setq subj 'you) | 1019 (setq doctor-subj 'you) |
1039 nil)))) | 1020 nil)))) |
1040 | 1021 |
1041 (defun doctor-nounp (x) | 1022 (defun doctor-nounp (x) |
1042 "Returns t if the symbol argument is a noun." | 1023 "Returns t if the symbol argument is a noun." |
1043 (or (doctor-pronounp x) | 1024 (or (doctor-pronounp x) |
1147 (cond (val (doctor-build (doctor-build (cadr foo) " ") val)) | 1128 (cond (val (doctor-build (doctor-build (cadr foo) " ") val)) |
1148 (t 'something))) | 1129 (t 'something))) |
1149 (t 'something)))) | 1130 (t 'something)))) |
1150 | 1131 |
1151 (defun doctor-getnoun (x) | 1132 (defun doctor-getnoun (x) |
1152 (cond ((null x)(setq object 'something)) | 1133 (cond ((null x)(setq doctor-object 'something)) |
1153 ((atom x)(setq object x)) | 1134 ((atom x)(setq doctor-object x)) |
1154 ((eq (length x) 1) | 1135 ((eq (length x) 1) |
1155 (setq object (cond | 1136 (setq doctor-object (cond |
1156 ((doctor-nounp (setq object (car x))) object) | 1137 ((doctor-nounp (setq doctor-object (car x))) doctor-object) |
1157 (t (doctor-query object))))) | 1138 (t (doctor-query doctor-object))))) |
1158 ((eq (car x) 'to) | 1139 ((eq (car x) 'to) |
1159 (doctor-build 'to\ (doctor-getnoun (cdr x)))) | 1140 (doctor-build 'to\ (doctor-getnoun (cdr x)))) |
1160 ((doctor-prepp (car x)) | 1141 ((doctor-prepp (car x)) |
1161 (doctor-getnoun (cdr x))) | 1142 (doctor-getnoun (cdr x))) |
1162 ((not (doctor-nounp (car x))) | 1143 ((not (doctor-nounp (car x))) |
1168 (list | 1149 (list |
1169 (cons | 1150 (cons |
1170 (car x) (car x)))))) | 1151 (car x) (car x)))))) |
1171 " ") | 1152 " ") |
1172 (doctor-getnoun (cdr x)))) | 1153 (doctor-getnoun (cdr x)))) |
1173 (t (setq object (car x)) | 1154 (t (setq doctor-object (car x)) |
1174 (doctor-build (doctor-build (car x) " ") (doctor-getnoun (cdr x)))) | 1155 (doctor-build (doctor-build (car x) " ") (doctor-getnoun (cdr x)))) |
1175 )) | 1156 )) |
1176 | 1157 |
1177 (defun doctor-modifierp (x) | 1158 (defun doctor-modifierp (x) |
1178 (or (doctor-adjectivep x) | 1159 (or (doctor-adjectivep x) |
1236 like near next of on onto over | 1217 like near next of on onto over |
1237 same through thru to toward towards | 1218 same through thru to toward towards |
1238 under underneath with without))) | 1219 under underneath with without))) |
1239 | 1220 |
1240 (defun doctor-remember (thing) | 1221 (defun doctor-remember (thing) |
1241 (cond ((null history) | 1222 (cond ((null doctor--history) |
1242 (setq history (list thing))) | 1223 (setq doctor--history (list thing))) |
1243 (t (setq history (append history (list thing)))))) | 1224 (t (setq doctor--history (append doctor--history (list thing)))))) |
1244 | 1225 |
1245 (defun doctor-type (x) | 1226 (defun doctor-type (x) |
1246 (setq x (doctor-fix-2 x)) | 1227 (setq x (doctor-fix-2 x)) |
1247 (doctor-txtype (doctor-assm x))) | 1228 (doctor-txtype (doctor-assm x))) |
1248 | 1229 |
1315 (defun doctor-replace (sent rlist) | 1296 (defun doctor-replace (sent rlist) |
1316 "Replace any element of SENT that is the car of a replacement | 1297 "Replace any element of SENT that is the car of a replacement |
1317 element pair in RLIST." | 1298 element pair in RLIST." |
1318 (apply 'append | 1299 (apply 'append |
1319 (mapcar | 1300 (mapcar |
1320 (function | |
1321 (lambda (x) | 1301 (lambda (x) |
1322 (cdr (or (assq x rlist) ; either find a replacement | 1302 (cdr (or (assq x rlist) ; either find a replacement |
1323 (list x x))))) ; or fake an identity mapping | 1303 (list x x)))) ; or fake an identity mapping |
1324 sent))) | 1304 sent))) |
1325 | 1305 |
1326 (defun doctor-wherego (sent) | 1306 (defun doctor-wherego (sent) |
1327 (cond ((null sent)(doc$ whereoutp)) | 1307 (cond ((null sent)(doc$ doctor--whereoutp)) |
1328 ((null (doctor-meaning (car sent))) | 1308 ((null (doctor-meaning (car sent))) |
1329 (doctor-wherego (cond ((zerop (random 2)) | 1309 (doctor-wherego (cond ((zerop (random 2)) |
1330 (reverse (cdr sent))) | 1310 (reverse (cdr sent))) |
1331 (t (cdr sent))))) | 1311 (t (cdr sent))))) |
1332 (t | 1312 (t |
1333 (setq found (car sent)) | 1313 (setq doctor-found (car sent)) |
1334 (doctor-meaning (car sent))))) | 1314 (doctor-meaning (car sent))))) |
1335 | 1315 |
1336 (defun doctor-svo (sent key type mem) | 1316 (defun doctor-svo (sent key type mem) |
1337 "Find subject, verb and object in sentence SENT with focus on word KEY. | 1317 "Find subject, verb and object in sentence SENT with focus on word KEY. |
1338 TYPE is number of words preceding KEY to start looking for subject. | 1318 TYPE is number of words preceding KEY to start looking for subject. |
1339 MEM is t if results are to be put on Doctor's memory stack. | 1319 MEM is t if results are to be put on Doctor's memory stack. |
1340 Return in the global variables SUBJ, VERB and OBJECT." | 1320 Return in the global variables DOCTOR-SUBJ, DOCTOR-VERB, DOCTOR-OBJECT, |
1321 and DOCTOR-OBJ." | |
1341 (let ((foo (doctor-subjsearch sent key type))) | 1322 (let ((foo (doctor-subjsearch sent key type))) |
1342 (or foo | 1323 (or foo |
1343 (setq foo sent | 1324 (setq foo sent |
1344 mem nil)) | 1325 mem nil)) |
1345 (while (and (null (doctor-verbp (car foo))) (cdr foo)) | 1326 (while (and (null (doctor-verbp (car foo))) (cdr foo)) |
1346 (setq foo (cdr foo))) | 1327 (setq foo (cdr foo))) |
1347 (setq verb (car foo)) | 1328 (setq doctor-verb (car foo)) |
1348 (setq obj (doctor-getnoun (cdr foo))) | 1329 (setq doctor-obj (doctor-getnoun (cdr foo))) |
1349 (cond ((eq object 'i)(setq object 'me)) | 1330 (cond ((eq doctor-object 'i)(setq doctor-object 'me)) |
1350 ((eq subj 'me)(setq subj 'i))) | 1331 ((eq doctor-subj 'me)(setq doctor-subj 'i))) |
1351 (cond (mem (doctor-remember (list subj verb obj)))))) | 1332 (cond (mem (doctor-remember (list doctor-subj doctor-verb doctor-obj)))))) |
1352 | 1333 |
1353 (defun doctor-possess (sent key) | 1334 (defun doctor-possess (sent key) |
1354 "Set possessive in SENT for keyword KEY. | 1335 "Set possessive in SENT for keyword KEY. |
1355 Hack on previous word, setting global variable OWNER to correct result." | 1336 Hack on previous word, setting global variable DOCTOR-OWNER to correct result." |
1356 (let* ((i (- (length sent) (length (memq key sent)) 1)) | 1337 (let* ((i (- (length sent) (length (memq key sent)) 1)) |
1357 (prev (if (< i 0) 'your | 1338 (prev (if (< i 0) 'your |
1358 (nth i sent)))) | 1339 (nth i sent)))) |
1359 (setq owner (if (or (doctor-possessivepronounp prev) | 1340 (setq doctor-owner |
1360 (string-equal "s" | 1341 (if (or (doctor-possessivepronounp prev) |
1361 (substring (doctor-make-string prev) | 1342 (string-equal "s" |
1362 -1))) | 1343 (substring (doctor-make-string prev) |
1363 prev | 1344 -1))) |
1364 'your)))) | 1345 prev |
1346 'your)))) | |
1365 | 1347 |
1366 ;; Output of replies. | 1348 ;; Output of replies. |
1367 | 1349 |
1368 (defun doctor-txtype (ans) | 1350 (defun doctor-txtype (ans) |
1369 "Output to buffer a list of symbols or strings as a sentence." | 1351 "Output to buffer a list of symbols or strings as a sentence." |
1370 (setq *print-upcase* t *print-space* nil) | 1352 (setq doctor--*print-upcase* t doctor--*print-space* nil) |
1371 (mapc 'doctor-type-symbol ans) | 1353 (mapc 'doctor-type-symbol ans) |
1372 (insert "\n")) | 1354 (insert "\n")) |
1373 | 1355 |
1374 (defun doctor-type-symbol (word) | 1356 (defun doctor-type-symbol (word) |
1375 "Output a symbol to the buffer with some fancy case and spacing hacks." | 1357 "Output a symbol to the buffer with some fancy case and spacing hacks." |
1376 (setq word (doctor-make-string word)) | 1358 (setq word (doctor-make-string word)) |
1377 (if (string-equal word "i") (setq word "I")) | 1359 (if (string-equal word "i") (setq word "I")) |
1378 (if *print-upcase* | 1360 (when doctor--*print-upcase* |
1379 (progn | 1361 (setq word (capitalize word)) |
1380 (setq word (capitalize word)) | 1362 (if doctor--*print-space* (insert " "))) |
1381 (if *print-space* | |
1382 (insert " ")))) | |
1383 (cond ((or (string-match "^[.,;:?! ]" word) | 1363 (cond ((or (string-match "^[.,;:?! ]" word) |
1384 (not *print-space*)) | 1364 (not doctor--*print-space*)) |
1385 (insert word)) | 1365 (insert word)) |
1386 (t (insert ?\s word))) | 1366 (t (insert ?\s word))) |
1387 (and auto-fill-function | 1367 (and auto-fill-function |
1388 (> (current-column) fill-column) | 1368 (> (current-column) fill-column) |
1389 (apply auto-fill-function nil)) | 1369 (apply auto-fill-function nil)) |
1390 (setq *print-upcase* (string-match "[.?!]$" word) | 1370 (setq doctor--*print-upcase* (string-match "[.?!]$" word) |
1391 *print-space* t)) | 1371 doctor--*print-space* t)) |
1392 | 1372 |
1393 (defun doctor-build (str1 str2) | 1373 (defun doctor-build (str1 str2) |
1394 "Make a symbol out of the concatenation of the two non-list arguments." | 1374 "Make a symbol out of the concatenation of the two non-list arguments." |
1395 (cond ((null str1) str2) | 1375 (cond ((null str1) str2) |
1396 ((null str2) str1) | 1376 ((null str2) str1) |
1424 (defun doctor-go (destination) | 1404 (defun doctor-go (destination) |
1425 "Call a `doctor-*' function." | 1405 "Call a `doctor-*' function." |
1426 (funcall (intern (concat "doctor-" (doctor-make-string destination))))) | 1406 (funcall (intern (concat "doctor-" (doctor-make-string destination))))) |
1427 | 1407 |
1428 (defun doctor-desire1 () | 1408 (defun doctor-desire1 () |
1429 (doctor-go (doc$ whereoutp))) | 1409 (doctor-go (doc$ doctor--whereoutp))) |
1430 | 1410 |
1431 (defun doctor-huh () | 1411 (defun doctor-huh () |
1432 (cond ((< (length sent) 9) (doctor-type (doc$ huhlst))) | 1412 (cond ((< (length doctor-sent) 9) (doctor-type (doc$ doctor--huhlst))) |
1433 (t (doctor-type (doc$ longhuhlst))))) | 1413 (t (doctor-type (doc$ doctor--longhuhlst))))) |
1434 | 1414 |
1435 (defun doctor-rthing () (doctor-type (doc$ thlst))) | 1415 (defun doctor-rthing () (doctor-type (doc$ doctor--thlst))) |
1436 | 1416 |
1437 (defun doctor-remem () (cond ((null history)(doctor-huh)) | 1417 (defun doctor-remem () (cond ((null doctor--history)(doctor-huh)) |
1438 ((doctor-type (doc$ remlst))))) | 1418 ((doctor-type (doc$ doctor--remlst))))) |
1439 | 1419 |
1440 (defun doctor-howdy () | 1420 (defun doctor-howdy () |
1441 (cond ((not howdyflag) | 1421 (cond ((not doctor--howdyflag) |
1442 (doctor-type '((doc$ hello) what brings you to see me \?)) | 1422 (doctor-type '((doc$ doctor--hello) what brings you to see me \?)) |
1443 (setq howdyflag t)) | 1423 (setq doctor--howdyflag t)) |
1444 (t | 1424 (t |
1445 (doctor-type '((doc$ ibelieve) we\'ve introduced ourselves already \.)) | 1425 (doctor-type '((doc$ doctor--ibelieve) we\'ve introduced ourselves already \.)) |
1446 (doctor-type '((doc$ please) (doc$ describe) (doc$ things) \.))))) | 1426 (doctor-type '((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--things) \.))))) |
1447 | 1427 |
1448 (defun doctor-when () | 1428 (defun doctor-when () |
1449 (cond ((< (length (memq found sent)) 3)(doctor-short)) | 1429 (cond ((< (length (memq doctor-found doctor-sent)) 3)(doctor-short)) |
1450 (t | 1430 (t |
1451 (setq sent (cdr (memq found sent))) | 1431 (setq doctor-sent (cdr (memq doctor-found doctor-sent))) |
1452 (setq sent (doctor-fixup sent)) | 1432 (setq doctor-sent (doctor-fixup doctor-sent)) |
1453 (doctor-type '((doc$ whatwhen)(doc// sent) \?))))) | 1433 (doctor-type '((doc$ doctor--whatwhen)(doc// doctor-sent) \?))))) |
1454 | 1434 |
1455 (defun doctor-conj () | 1435 (defun doctor-conj () |
1456 (cond ((< (length (memq found sent)) 4)(doctor-short)) | 1436 (cond ((< (length (memq doctor-found doctor-sent)) 4)(doctor-short)) |
1457 (t | 1437 (t |
1458 (setq sent (cdr (memq found sent))) | 1438 (setq doctor-sent (cdr (memq doctor-found doctor-sent))) |
1459 (setq sent (doctor-fixup sent)) | 1439 (setq doctor-sent (doctor-fixup doctor-sent)) |
1460 (cond ((eq (car sent) 'of) | 1440 (cond ((eq (car doctor-sent) 'of) |
1461 (doctor-type '(are you (doc$ sure) that is the real reason \?)) | 1441 (doctor-type '(are you (doc$ doctor--sure) that is the real reason \?)) |
1462 (setq things (cons (cdr sent) things))) | 1442 (setq doctor--things (cons (cdr doctor-sent) doctor--things))) |
1463 (t | 1443 (t |
1464 (doctor-remember sent) | 1444 (doctor-remember doctor-sent) |
1465 (doctor-type (doc$ beclst))))))) | 1445 (doctor-type (doc$ doctor--beclst))))))) |
1466 | 1446 |
1467 (defun doctor-short () | 1447 (defun doctor-short () |
1468 (cond ((= (car repetitive-shortness) (1- lincount)) | 1448 (cond ((= (car doctor--repetitive-shortness) (1- doctor--lincount)) |
1469 (rplacd repetitive-shortness | 1449 (rplacd doctor--repetitive-shortness |
1470 (1+ (cdr repetitive-shortness)))) | 1450 (1+ (cdr doctor--repetitive-shortness)))) |
1471 (t | 1451 (t |
1472 (rplacd repetitive-shortness 1))) | 1452 (rplacd doctor--repetitive-shortness 1))) |
1473 (rplaca repetitive-shortness lincount) | 1453 (rplaca doctor--repetitive-shortness doctor--lincount) |
1474 (cond ((> (cdr repetitive-shortness) 6) | 1454 (cond ((> (cdr doctor--repetitive-shortness) 6) |
1475 (cond ((not **mad**) | 1455 (cond ((not doctor--**mad**) |
1476 (doctor-type '((doc$ areyou) | 1456 (doctor-type '((doc$ doctor--areyou) |
1477 just trying to see what kind of things | 1457 just trying to see what kind of things |
1478 i have in my vocabulary \? please try to | 1458 i have in my vocabulary \? please try to |
1479 carry on a reasonable conversation!)) | 1459 carry on a reasonable conversation!)) |
1480 (setq **mad** t)) | 1460 (setq doctor--**mad** t)) |
1481 (t | 1461 (t |
1482 (doctor-type '(i give up \. you need a lesson in creative | 1462 (doctor-type '(i give up \. you need a lesson in creative |
1483 writing \.\.\.)) | 1463 writing \.\.\.)) |
1484 ))) | 1464 ))) |
1485 (t | 1465 (t |
1486 (cond ((equal sent (doctor-assm '(yes))) | 1466 (cond ((equal doctor-sent (doctor-assm '(yes))) |
1487 (doctor-type '((doc$ isee) (doc$ inter) (doc$ whysay) this is so \?))) | 1467 (doctor-type '((doc$ doctor--isee) (doc$ doctor--inter) (doc$ doctor--whysay) this is so \?))) |
1488 ((equal sent (doctor-assm '(because))) | 1468 ((equal doctor-sent (doctor-assm '(because))) |
1489 (doctor-type (doc$ shortbeclst))) | 1469 (doctor-type (doc$ doctor--shortbeclst))) |
1490 ((equal sent (doctor-assm '(no))) | 1470 ((equal doctor-sent (doctor-assm '(no))) |
1491 (doctor-type (doc$ neglst))) | 1471 (doctor-type (doc$ doctor--neglst))) |
1492 (t (doctor-type (doc$ shortlst))))))) | 1472 (t (doctor-type (doc$ doctor--shortlst))))))) |
1493 | 1473 |
1494 (defun doctor-alcohol () (doctor-type (doc$ drnk))) | 1474 (defun doctor-alcohol () (doctor-type (doc$ doctor--drnk))) |
1495 | 1475 |
1496 (defun doctor-desire () | 1476 (defun doctor-desire () |
1497 (let ((foo (memq found sent))) | 1477 (let ((foo (memq doctor-found doctor-sent))) |
1498 (cond ((< (length foo) 2) | 1478 (cond ((< (length foo) 2) |
1499 (doctor-go (doctor-build (doctor-meaning found) 1))) | 1479 (doctor-go (doctor-build (doctor-meaning doctor-found) 1))) |
1500 ((memq (cadr foo) '(a an)) | 1480 ((memq (cadr foo) '(a an)) |
1501 (rplacd foo (append '(to have) (cdr foo))) | 1481 (rplacd foo (append '(to have) (cdr foo))) |
1502 (doctor-svo sent found 1 nil) | 1482 (doctor-svo doctor-sent doctor-found 1 nil) |
1503 (doctor-remember (list subj 'would 'like obj)) | 1483 (doctor-remember (list doctor-subj 'would 'like doctor-obj)) |
1504 (doctor-type (doc$ whywant))) | 1484 (doctor-type (doc$ doctor--whywant))) |
1505 ((not (eq (cadr foo) 'to)) | 1485 ((not (eq (cadr foo) 'to)) |
1506 (doctor-go (doctor-build (doctor-meaning found) 1))) | 1486 (doctor-go (doctor-build (doctor-meaning doctor-found) 1))) |
1507 (t | 1487 (t |
1508 (doctor-svo sent found 1 nil) | 1488 (doctor-svo doctor-sent doctor-found 1 nil) |
1509 (doctor-remember (list subj 'would 'like obj)) | 1489 (doctor-remember (list doctor-subj 'would 'like doctor-obj)) |
1510 (doctor-type (doc$ whywant)))))) | 1490 (doctor-type (doc$ doctor--whywant)))))) |
1511 | 1491 |
1512 (defun doctor-drug () | 1492 (defun doctor-drug () |
1513 (doctor-type (doc$ drugs)) | 1493 (doctor-type (doc$ doctor--drugs)) |
1514 (doctor-remember (list 'you 'used found))) | 1494 (doctor-remember (list 'you 'used doctor-found))) |
1515 | 1495 |
1516 (defun doctor-toke () | 1496 (defun doctor-toke () |
1517 (doctor-type (doc$ toklst))) | 1497 (doctor-type (doc$ doctor--toklst))) |
1518 | 1498 |
1519 (defun doctor-state () | 1499 (defun doctor-state () |
1520 (doctor-type (doc$ states))(doctor-remember (list 'you 'were found))) | 1500 (doctor-type (doc$ doctor--states))(doctor-remember (list 'you 'were doctor-found))) |
1521 | 1501 |
1522 (defun doctor-mood () | 1502 (defun doctor-mood () |
1523 (doctor-type (doc$ moods))(doctor-remember (list 'you 'felt found))) | 1503 (doctor-type (doc$ doctor--moods))(doctor-remember (list 'you 'felt doctor-found))) |
1524 | 1504 |
1525 (defun doctor-fear () | 1505 (defun doctor-fear () |
1526 (setq feared (doctor-setprep sent found)) | 1506 (setq doctor--feared (doctor-setprep doctor-sent doctor-found)) |
1527 (doctor-type (doc$ fears)) | 1507 (doctor-type (doc$ doctor--fears)) |
1528 (doctor-remember (list 'you 'were 'afraid 'of feared))) | 1508 (doctor-remember (list 'you 'were 'afraid 'of doctor--feared))) |
1529 | 1509 |
1530 (defun doctor-hate () | 1510 (defun doctor-hate () |
1531 (doctor-svo sent found 1 t) | 1511 (doctor-svo doctor-sent doctor-found 1 t) |
1532 (cond ((memq 'not sent) (doctor-forget) (doctor-huh)) | 1512 (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh)) |
1533 ((equal subj 'you) | 1513 ((equal doctor-subj 'you) |
1534 (doctor-type '(why do you (doc// verb)(doc// obj) \?))) | 1514 (doctor-type '(why do you (doc// doctor-verb)(doc// doctor-obj) \?))) |
1535 (t (doctor-type '((doc$ whysay)(list subj verb obj)))))) | 1515 (t (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj)))))) |
1536 | 1516 |
1537 (defun doctor-symptoms () | 1517 (defun doctor-symptoms () |
1538 (doctor-type '((doc$ maybe) you should consult a medical doctor\; | 1518 (doctor-type '((doc$ doctor--maybe) you should consult a medical doctor\; |
1539 i am a psychotherapist. \.))) | 1519 i am a psychotherapist. \.))) |
1540 | 1520 |
1541 (defun doctor-hates () | 1521 (defun doctor-hates () |
1542 (doctor-svo sent found 1 t) | 1522 (doctor-svo doctor-sent doctor-found 1 t) |
1543 (doctor-hates1)) | 1523 (doctor-hates1)) |
1544 | 1524 |
1545 (defun doctor-hates1 () | 1525 (defun doctor-hates1 () |
1546 (doctor-type '((doc$ whysay)(list subj verb obj) \?))) | 1526 (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj) \?))) |
1547 | 1527 |
1548 (defun doctor-loves () | 1528 (defun doctor-loves () |
1549 (doctor-svo sent found 1 t) | 1529 (doctor-svo doctor-sent doctor-found 1 t) |
1550 (doctor-qloves)) | 1530 (doctor-qloves)) |
1551 | 1531 |
1552 (defun doctor-qloves () | 1532 (defun doctor-qloves () |
1553 (doctor-type '((doc$ bother)(list subj verb obj) \?))) | 1533 (doctor-type '((doc$ doctor--bother)(list doctor-subj doctor-verb doctor-obj) \?))) |
1554 | 1534 |
1555 (defun doctor-love () | 1535 (defun doctor-love () |
1556 (doctor-svo sent found 1 t) | 1536 (doctor-svo doctor-sent doctor-found 1 t) |
1557 (cond ((memq 'not sent) (doctor-forget) (doctor-huh)) | 1537 (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh)) |
1558 ((memq 'to sent) (doctor-hates1)) | 1538 ((memq 'to doctor-sent) (doctor-hates1)) |
1559 (t | 1539 (t |
1560 (cond ((equal object 'something) | 1540 (cond ((equal doctor-object 'something) |
1561 (setq object '(this person you love)))) | 1541 (setq doctor-object '(this person you love)))) |
1562 (cond ((equal subj 'you) | 1542 (cond ((equal doctor-subj 'you) |
1563 (setq lover obj) | 1543 (setq doctor--lover doctor-obj) |
1564 (cond ((equal lover '(this person you love)) | 1544 (cond ((equal doctor--lover '(this person you love)) |
1565 (setq lover '(your partner)) | 1545 (setq doctor--lover '(your partner)) |
1566 (doctor-forget) | 1546 (doctor-forget) |
1567 (doctor-type '(with whom are you in love \?))) | 1547 (doctor-type '(with whom are you in love \?))) |
1568 ((doctor-type '((doc$ please) | 1548 ((doctor-type '((doc$ doctor--please) |
1569 (doc$ describe) | 1549 (doc$ doctor--describe) |
1570 (doc$ relation) | 1550 (doc$ doctor--relation) |
1571 (doc// lover) | 1551 (doc// doctor--lover) |
1572 \.))))) | 1552 \.))))) |
1573 ((equal subj 'i) | 1553 ((equal doctor-subj 'i) |
1574 (doctor-txtype '(we were discussing you!))) | 1554 (doctor-txtype '(we were discussing you!))) |
1575 (t (doctor-forget) | 1555 (t (doctor-forget) |
1576 (setq obj 'someone) | 1556 (setq doctor-obj 'someone) |
1577 (setq verb (doctor-build verb 's)) | 1557 (setq doctor-verb (doctor-build doctor-verb 's)) |
1578 (doctor-qloves)))))) | 1558 (doctor-qloves)))))) |
1579 | 1559 |
1580 (defun doctor-mach () | 1560 (defun doctor-mach () |
1581 (setq found (doctor-plural found)) | 1561 (setq doctor-found (doctor-plural doctor-found)) |
1582 (doctor-type (doc$ machlst))) | 1562 (doctor-type (doc$ doctor--machlst))) |
1583 | 1563 |
1584 (defun doctor-sexnoun () (doctor-sexverb)) | 1564 (defun doctor-sexnoun () (doctor-sexverb)) |
1585 | 1565 |
1586 (defun doctor-sexverb () | 1566 (defun doctor-sexverb () |
1587 (if (or (memq 'me sent)(memq 'myself sent)(memq 'i sent)) | 1567 (if (or (memq 'me doctor-sent)(memq 'myself doctor-sent)(memq 'i doctor-sent)) |
1588 (doctor-foul) | 1568 (doctor-foul) |
1589 (doctor-type (doc$ sexlst)))) | 1569 (doctor-type (doc$ doctor--sexlst)))) |
1590 | 1570 |
1591 (defun doctor-death () | 1571 (defun doctor-death () |
1592 (cond (suicide-flag (doctor-type (doc$ deathlst))) | 1572 (cond (doctor--suicide-flag (doctor-type (doc$ doctor--deathlst))) |
1593 ((or (equal found 'suicide) | 1573 ((or (equal doctor-found 'suicide) |
1594 (and (or (equal found 'kill) | 1574 (and (or (equal doctor-found 'kill) |
1595 (equal found 'killing)) | 1575 (equal doctor-found 'killing)) |
1596 (memq 'yourself sent))) | 1576 (memq 'yourself doctor-sent))) |
1597 (setq suicide-flag t) | 1577 (setq doctor--suicide-flag t) |
1598 (doctor-type '(If you are really suicidal, you might | 1578 (doctor-type '(If you are really suicidal, you might |
1599 want to contact the Samaritans via | 1579 want to contact the Samaritans via |
1600 E-mail: jo@samaritans.org or, at your option, | 1580 E-mail: jo@samaritans.org or, at your option, |
1601 anonymous E-mail: samaritans@anon.twwells.com\ \. | 1581 anonymous E-mail: samaritans@anon.twwells.com\ \. |
1602 or find a Befrienders crisis center at | 1582 or find a Befrienders crisis center at |
1603 http://www.befrienders.org/\ \. | 1583 http://www.befrienders.org/\ \. |
1604 (doc$ please) (doc$ continue) \.))) | 1584 (doc$ doctor--please) (doc$ doctor--continue) \.))) |
1605 (t (doctor-type (doc$ deathlst))))) | 1585 (t (doctor-type (doc$ doctor--deathlst))))) |
1606 | 1586 |
1607 (defun doctor-foul () | 1587 (defun doctor-foul () |
1608 (doctor-type (doc$ foullst))) | 1588 (doctor-type (doc$ doctor--foullst))) |
1609 | 1589 |
1610 (defun doctor-family () | 1590 (defun doctor-family () |
1611 (doctor-possess sent found) | 1591 (doctor-possess doctor-sent doctor-found) |
1612 (doctor-type (doc$ famlst))) | 1592 (doctor-type (doc$ doctor--famlst))) |
1613 | 1593 |
1614 ;; I did not add this -- rms. | 1594 ;; I did not add this -- rms. |
1615 ;; But he might have removed it. I put it back. --roland | 1595 ;; But he might have removed it. I put it back. --roland |
1616 (defun doctor-rms () | 1596 (defun doctor-rms () |
1617 (cond (rms-flag (doctor-type (doc$ stallmanlst))) | 1597 (cond (doctor--rms-flag (doctor-type (doc$ doctor--stallmanlst))) |
1618 (t (setq rms-flag t) (doctor-type '(do you know Stallman \?))))) | 1598 (t (setq doctor--rms-flag t) (doctor-type '(do you know Stallman \?))))) |
1619 | 1599 |
1620 (defun doctor-school nil (doctor-type (doc$ schoollst))) | 1600 (defun doctor-school nil (doctor-type (doc$ doctor--schoollst))) |
1621 | 1601 |
1622 (defun doctor-eliza () | 1602 (defun doctor-eliza () |
1623 (cond (eliza-flag (doctor-type (doc$ elizalst))) | 1603 (cond (doctor--eliza-flag (doctor-type (doc$ doctor--elizalst))) |
1624 (t (setq eliza-flag t) | 1604 (t (setq doctor--eliza-flag t) |
1625 (doctor-type '((doc// found) \? hah ! | 1605 (doctor-type '((doc// doctor-found) \? hah ! |
1626 (doc$ please) (doc$ continue) \.))))) | 1606 (doc$ doctor--please) (doc$ doctor--continue) \.))))) |
1627 | 1607 |
1628 (defun doctor-sports () (doctor-type (doc$ sportslst))) | 1608 (defun doctor-sports () (doctor-type (doc$ doctor--sportslst))) |
1629 | 1609 |
1630 (defun doctor-math () (doctor-type (doc$ mathlst))) | 1610 (defun doctor-math () (doctor-type (doc$ doctor--mathlst))) |
1631 | 1611 |
1632 (defun doctor-zippy () | 1612 (defun doctor-zippy () |
1633 (cond (zippy-flag (doctor-type (doc$ zippylst))) | 1613 (cond (doctor--zippy-flag (doctor-type (doc$ doctor--zippylst))) |
1634 (t (setq zippy-flag t) | 1614 (t (setq doctor--zippy-flag t) |
1635 (doctor-type '(yow! are we interactive yet \?))))) | 1615 (doctor-type '(yow! are we interactive yet \?))))) |
1636 | 1616 |
1637 | 1617 |
1638 (defun doctor-chat () (doctor-type (doc$ chatlst))) | 1618 (defun doctor-chat () (doctor-type (doc$ doctor--chatlst))) |
1639 | 1619 |
1640 (random t) | 1620 (random t) |
1641 | 1621 |
1642 (provide 'doctor) | 1622 (provide 'doctor) |
1643 | 1623 |
1644 ;; arch-tag: 579380f6-4902-4ea5-bccb-6339e30e1257 | |
1645 ;;; doctor.el ends here | 1624 ;;; doctor.el ends here |