RSS

(root)/emacs/trunk : /lisp/play/doctor.el (revision 118363)

To get this branch, use:
For public read access:
bzr branch http://bzr.savannah.gnu.org/r/emacs/trunk

For developer write access:
bzr branch bzr+ssh://yourusername@bzr.savannah.gnu.org/emacs/trunk
Line Revision Contents
1 38397
;;; doctor.el --- psychological help for frustrated users
2 663
3 115824
;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2014 Free Software
4 110764.1.3...
;; Foundation, Inc.
5 846
6 116379
;; Maintainer: emacs-devel@gnu.org
7 808
;; Keywords: games
8
9 401
;; This file is part of GNU Emacs.
10
11 87343
;; GNU Emacs is free software: you can redistribute it and/or modify
12 401
;; it under the terms of the GNU General Public License as published by
13 87343
;; the Free Software Foundation, either version 3 of the License, or
14
;; (at your option) any later version.
15 401
16
;; GNU Emacs is distributed in the hope that it will be useful,
17
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19
;; GNU General Public License for more details.
20
21
;; You should have received a copy of the GNU General Public License
22 87343
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
23 401
24 2308
;;; Commentary:
25
26
;; The single entry point `doctor', simulates a Rogerian analyst using
27
;; phrase-production techniques similar to the classic ELIZA demonstration
28
;; of pseudo-AI.
29
30 808
;;; Code:
31 401
32 102254
(defvar doctor--**mad**)
33
(defvar doctor--*print-space*)
34
(defvar doctor--*print-upcase*)
35
(defvar doctor--abuselst)
36
(defvar doctor--abusewords)
37
(defvar doctor--afraidof)
38
(defvar doctor--arerelated)
39
(defvar doctor--areyou)
40
(defvar doctor--bak)
41
(defvar doctor--beclst)
42
(defvar doctor--bother)
43
(defvar doctor--bye)
44
(defvar doctor--canyou)			; unused?
45
(defvar doctor--chatlst)
46
(defvar doctor--continue)
47
(defvar doctor--deathlst)
48
(defvar doctor--describe)
49
(defvar doctor--drnk)
50
(defvar doctor--drugs)
51
(defvar doctor--eliza-flag)
52
(defvar doctor--elizalst)
53
(defvar doctor--famlst)
54
(defvar doctor--feared)
55
(defvar doctor--fears)
56
(defvar doctor--feelings-about)
57
(defvar doctor--foullst)
58
(defvar doctor-found)
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)
114 49780.1.32
115 47352
(defun doc// (x) x)
116 401
117 47352
(defmacro doc$ (what)
118 99634.2.92...
  "Quoted arg form of doctor-$."
119 102254
  `(doctor-$ ',what))
120 401
121
(defun doctor-$ (what)
122 99634.2.92...
  "Return the car of a list, rotating the list each time."
123 401
  (let* ((vv (symbol-value what))
124
	(first (car vv))
125
	(ww (append (cdr vv) (list first))))
126
    (set what ww)
127
    first))
128

129 68309
(defvar doctor-mode-map
130 68211
  (let ((map (make-sparse-keymap)))
131
    (define-key map "\n" 'doctor-read-print)
132
    (define-key map "\r" 'doctor-ret-or-read)
133
    map))
134
135 49780.1.32
(define-derived-mode doctor-mode text-mode "Doctor"
136 401
  "Major mode for running the Doctor (Eliza) program.
137
Like Text mode with Auto Fill mode
138
except that RET when point is after a newline, or LFD at any time,
139
reads the sentence before point, and prints the Doctor's answer."
140
  (make-doctor-variables)
141
  (turn-on-auto-fill)
142
  (doctor-type '(i am the psychotherapist \.
143 102254
		 (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \.
144 103295
		 each time you are finished talking\, type \R\E\T twice \.))
145 401
  (insert "\n"))
146
147
(defun make-doctor-variables ()
148 102254
  (set (make-local-variable 'doctor--typos)
149
       (mapcar (lambda (x)
150
		 (put (car x) 'doctor-correction  (cadr x))
151
		 (put (cadr x) 'doctor-expansion (car (cddr x)))
152
		 (car x))
153
	       '((theyll they\'ll (they will))
154
		 (theyre they\'re (they are))
155
		 (hes he\'s (he is))
156
		 (he7s he\'s (he is))
157
		 (im i\'m (you are))
158
		 (i7m i\'m (you are))
159
		 (isa is\ a (is a))
160
		 (thier their (their))
161
		 (dont don\'t (do not))
162
		 (don7t don\'t (do not))
163
		 (you7re you\'re (i am))
164
		 (you7ve you\'ve (i have))
165
		 (you7ll you\'ll (i will)))))
166 105733
  (set (make-local-variable 'doctor-sent) nil)
167 102254
  (set (make-local-variable 'doctor-found) nil)
168
  (set (make-local-variable 'doctor-owner) nil)
169
  (set (make-local-variable 'doctor--history) nil)
170
  (set (make-local-variable 'doctor--inter) '((well\,)
171
				      (hmmm \.\.\.\ so\,)
172
				      (so)
173
				      (\.\.\.and)
174
				      (then)))
175
  (set (make-local-variable 'doctor--continue) '((continue)
176
						 (proceed)
177
						 (go on)
178
						 (keep going)))
179
  (set (make-local-variable 'doctor--relation)
180
       '((your relationship with)
181
	 (something you remember about)
182
	 (your feelings toward)
183
	 (some experiences you have had with)
184
	 (how you feel about)))
185
  (set (make-local-variable 'doctor--fears)
186
       '(((doc$ doctor--whysay) you are (doc$ doctor--afraidof) (doc// doctor--feared) \?)
187
	 (you seem terrified by (doc// doctor--feared) \.)
188
	 (when did you first feel (doc$ doctor--afraidof) (doc// doctor--feared) \?)))
189
  (set (make-local-variable 'doctor--sure) '((sure)
190
					     (positive)
191
					     (certain)
192
					     (absolutely sure)))
193
  (set (make-local-variable 'doctor--afraidof) '((afraid of)
194
					 (frightened by)
195
					 (scared of)))
196
  (set (make-local-variable 'doctor--areyou) '((are you)
197
				       (have you been)
198
				       (have you been)))
199
  (set (make-local-variable 'doctor--isrelated)
200
       '((has something to do with)
201
	 (is related to)
202
	 (could be the reason for)
203
	 (is caused by)
204
	 (is because of)))
205
  (set (make-local-variable 'doctor--arerelated) '((have something to do with)
206
					   (are related to)
207
					   (could have caused)
208
					   (could be the reason for)
209
					   (are caused by)
210
					   (are because of)))
211
  (set (make-local-variable 'doctor--moods)
212
       '(((doc$ doctor--areyou) (doc// doctor-found) often \?)
213
	 (what causes you to be (doc// doctor-found) \?)
214
	 ((doc$ doctor--whysay) you are (doc// doctor-found) \?)))
215
  (set (make-local-variable 'doctor--maybe) '((maybe)
216
				      (perhaps)
217
				      (possibly)))
218
  (set (make-local-variable 'doctor--whatwhen) '((what happened when)
219
						 (what would happen if)))
220
  (set (make-local-variable 'doctor--hello) '((how do you do \?)
221
				      (hello \.)
222
				      (howdy!)
223
				      (hello \.)
224
				      (hi \.)
225
				      (hi there \.)))
226
  (set (make-local-variable 'doctor--drnk)
227
       '((do you drink a lot of (doc// doctor-found) \?)
228
	 (do you get drunk often \?)
229
	 ((doc$ doctor--describe) your drinking habits \.)))
230
  (set (make-local-variable 'doctor--drugs)
231
       '((do you use (doc// doctor-found) often \?)
232
	 ((doc$ doctor--areyou) addicted to (doc// doctor-found) \?)
233
	 (do you realize that drugs can be very harmful \?)
234
	 ((doc$ doctor--maybe) you should try to quit using (doc// doctor-found) \.)))
235
  (set (make-local-variable 'doctor--whywant)
236
       '(((doc$ doctor--whysay) (doc// doctor-subj) might (doc$ doctor--want) (doc// doctor-obj) \?)
237
	 (how does it feel to want \?)
238
	 (why should (doc// doctor-subj) get (doc// doctor-obj) \?)
239
	 (when did (doc// doctor-subj) first (doc$ doctor--want) (doc// doctor-obj) \?)
240
	 ((doc$ doctor--areyou) obsessed with (doc// doctor-obj) \?)
241
	 (why should i give (doc// doctor-obj) to (doc// doctor-subj) \?)
242
	 (have you ever gotten (doc// doctor-obj) \?)))
243
  (set (make-local-variable 'doctor--canyou)
244
       '((of course i can \.)
245
	 (why should i \?)
246
	 (what makes you think i would even want to \?)
247
	 (i am the doctor\, i can do anything i damn please \.)
248
	 (not really\, it\'s not up to me \.)
249
	 (depends\, how important is it \?)
250
	 (i could\, but i don\'t think it would be a wise thing to do \.)
251
	 (can you \?)
252
	 (maybe i can\, maybe i can\'t \.\.\.)
253
	 (i don\'t think i should do that \.)))
254
  (set (make-local-variable 'doctor--want) '((want) (desire) (wish) (want) (hope)))
255
  (set (make-local-variable 'doctor--shortlst)
256
       '((can you elaborate on that \?)
257
	 ((doc$ doctor--please) continue \.)
258
	 (go on\, don\'t be afraid \.)
259
	 (i need a little more detail please \.)
260
	 (you\'re being a bit brief\, (doc$ doctor--please) go into detail \.)
261
	 (can you be more explicit \?)
262
	 (and \?)
263
	 ((doc$ doctor--please) go into more detail \?)
264
	 (you aren\'t being very talkative today\!)
265
	 (is that all there is to it \?)
266
	 (why must you respond so briefly \?)))
267
  (set (make-local-variable 'doctor--famlst)
268
       '((tell me (doc$ doctor--something) about (doc// doctor-owner) family \.)
269
	 (you seem to dwell on (doc// doctor-owner) family \.)
270
	 ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?)))
271
  (set (make-local-variable 'doctor--huhlst)
272 103967
       '(((doc$ doctor--whysay) (doc// doctor-sent) \?)
273 102254
	 (is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?)))
274
  (set (make-local-variable 'doctor--longhuhlst)
275
       '(((doc$ doctor--whysay) that \?)
276
	 (i don\'t understand \.)
277
	 ((doc$ doctor--thlst))
278
	 ((doc$ doctor--areyou) (doc$ doctor--afraidof) that \?)))
279
  (set (make-local-variable 'doctor--feelings-about) '((feelings about)
280
					       (apprehensions toward)
281
					       (thoughts on)
282
					       (emotions toward)))
283
  (set (make-local-variable 'doctor--random-adjective)
284
       '((vivid)
285
	 (emotionally stimulating)
286
	 (exciting)
287
	 (boring)
288
	 (interesting)
289
	 (recent)
290
	 (random) ; how can we omit this?
291
	 (unusual)
292
	 (shocking)
293
	 (embarrassing)))
294
  (set (make-local-variable 'doctor--whysay) '((why do you say)
295
				       (what makes you believe)
296
				       (are you sure that)
297
				       (do you really think)
298
				       (what makes you think)))
299
  (set (make-local-variable 'doctor--isee) '((i see \.\.\.)
300
				     (yes\,)
301
				     (i understand \.)
302
				     (oh \.) ))
303
  (set (make-local-variable 'doctor--please) '((please\,)
304
				       (i would appreciate it if you would)
305
				       (perhaps you could)
306
				       (please\,)
307
				       (would you please)
308
				       (why don\'t you)
309
				       (could you)))
310
  (set (make-local-variable 'doctor--bye)
311
       '((my secretary will send you a bill \.)
312
	 (bye bye \.)
313
	 (see ya \.)
314
	 (ok\, talk to you some other time \.)
315
	 (talk to you later \.)
316
	 (ok\, have fun \.)
317
	 (ciao \.)))
318
  (set (make-local-variable 'doctor--something) '((something)
319
						  (more)
320
						  (how you feel)))
321
  (set (make-local-variable 'doctor--thing) '((your life)
322
				      (your sex life)))
323
  (set (make-local-variable 'doctor--things) '((your plans)
324
				       (the people you hang around with)
325
				       (problems at school)
326
				       (any hobbies you have)
327
				       (hangups you have)
328
				       (your inhibitions)
329
				       (some problems in your childhood)
330
				       (some problems at home)))
331
  (set (make-local-variable 'doctor--describe) '((describe)
332
					 (tell me about)
333
					 (talk about)
334
					 (discuss)
335
					 (tell me more about)
336
					 (elaborate on)))
337
  (set (make-local-variable 'doctor--ibelieve)
338
       '((i believe) (i think) (i have a feeling) (it seems to me that)
339
	 (it looks like)))
340
  (set (make-local-variable 'doctor--problems) '((problems)
341
					 (inhibitions)
342
					 (hangups)
343
					 (difficulties)
344
					 (anxieties)
345
					 (frustrations)))
346
  (set (make-local-variable 'doctor--bother) '((does it bother you that)
347
				       (are you annoyed that)
348
				       (did you ever regret)
349
				       (are you sorry)
350
				       (are you satisfied with the fact that)))
351
  (set (make-local-variable 'doctor--machlst)
352
       '((you have your mind on (doc// doctor-found) \, it seems \.)
353
	 (you think too much about  (doc// doctor-found) \.)
354
	 (you should try taking your mind off of (doc// doctor-found)\.)
355
	 (are you a computer hacker \?)))
356
  (set (make-local-variable 'doctor--qlist)
357
       '((what do you think \?)
358
	 (i\'ll ask the questions\, if you don\'t mind!)
359
	 (i could ask the same thing myself \.)
360
	 ((doc$ doctor--please) allow me to do the questioning \.)
361
	 (i have asked myself that question many times \.)
362
	 ((doc$ doctor--please) try to answer that question yourself \.)))
363
  (set (make-local-variable 'doctor--foullst)
364
       '(((doc$ doctor--please) watch your tongue!)
365
	 ((doc$ doctor--please) avoid such unwholesome thoughts \.)
366
	 ((doc$ doctor--please) get your mind out of the gutter \.)
367
	 (such lewdness is not appreciated \.)))
368
  (set (make-local-variable 'doctor--deathlst)
369
       '((this is not a healthy way of thinking \.)
370
	 ((doc$ doctor--bother) you\, too\, may die someday \?)
371
	 (i am worried by your obsession with this topic!)
372
	 (did you watch a lot of crime and violence on television as a child \?)))
373
  (set (make-local-variable 'doctor--sexlst)
374
       '(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?)
375 103967
	 ((doc$ doctor--describe) (doc$ doctor--something) about your sexual history \.)
376
	 ((doc$ doctor--please) (doc$ doctor--describe) your sex life \.\.\.)
377 102254
	 ((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.)
378
	 ((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.)
379
	 ((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?)))
380
  (set (make-local-variable 'doctor--neglst) '((why not \?)
381
				       ((doc$ doctor--bother) i ask that \?)
382
				       (why not \?)
383
				       (why not \?)
384
				       (how come \?)
385
				       ((doc$ doctor--bother) i ask that \?)))
386
  (set (make-local-variable 'doctor--beclst)
387
       '((is it because (doc// doctor-sent) that you came to me \?)
388 103967
	 ((doc$ doctor--bother) (doc// doctor-sent) \?)
389 102254
	 (when did you first know that (doc// doctor-sent) \?)
390
	 (is the fact that (doc// doctor-sent) the real reason \?)
391
	 (does the fact that (doc// doctor-sent) explain anything else \?)
392 103967
	 ((doc$ doctor--areyou) (doc$ doctor--sure) (doc// doctor-sent) \? )))
393 102254
  (set (make-local-variable 'doctor--shortbeclst)
394
   '(((doc$ doctor--bother) i ask you that \?)
395
     (that\'s not much of an answer!)
396
     ((doc$ doctor--inter) why won\'t you talk about it \?)
397
     (speak up!)
398
     ((doc$ doctor--areyou) (doc$ doctor--afraidof) talking about it \?)
399
     (don\'t be (doc$ doctor--afraidof) elaborating \.)
400
     ((doc$ doctor--please) go into more detail \.)))
401
  (set (make-local-variable 'doctor--thlst)
402 103967
       '(((doc$ doctor--maybe) (doc$ doctor--thing) (doc$ doctor--isrelated) this \.)
403
	 ((doc$ doctor--maybe) (doc$ doctor--things) (doc$ doctor--arerelated) this \.)
404 102254
	 (is it because of (doc$ doctor--things) that you are going through all this \?)
405
	 (how do you reconcile (doc$ doctor--things) \? )
406 103967
	 ((doc$ doctor--maybe) this (doc$ doctor--isrelated) (doc$ doctor--things) \?)))
407 102254
  (set (make-local-variable 'doctor--remlst)
408
       '((earlier you said (doc$ doctor--history) \?)
409
	 (you mentioned that (doc$ doctor--history) \?)
410 103967
	 ((doc$ doctor--whysay) (doc$ doctor--history) \? )))
411 102254
  (set (make-local-variable 'doctor--toklst)
412
       '((is this how you relax \?)
413
	 (how long have you been smoking	grass \?)
414
	 ((doc$ doctor--areyou) (doc$ doctor--afraidof) of being drawn to using harder stuff \?)))
415
  (set (make-local-variable 'doctor--states)
416
       '((do you get (doc// doctor-found) often \?)
417
	 (do you enjoy being (doc// doctor-found) \?)
418
	 (what makes you (doc// doctor-found) \?)
419 103967
	 (how often (doc$ doctor--areyou) (doc// doctor-found) \?)
420 102254
	 (when were you last (doc// doctor-found) \?)))
421
  (set (make-local-variable 'doctor--replist) '((i . (you))
422
					(my . (your))
423
					(me . (you))
424
					(you . (me))
425
					(your . (my))
426
					(mine . (yours))
427
					(yours . (mine))
428
					(our . (your))
429
					(ours . (yours))
430
					(we . (you))
431
					(dunno . (do not know))
432
					;;	  (yes . ())
433
					(no\, . ())
434
					(yes\, . ())
435
					(ya . (i))
436
					(aint . (am not))
437
					(wanna . (want to))
438
					(gimme . (give me))
439
					(gotta . (have to))
440
					(gonna . (going to))
441
					(never . (not ever))
442
					(doesn\'t . (does not))
443
					(don\'t . (do not))
444
					(aren\'t . (are not))
445
					(isn\'t . (is not))
446
					(won\'t . (will not))
447
					(can\'t . (cannot))
448
					(haven\'t . (have not))
449
					(i\'m . (you are))
450
					(ourselves . (yourselves))
451
					(myself . (yourself))
452
					(yourself . (myself))
453
					(you\'re . (i am))
454
					(you\'ve . (i have))
455
					(i\'ve . (you have))
456
					(i\'ll . (you will))
457
					(you\'ll . (i shall))
458
					(i\'d . (you would))
459
					(you\'d . (i would))
460
					(here . (there))
461
					(please . ())
462
					(eh\, . ())
463
					(eh . ())
464
					(oh\, . ())
465
					(oh . ())
466
					(shouldn\'t . (should not))
467
					(wouldn\'t . (would not))
468
					(won\'t . (will not))
469
					(hasn\'t . (has not))))
470
  (set (make-local-variable 'doctor--stallmanlst)
471
       '(((doc$ doctor--describe) your (doc$ doctor--feelings-about) him \.)
472
	 ((doc$ doctor--areyou) a friend of Stallman \?)
473
	 ((doc$ doctor--bother) Stallman is (doc$ doctor--random-adjective) \?)
474
	 ((doc$ doctor--ibelieve) you are (doc$ doctor--afraidof) him \.)))
475
  (set (make-local-variable 'doctor--schoollst)
476
       '(((doc$ doctor--describe) your (doc// doctor-found) \.)
477
	 ((doc$ doctor--bother) your grades could (doc$ doctor--improve) \?)
478
	 ((doc$ doctor--areyou) (doc$ doctor--afraidof) (doc// doctor-found) \?)
479
	 ((doc$ doctor--maybe) this (doc$ doctor--isrelated) to your attitude \.)
480
	 ((doc$ doctor--areyou) absent often \?)
481
	 ((doc$ doctor--maybe) you should study (doc$ doctor--something) \.)))
482
  (set (make-local-variable 'doctor--improve)
483
       '((improve) (be better) (be improved) (be higher)))
484
  (set (make-local-variable 'doctor--elizalst)
485
       '(((doc$ doctor--areyou) (doc$ doctor--sure) \?)
486
	 ((doc$ doctor--ibelieve) you have (doc$ doctor--problems) with (doc// doctor-found) \.)
487
	 ((doc$ doctor--whysay) (doc// doctor-sent) \?)))
488
  (set (make-local-variable 'doctor--sportslst)
489
       '((tell me (doc$ doctor--something) about (doc// doctor-found) \.)
490
	 ((doc$ doctor--describe) (doc$ doctor--relation) (doc// doctor-found) \.)
491
	 (do you find (doc// doctor-found) (doc$ doctor--random-adjective) \?)))
492
  (set (make-local-variable 'doctor--mathlst)
493
       '(((doc$ doctor--describe) (doc$ doctor--something) about math \.)
494
	 ((doc$ doctor--maybe) your (doc$ doctor--problems) (doc$ doctor--arerelated) (doc// doctor-found) \.)
495
	 (i don\'t know much (doc// doctor-found) \, but (doc$ doctor--continue)
496
	    anyway \.)))
497
  (set (make-local-variable 'doctor--zippylst)
498
       '(((doc$ doctor--areyou) Zippy \?)
499
	 ((doc$ doctor--ibelieve) you have some serious (doc$ doctor--problems) \.)
500
	 ((doc$ doctor--bother) you are a pinhead \?)))
501
  (set (make-local-variable 'doctor--chatlst)
502
       '(((doc$ doctor--maybe) we could chat \.)
503
	 ((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--something) about chat mode \.)
504
	 ((doc$ doctor--bother) our discussion is so (doc$ doctor--random-adjective) \?)))
505
  (set (make-local-variable 'doctor--abuselst)
506
       '(((doc$ doctor--please) try to be less abusive \.)
507
	 ((doc$ doctor--describe) why you call me (doc// doctor-found) \.)
508
	 (i\'ve had enough of you!)))
509
  (set (make-local-variable 'doctor--abusewords)
510
       '(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
  (set (make-local-variable 'doctor--howareyoulst)
516
       '((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
  (set (make-local-variable 'doctor--whereoutp) '(huh remem rthing))
524
  (set (make-local-variable 'doctor-subj) nil)
525
  (set (make-local-variable 'doctor-verb) nil)
526
  (set (make-local-variable 'doctor-obj) nil)
527
  (set (make-local-variable 'doctor--feared) nil)
528
  (set (make-local-variable 'doctor--repetitive-shortness) '(0 . 0))
529
  (set (make-local-variable 'doctor--**mad**) nil)
530
  (set (make-local-variable 'doctor--rms-flag) nil)
531
  (set (make-local-variable 'doctor--eliza-flag) nil)
532
  (set (make-local-variable 'doctor--zippy-flag) nil)
533
  (set (make-local-variable 'doctor--suicide-flag) nil)
534
  (set (make-local-variable 'doctor--lover) '(your partner))
535
  (set (make-local-variable 'doctor--bak) nil)
536
  (set (make-local-variable 'doctor--lincount) 0)
537
  (set (make-local-variable 'doctor--*print-upcase*) nil)
538
  (set (make-local-variable 'doctor--*print-space*) nil)
539
  (set (make-local-variable 'doctor--howdyflag) nil)
540
  (set (make-local-variable 'doctor-object) nil))
541 401

542
;; Define equivalence classes of words that get treated alike.
543
544
(defun doctor-meaning (x) (get x 'doctor-meaning))
545
546
(defmacro doctor-put-meaning (symb val)
547 99634.2.92...
  "Store the base meaning of a word on the property list."
548 102254
  `(put ',symb 'doctor-meaning ,val))
549 401
550
(doctor-put-meaning howdy 'howdy)
551
(doctor-put-meaning hi 'howdy)
552
(doctor-put-meaning greetings 'howdy)
553
(doctor-put-meaning hello 'howdy)
554
(doctor-put-meaning tops20 'mach)
555
(doctor-put-meaning tops-20 'mach)
556
(doctor-put-meaning tops 'mach)
557
(doctor-put-meaning pdp11 'mach)
558
(doctor-put-meaning computer 'mach)
559
(doctor-put-meaning unix 'mach)
560
(doctor-put-meaning machine 'mach)
561
(doctor-put-meaning computers 'mach)
562
(doctor-put-meaning machines 'mach)
563
(doctor-put-meaning pdp11s 'mach)
564
(doctor-put-meaning foo 'mach)
565
(doctor-put-meaning foobar 'mach)
566
(doctor-put-meaning multics 'mach)
567
(doctor-put-meaning macsyma 'mach)
568
(doctor-put-meaning teletype 'mach)
569
(doctor-put-meaning la36 'mach)
570
(doctor-put-meaning vt52 'mach)
571
(doctor-put-meaning zork 'mach)
572
(doctor-put-meaning trek 'mach)
573
(doctor-put-meaning startrek 'mach)
574
(doctor-put-meaning advent 'mach)
575
(doctor-put-meaning pdp 'mach)
576
(doctor-put-meaning dec 'mach)
577
(doctor-put-meaning commodore 'mach)
578
(doctor-put-meaning vic 'mach)
579
(doctor-put-meaning bbs 'mach)
580
(doctor-put-meaning modem 'mach)
581
(doctor-put-meaning baud 'mach)
582
(doctor-put-meaning macintosh 'mach)
583
(doctor-put-meaning vax 'mach)
584
(doctor-put-meaning vms 'mach)
585
(doctor-put-meaning ibm 'mach)
586
(doctor-put-meaning pc 'mach)
587
(doctor-put-meaning bitching 'foul)
588 18457
(doctor-put-meaning shit 'foul)
589 401
(doctor-put-meaning bastard 'foul)
590
(doctor-put-meaning damn 'foul)
591
(doctor-put-meaning damned 'foul)
592
(doctor-put-meaning hell 'foul)
593
(doctor-put-meaning suck 'foul)
594
(doctor-put-meaning sucking 'foul)
595
(doctor-put-meaning sux 'foul)
596
(doctor-put-meaning ass 'foul)
597
(doctor-put-meaning whore 'foul)
598
(doctor-put-meaning bitch 'foul)
599
(doctor-put-meaning asshole 'foul)
600
(doctor-put-meaning shrink 'foul)
601
(doctor-put-meaning pot 'toke)
602
(doctor-put-meaning grass 'toke)
603
(doctor-put-meaning weed 'toke)
604
(doctor-put-meaning marijuana 'toke)
605
(doctor-put-meaning acapulco 'toke)
606
(doctor-put-meaning columbian 'toke)
607
(doctor-put-meaning tokin 'toke)
608
(doctor-put-meaning joint 'toke)
609
(doctor-put-meaning toke 'toke)
610
(doctor-put-meaning toking 'toke)
611
(doctor-put-meaning tokin\' 'toke)
612
(doctor-put-meaning toked 'toke)
613
(doctor-put-meaning roach 'toke)
614
(doctor-put-meaning pills 'drug)
615
(doctor-put-meaning dope 'drug)
616
(doctor-put-meaning acid 'drug)
617
(doctor-put-meaning lsd 'drug)
618
(doctor-put-meaning speed 'drug)
619
(doctor-put-meaning heroin 'drug)
620
(doctor-put-meaning hash 'drug)
621
(doctor-put-meaning cocaine 'drug)
622
(doctor-put-meaning uppers 'drug)
623
(doctor-put-meaning downers 'drug)
624
(doctor-put-meaning loves 'loves)
625
(doctor-put-meaning love 'love)
626
(doctor-put-meaning loved 'love)
627
(doctor-put-meaning hates 'hates)
628
(doctor-put-meaning dislikes 'hates)
629
(doctor-put-meaning hate 'hate)
630
(doctor-put-meaning hated 'hate)
631
(doctor-put-meaning dislike 'hate)
632
(doctor-put-meaning stoned 'state)
633
(doctor-put-meaning drunk 'state)
634
(doctor-put-meaning drunken 'state)
635
(doctor-put-meaning high 'state)
636
(doctor-put-meaning horny 'state)
637
(doctor-put-meaning blasted 'state)
638
(doctor-put-meaning happy 'state)
639
(doctor-put-meaning paranoid 'state)
640
(doctor-put-meaning wish 'desire)
641
(doctor-put-meaning wishes 'desire)
642
(doctor-put-meaning want 'desire)
643
(doctor-put-meaning desire 'desire)
644
(doctor-put-meaning like 'desire)
645
(doctor-put-meaning hope 'desire)
646
(doctor-put-meaning hopes 'desire)
647
(doctor-put-meaning desires 'desire)
648
(doctor-put-meaning wants 'desire)
649
(doctor-put-meaning desires 'desire)
650
(doctor-put-meaning likes 'desire)
651
(doctor-put-meaning needs 'desire)
652
(doctor-put-meaning need 'desire)
653
(doctor-put-meaning frustrated 'mood)
654
(doctor-put-meaning depressed 'mood)
655
(doctor-put-meaning annoyed 'mood)
656
(doctor-put-meaning upset 'mood)
657
(doctor-put-meaning unhappy 'mood)
658
(doctor-put-meaning excited 'mood)
659
(doctor-put-meaning worried 'mood)
660
(doctor-put-meaning lonely 'mood)
661
(doctor-put-meaning angry 'mood)
662
(doctor-put-meaning mad 'mood)
663 18457
(doctor-put-meaning pissed 'mood)
664 401
(doctor-put-meaning jealous 'mood)
665
(doctor-put-meaning afraid 'fear)
666
(doctor-put-meaning terrified 'fear)
667
(doctor-put-meaning fear 'fear)
668
(doctor-put-meaning scared 'fear)
669
(doctor-put-meaning frightened 'fear)
670
(doctor-put-meaning virginity 'sexnoun)
671
(doctor-put-meaning virgins 'sexnoun)
672
(doctor-put-meaning virgin 'sexnoun)
673
(doctor-put-meaning cock 'sexnoun)
674
(doctor-put-meaning cocks 'sexnoun)
675
(doctor-put-meaning dick 'sexnoun)
676
(doctor-put-meaning dicks 'sexnoun)
677 18457
(doctor-put-meaning cunt 'sexnoun)
678
(doctor-put-meaning cunts 'sexnoun)
679 401
(doctor-put-meaning prostitute 'sexnoun)
680
(doctor-put-meaning condom 'sexnoun)
681
(doctor-put-meaning sex 'sexnoun)
682
(doctor-put-meaning rapes 'sexnoun)
683
(doctor-put-meaning wife 'family)
684
(doctor-put-meaning family 'family)
685
(doctor-put-meaning brothers 'family)
686
(doctor-put-meaning sisters 'family)
687
(doctor-put-meaning parent 'family)
688
(doctor-put-meaning parents 'family)
689
(doctor-put-meaning brother 'family)
690
(doctor-put-meaning sister 'family)
691
(doctor-put-meaning father 'family)
692
(doctor-put-meaning mother 'family)
693
(doctor-put-meaning husband 'family)
694
(doctor-put-meaning siblings 'family)
695
(doctor-put-meaning grandmother 'family)
696
(doctor-put-meaning grandfather 'family)
697
(doctor-put-meaning maternal 'family)
698
(doctor-put-meaning paternal 'family)
699
(doctor-put-meaning stab 'death)
700
(doctor-put-meaning murder 'death)
701
(doctor-put-meaning murders 'death)
702
(doctor-put-meaning suicide 'death)
703
(doctor-put-meaning suicides 'death)
704
(doctor-put-meaning kill 'death)
705
(doctor-put-meaning kills 'death)
706 18390
(doctor-put-meaning killing 'death)
707 401
(doctor-put-meaning die 'death)
708
(doctor-put-meaning dies 'death)
709
(doctor-put-meaning died 'death)
710
(doctor-put-meaning dead 'death)
711
(doctor-put-meaning death 'death)
712
(doctor-put-meaning deaths 'death)
713
(doctor-put-meaning pain 'symptoms)
714
(doctor-put-meaning ache 'symptoms)
715
(doctor-put-meaning fever 'symptoms)
716
(doctor-put-meaning sore 'symptoms)
717
(doctor-put-meaning aching 'symptoms)
718
(doctor-put-meaning stomachache 'symptoms)
719
(doctor-put-meaning headache 'symptoms)
720
(doctor-put-meaning hurts 'symptoms)
721
(doctor-put-meaning disease 'symptoms)
722
(doctor-put-meaning virus 'symptoms)
723
(doctor-put-meaning vomit 'symptoms)
724
(doctor-put-meaning vomiting 'symptoms)
725
(doctor-put-meaning barf 'symptoms)
726
(doctor-put-meaning toothache 'symptoms)
727
(doctor-put-meaning hurt 'symptoms)
728
(doctor-put-meaning rum 'alcohol)
729
(doctor-put-meaning gin 'alcohol)
730
(doctor-put-meaning vodka 'alcohol)
731
(doctor-put-meaning alcohol 'alcohol)
732
(doctor-put-meaning bourbon 'alcohol)
733
(doctor-put-meaning beer 'alcohol)
734
(doctor-put-meaning wine 'alcohol)
735
(doctor-put-meaning whiskey 'alcohol)
736
(doctor-put-meaning scotch 'alcohol)
737 18457
(doctor-put-meaning fuck 'sexverb)
738
(doctor-put-meaning fucked 'sexverb)
739 401
(doctor-put-meaning screw 'sexverb)
740
(doctor-put-meaning screwing 'sexverb)
741 18457
(doctor-put-meaning fucking 'sexverb)
742 401
(doctor-put-meaning rape 'sexverb)
743
(doctor-put-meaning raped 'sexverb)
744
(doctor-put-meaning kiss 'sexverb)
745
(doctor-put-meaning kissing 'sexverb)
746
(doctor-put-meaning kisses 'sexverb)
747
(doctor-put-meaning screws 'sexverb)
748 18457
(doctor-put-meaning fucks 'sexverb)
749 401
(doctor-put-meaning because 'conj)
750
(doctor-put-meaning but 'conj)
751
(doctor-put-meaning however 'conj)
752
(doctor-put-meaning besides 'conj)
753
(doctor-put-meaning anyway 'conj)
754
(doctor-put-meaning that 'conj)
755
(doctor-put-meaning except 'conj)
756
(doctor-put-meaning why 'conj)
757
(doctor-put-meaning how 'conj)
758
(doctor-put-meaning until 'when)
759
(doctor-put-meaning when 'when)
760
(doctor-put-meaning whenever 'when)
761
(doctor-put-meaning while 'when)
762
(doctor-put-meaning since 'when)
763
(doctor-put-meaning rms 'rms)
764
(doctor-put-meaning stallman 'rms)
765
(doctor-put-meaning school 'school)
766
(doctor-put-meaning schools 'school)
767
(doctor-put-meaning skool 'school)
768
(doctor-put-meaning grade 'school)
769
(doctor-put-meaning grades 'school)
770
(doctor-put-meaning teacher 'school)
771
(doctor-put-meaning teachers 'school)
772
(doctor-put-meaning classes 'school)
773
(doctor-put-meaning professor 'school)
774
(doctor-put-meaning prof 'school)
775
(doctor-put-meaning profs 'school)
776
(doctor-put-meaning professors 'school)
777
(doctor-put-meaning mit 'school)
778
(doctor-put-meaning emacs 'eliza)
779
(doctor-put-meaning eliza 'eliza)
780
(doctor-put-meaning liza 'eliza)
781
(doctor-put-meaning elisa 'eliza)
782
(doctor-put-meaning weizenbaum 'eliza)
783
(doctor-put-meaning doktor 'eliza)
784 3592
(doctor-put-meaning athletics 'sports)
785 401
(doctor-put-meaning baseball 'sports)
786
(doctor-put-meaning basketball 'sports)
787
(doctor-put-meaning football 'sports)
788
(doctor-put-meaning frisbee 'sports)
789
(doctor-put-meaning gym 'sports)
790
(doctor-put-meaning gymnastics 'sports)
791
(doctor-put-meaning hockey 'sports)
792
(doctor-put-meaning lacrosse 'sports)
793
(doctor-put-meaning soccer 'sports)
794
(doctor-put-meaning softball 'sports)
795
(doctor-put-meaning sports 'sports)
796
(doctor-put-meaning swimming 'sports)
797
(doctor-put-meaning swim 'sports)
798
(doctor-put-meaning tennis 'sports)
799
(doctor-put-meaning volleyball 'sports)
800
(doctor-put-meaning math 'math)
801
(doctor-put-meaning mathematics 'math)
802
(doctor-put-meaning mathematical 'math)
803
(doctor-put-meaning theorem 'math)
804
(doctor-put-meaning axiom 'math)
805
(doctor-put-meaning lemma 'math)
806
(doctor-put-meaning algebra 'math)
807
(doctor-put-meaning algebraic 'math)
808
(doctor-put-meaning trig 'math)
809
(doctor-put-meaning trigonometry 'math)
810
(doctor-put-meaning trigonometric 'math)
811
(doctor-put-meaning geometry 'math)
812
(doctor-put-meaning geometric 'math)
813
(doctor-put-meaning calculus 'math)
814
(doctor-put-meaning arithmetic 'math)
815
(doctor-put-meaning zippy 'zippy)
816
(doctor-put-meaning zippy 'zippy)
817
(doctor-put-meaning pinhead 'zippy)
818
(doctor-put-meaning chat 'chat)
819

820
;;;###autoload
821
(defun doctor ()
822
  "Switch to *doctor* buffer and start giving psychotherapy."
823
  (interactive)
824
  (switch-to-buffer "*doctor*")
825
  (doctor-mode))
826
827
(defun doctor-ret-or-read (arg)
828
  "Insert a newline if preceding character is not a newline.
829
Otherwise call the Doctor to parse preceding sentence."
830
  (interactive "*p")
831
  (if (= (preceding-char) ?\n)
832
      (doctor-read-print)
833
    (newline arg)))
834
835 108610
(defun doctor-read-print ()
836 99634.2.92...
  "Top level loop."
837 401
  (interactive)
838 108610
  (setq doctor-sent (doctor-readin))
839
  (insert "\n")
840
  (setq doctor--lincount (1+ doctor--lincount))
841
  (doctor-doc)
842
  (insert "\n")
843
  (setq doctor--bak doctor-sent))
844 401
845 108610
(defun doctor-readin ()
846 401
  "Read a sentence.  Return it as a list of words."
847
  (let (sentence)
848
    (backward-sentence 1)
849
    (while (not (eobp))
850
      (setq sentence (append sentence (list (doctor-read-token)))))
851
    sentence))
852
853
(defun doctor-read-token ()
854 99634.2.92...
  "Read one word from buffer."
855 401
  (prog1 (intern (downcase (buffer-substring (point)
856
					     (progn
857
					       (forward-word 1)
858
					       (point)))))
859
    (re-search-forward "\\Sw*")))
860

861
;; Main processing function for sentences that have been read.
862
863 108610
(defun doctor-doc ()
864 401
  (cond
865 108610
   ((equal doctor-sent '(foo))
866 103967
    (doctor-type '(bar! (doc$ doctor--please) (doc$ doctor--continue) \.)))
867 108610
   ((member doctor-sent doctor--howareyoulst)
868 102254
    (doctor-type '(i\'m ok \.  (doc$ doctor--describe) yourself \.)))
869 108610
   ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long)
870
			      (go away) (get lost)))
871
	(memq (car doctor-sent)
872 49583
	      '(bye halt break quit done exit goodbye
873 401
		    bye\, stop pause goodbye\, stop pause)))
874 102254
    (doctor-type (doc$ doctor--bye)))
875 108610
   ((and (eq (car doctor-sent) 'you)
876
	 (memq (cadr doctor-sent) doctor--abusewords))
877
    (setq doctor-found (cadr doctor-sent))
878 102254
    (doctor-type (doc$ doctor--abuselst)))
879 108610
   ((eq (car doctor-sent) 'whatmeans)
880
    (doctor-def (cadr doctor-sent)))
881
   ((equal doctor-sent '(parse))
882 102254
    (doctor-type (list  'subj '= doctor-subj ",  "
883
			'verb '= doctor-verb "\n"
884
			'object 'phrase '= doctor-obj ","
885
			'noun 'form '=  doctor-object "\n"
886
			'current 'keyword 'is doctor-found
887 401
			", "
888
			'most 'recent 'possessive
889 102254
			'is doctor-owner "\n"
890 401
			'sentence 'used 'was
891
			"..."
892 102254
			'(doc// doctor--bak))))
893 108610
   ((memq (car doctor-sent) '(are is do has have how when where who why))
894 102254
    (doctor-type (doc$ doctor--qlist)))
895 103967
   ;;   ((eq (car sent) 'forget)
896
   ;;    (set (cadr sent) nil)
897
   ;;    (doctor-type '((doc$ doctor--isee) (doc$ doctor--please)
898 102254
   ;;     (doc$ doctor--continue)\.)))
899 401
   (t
900 108610
    (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found))
901
    (if (> (length doctor-sent) 12)
902
	(setq doctor-sent (doctor-shorten doctor-sent)))
903
    (setq doctor-sent (doctor-correct-spelling
904
		       (doctor-replace doctor-sent doctor--replist)))
905
    (cond ((and (not (memq 'me doctor-sent)) (not (memq 'i doctor-sent))
906
		(memq 'am doctor-sent))
907
	   (setq doctor-sent (doctor-replace doctor-sent '((am . (are)))))))
908
    (cond ((equal (car doctor-sent) 'yow) (doctor-zippy))
909
	  ((< (length doctor-sent) 2)
910
	   (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy)
911 401
		  (doctor-howdy))
912
		 (t (doctor-short))))
913
	  (t
914 108610
	   (if (memq 'am doctor-sent)
915
	       (setq doctor-sent (doctor-replace doctor-sent '((me . (i))))))
916
	   (setq doctor-sent (doctor-fixup doctor-sent))
917
	   (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not))
918 401
	       (cond ((zerop (random 3))
919 102254
		      (doctor-type '(are you (doc$ doctor--afraidof) that \?)))
920 401
		     ((zerop (random 2))
921
		      (doctor-type '(don\'t tell me what to do \. i am the
922 49780.1.32
					    doctor here!))
923 401
		      (doctor-rthing))
924
		     (t
925 102254
		      (doctor-type '((doc$ doctor--whysay) that i shouldn\'t
926 108610
				     (cddr doctor-sent)
927 401
				     \?))))
928 108610
	     (doctor-go (doctor-wherego doctor-sent))))))))
929 401

930
;; Things done to process sentences once read.
931
932
(defun doctor-correct-spelling (sent)
933
  "Correct the spelling and expand each word in sentence."
934
  (if sent
935 30888
      (apply 'append (mapcar (lambda (word)
936 102254
				(if (memq word doctor--typos)
937
				    (get (get word 'doctor-correction)
938
					 'doctor-expansion)
939 401
				  (list word)))
940
			     sent))))
941
942
(defun doctor-shorten (sent)
943 3592
  "Make a sentence manageably short using a few hacks."
944 401
  (let (foo
945 47299
	(retval sent)
946 401
	(temp '(because but however besides anyway until
947
		    while that except why how)))
948
    (while temp
949
	   (setq foo (memq (car temp) sent))
950
	   (if (and foo
951
		    (> (length foo) 3))
952 47299
	       (setq retval (doctor-fixup foo)
953
		     temp nil)
954 401
	       (setq temp (cdr temp))))
955
    retval))
956
957
(defun doctor-define (sent found)
958
  (doctor-svo sent found 1 nil)
959
  (and
960 102254
   (doctor-nounp doctor-subj)
961
   (not (doctor-pronounp doctor-subj))
962
   doctor-subj
963
   (doctor-meaning doctor-object)
964
   (put doctor-subj 'doctor-meaning (doctor-meaning doctor-object))
965 401
   t))
966
967
(defun doctor-defq (sent)
968 102254
  "Set global var DOCTOR-FOUND to first keyword found in sentence SENT."
969
  (setq doctor-found nil)
970 401
  (let ((temp '(means applies mean refers refer related
971
		      similar defined associated linked like same)))
972
    (while temp
973
	   (if (memq (car temp) sent)
974 102254
	       (setq doctor-found (car temp)
975 401
		     temp nil)
976
	       (setq temp (cdr temp)))))
977 102254
  doctor-found)
978 401
979
(defun doctor-def (x)
980 102254
  (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me))
981
  nil)
982 401
983
(defun doctor-forget ()
984
  "Delete the last element of the history list."
985 102254
  (setq doctor--history (reverse (cdr (reverse doctor--history)))))
986 401
987
(defun doctor-query (x)
988
  "Prompt for a line of input from the minibuffer until a noun or verb is seen.
989
Put dialogue in buffer."
990
  (let (a
991
	(prompt (concat (doctor-make-string x)
992
			" what \?  "))
993
	retval)
994
    (while (not retval)
995
	   (while (not a)
996
	     (insert ?\n
997
		     prompt
998
		     (read-string prompt)
999
		     ?\n)
1000
	     (setq a (doctor-readin)))
1001
	   (while (and a (not retval))
1002
		  (cond ((doctor-nounp (car a))
1003
			 (setq retval (car a)))
1004
			((doctor-verbp (car a))
1005
			 (setq retval (doctor-build
1006
				       (doctor-build x " ")
1007
				       (car a))))
1008
			((setq a (cdr a))))))
1009
    retval))
1010
1011
(defun doctor-subjsearch (sent key type)
1012
  "Search for the subject of a sentence SENT, looking for the noun closest
1013 102254
to and preceding KEY by at least TYPE words.  Set global variable doctor-subj to
1014 401
the subject noun, and return the portion of the sentence following it."
1015
  (let ((i (- (length sent) (length (memq key sent)) type)))
1016
    (while (and (> i -1) (not (doctor-nounp (nth i sent))))
1017
      (setq i (1- i)))
1018
    (cond ((> i -1)
1019 102254
	   (setq doctor-subj (nth i sent))
1020 401
	   (nthcdr (1+ i) sent))
1021
	  (t
1022 102254
	   (setq doctor-subj 'you)
1023 401
	   nil))))
1024
1025
(defun doctor-nounp (x)
1026 99634.2.92...
  "Return t if the symbol argument is a noun."
1027 401
	(or (doctor-pronounp x)
1028
	    (not (or (doctor-verbp x)
1029
		     (equal x 'not)
1030
		     (doctor-prepp x)
1031
		     (doctor-modifierp x) )) ))
1032
1033
(defun doctor-pronounp (x)
1034 99634.2.92...
  "Return t if the symbol argument is a pronoun."
1035 401
  (memq x '(
1036
	i me mine myself
1037
	we us ours ourselves ourself
1038
	you yours yourself yourselves
1039
	he him himself she hers herself
1040
	it that those this these things thing
1041
	they them themselves theirs
1042
	anybody everybody somebody
1043
	anyone everyone someone
1044
	anything something everything)))
1045
1046 68211
(dolist (x
1047
         '(abort aborted aborts ask asked asks am
1048
           applied applies apply are associate
1049
           associated ate
1050
           be became become becomes becoming
1051
           been being believe believed believes
1052
           bit bite bites bore bored bores boring bought buy buys buying
1053
           call called calling calls came can caught catch come
1054
           contract contracted contracts control controlled controls
1055
           could croak croaks croaked cut cuts
1056
           dare dared define defines dial dialed dials did die died dies
1057
           dislike disliked
1058
           dislikes do does drank drink drinks drinking
1059
           drive drives driving drove dying
1060
           eat eating eats expand expanded expands
1061
           expect expected expects expel expels expelled
1062
           explain explained explains
1063
           fart farts feel feels felt fight fights find finds finding
1064
           forget forgets forgot fought found
1065
           fuck fucked fucking fucks
1066
           gave get gets getting give gives go goes going gone got gotten
1067
           had harm harms has hate hated hates have having
1068
           hear heard hears hearing help helped helping helps
1069
           hit hits hope hoped hopes hurt hurts
1070
           implies imply is
1071
           join joined joins jump jumped jumps
1072
           keep keeping keeps kept
1073
           kill killed killing kills kiss kissed kisses kissing
1074
           knew know knows
1075
           laid lay lays let lets lie lied lies like liked likes
1076
           liking listen listens
1077
           login look looked looking looks
1078
           lose losing lost
1079
           love loved loves loving
1080
           luse lusing lust lusts
1081
           made make makes making may mean means meant might
1082
           move moved moves moving must
1083
           need needed needs
1084
           order ordered orders ought
1085
           paid pay pays pick picked picking picks
1086
           placed placing prefer prefers put puts
1087
           ran rape raped rapes
1088
           read reading reads recall receive received receives
1089
           refer refered referred refers
1090
           relate related relates remember remembered remembers
1091
           romp romped romps run running runs
1092
           said sang sat saw say says
1093
           screw screwed screwing screws scrod see sees seem seemed
1094
           seems seen sell selling sells
1095
           send sendind sends sent shall shoot shot should
1096
           sing sings sit sits sitting sold studied study
1097
           take takes taking talk talked talking talks tell tells telling
1098
           think thinks
1099
           thought told took tooled touch touched touches touching
1100
           transfer transferred transfers transmit transmits transmitted
1101
           type types types typing
1102
           walk walked walking walks want wanted wants was watch
1103
           watched watching went were will wish would work worked works
1104
           write writes writing wrote use used uses using))
1105
  (put x 'doctor-sentence-type 'verb))
1106 401
1107
(defun doctor-verbp (x) (if (symbolp x)
1108
			    (eq (get x 'doctor-sentence-type) 'verb)))
1109
1110
(defun doctor-plural (x)
1111
  "Form the plural of the word argument."
1112
  (let ((foo (doctor-make-string x)))
1113
    (cond ((string-equal (substring foo -1) "s")
1114
	   (cond ((string-equal (substring foo -2 -1) "s")
1115
		  (intern (concat foo "es")))
1116
		 (t x)))
1117
	   ((string-equal (substring foo -1) "y")
1118
	    (intern (concat (substring foo 0 -1)
1119
			    "ies")))
1120
	   (t (intern (concat foo "s"))))))
1121
1122
(defun doctor-setprep (sent key)
1123
  (let ((val)
1124
	(foo (memq key sent)))
1125 47307
    (cond ((doctor-prepp (cadr foo))
1126
	   (setq val (doctor-getnoun (cddr foo)))
1127 401
	   (cond (val val)
1128
		 (t 'something)))
1129 47307
	  ((doctor-articlep (cadr foo))
1130
	   (setq val (doctor-getnoun (cddr foo)))
1131
	   (cond (val (doctor-build (doctor-build (cadr foo) " ") val))
1132 401
		 (t 'something)))
1133
	  (t 'something))))
1134
1135
(defun doctor-getnoun (x)
1136 103967
  (cond ((null x) (setq doctor-object 'something))
1137
	((atom x) (setq doctor-object x))
1138 401
	((eq (length x) 1)
1139 102254
	 (setq doctor-object (cond
1140
		       ((doctor-nounp (setq doctor-object (car x))) doctor-object)
1141
		       (t (doctor-query doctor-object)))))
1142 401
	((eq (car x) 'to)
1143
	 (doctor-build 'to\  (doctor-getnoun (cdr x))))
1144
	((doctor-prepp (car x))
1145
	 (doctor-getnoun (cdr x)))
1146
	((not (doctor-nounp (car x)))
1147
	 (doctor-build (doctor-build (cdr (assq (car x)
1148
						(append
1149
						 '((a . this)
1150
						   (some . this)
1151
						   (one . that))
1152
						 (list
1153
						  (cons
1154
						   (car x) (car x))))))
1155
				     " ")
1156
		       (doctor-getnoun (cdr x))))
1157 102254
	(t (setq doctor-object (car x))
1158 47573
	   (doctor-build (doctor-build (car x) " ") (doctor-getnoun (cdr x))))
1159
	))
1160 401
1161
(defun doctor-modifierp (x)
1162
  (or (doctor-adjectivep x)
1163
      (doctor-adverbp x)
1164
      (doctor-othermodifierp x)))
1165
1166
(defun doctor-adjectivep (x)
1167
  (or (numberp x)
1168
      (doctor-nmbrp x)
1169
      (doctor-articlep x)
1170
      (doctor-colorp x)
1171
      (doctor-sizep x)
1172
      (doctor-possessivepronounp x)))
1173
1174
(defun doctor-adverbp (xx)
1175 5283
  (let ((xxstr (doctor-make-string xx)))
1176
    (and (>= (length xxstr) 2)
1177 98186
	 (string-equal (substring (doctor-make-string xx) -2) "ly")
1178
	 (not (memq xx '(family fly jelly rally))))))
1179 401
1180
(defun doctor-articlep (x)
1181
  (memq x '(the a an)))
1182
1183
(defun doctor-nmbrp (x)
1184
  (memq x '(one two three four five six seven eight nine ten
1185
		eleven twelve thirteen fourteen fifteen
1186
		sixteen seventeen eighteen nineteen
1187
		twenty thirty forty fifty sixty seventy eighty ninety
1188
		hundred thousand million billion
1189
		half quarter
1190
		first second third fourth fifth
1191 3592
		sixth seventh eighth ninth tenth)))
1192 49583
1193 401
(defun doctor-colorp (x)
1194
  (memq x '(beige black blue brown crimson
1195
		  gray grey green
1196
		  orange pink purple red tan tawny
1197
		  violet white yellow)))
1198
1199
(defun doctor-sizep (x)
1200
  (memq x '(big large tall fat wide thick
1201
		small petite short thin skinny)))
1202
1203
(defun doctor-possessivepronounp (x)
1204
  (memq x '(my your his her our their)))
1205
1206
(defun doctor-othermodifierp (x)
1207
  (memq x '(all also always amusing any anyway associated awesome
1208
		bad beautiful best better but certain clear
1209
		ever every fantastic fun funny
1210 13957
		good great grody gross however if ignorant
1211 401
		less linked losing lusing many more much
1212
		never nice obnoxious often poor pretty real related rich
1213
		similar some stupid super superb
1214
		terrible terrific too total tubular ugly very)))
1215
1216
(defun doctor-prepp (x)
1217
  (memq x '(about above after around as at
1218
		  before beneath behind beside between by
1219
		  for from in inside into
1220
		  like near next of on onto over
1221
		  same through thru to toward towards
1222
		  under underneath with without)))
1223
1224
(defun doctor-remember (thing)
1225 102254
  (cond ((null doctor--history)
1226
	 (setq doctor--history (list thing)))
1227
	(t (setq doctor--history (append doctor--history (list thing))))))
1228 401
1229
(defun doctor-type (x)
1230
  (setq x (doctor-fix-2 x))
1231
  (doctor-txtype (doctor-assm x)))
1232
1233
(defun doctor-fixup (sent)
1234
  (setq sent (append
1235
	      (cdr
1236
	       (assq (car sent)
1237
		     (append
1238
		      '((me  i)
1239
			(him  he)
1240
			(her  she)
1241
			(them  they)
1242
			(okay)
1243
			(well)
1244
			(sigh)
1245
			(hmm)
1246
			(hmmm)
1247
			(hmmmm)
1248
			(hmmmmm)
1249
			(gee)
1250
			(sure)
1251
			(great)
1252
			(oh)
1253
			(fine)
1254
			(ok)
1255
			(no))
1256
		      (list (list (car sent)
1257
				  (car sent))))))
1258
	      (cdr sent)))
1259
  (doctor-fix-2 sent))
1260
1261
(defun doctor-fix-2 (sent)
1262
  (let ((foo sent))
1263
    (while foo
1264
      (if (and (eq (car foo) 'me)
1265 47307
	       (doctor-verbp (cadr foo)))
1266 401
	  (rplaca foo 'i)
1267
	(cond ((eq (car foo) 'you)
1268 47307
	       (cond ((memq (cadr foo) '(am be been is))
1269 401
		      (rplaca (cdr foo) 'are))
1270 47307
		     ((memq (cadr foo) '(has))
1271 401
		      (rplaca (cdr foo) 'have))
1272 47307
		     ((memq (cadr foo) '(was))
1273 401
		      (rplaca (cdr foo) 'were))))
1274
	      ((equal (car foo) 'i)
1275 47307
	       (cond ((memq (cadr foo) '(are is be been))
1276 401
		      (rplaca (cdr foo) 'am))
1277 47307
		     ((memq (cadr foo) '(were))
1278 401
		      (rplaca (cdr foo) 'was))
1279 47307
		     ((memq (cadr foo) '(has))
1280 401
		      (rplaca (cdr foo) 'have))))
1281
	      ((and (doctor-verbp (car foo))
1282 47307
		    (eq (cadr foo) 'i)
1283
		    (not (doctor-verbp (car (cddr foo)))))
1284 401
	       (rplaca (cdr foo) 'me))
1285
	      ((and (eq (car foo) 'a)
1286
		    (doctor-vowelp (string-to-char
1287 47307
				    (doctor-make-string (cadr foo)))))
1288 401
	       (rplaca foo 'an))
1289
	      ((and (eq (car foo) 'an)
1290
		    (not (doctor-vowelp (string-to-char
1291 47307
					 (doctor-make-string (cadr foo))))))
1292 401
	       (rplaca foo 'a)))
1293
	(setq foo (cdr foo))))
1294
    sent))
1295
1296
(defun doctor-vowelp (x)
1297
  (memq x '(?a ?e ?i ?o ?u)))
1298
1299
(defun doctor-replace (sent rlist)
1300
  "Replace any element of SENT that is the car of a replacement
1301
element pair in RLIST."
1302
  (apply 'append
1303
	 (mapcar
1304
	   (lambda (x)
1305
	     (cdr (or (assq x rlist)   ; either find a replacement
1306 102254
		      (list x x))))    ; or fake an identity mapping
1307
	   sent)))
1308 401
1309
(defun doctor-wherego (sent)
1310 103967
  (cond ((null sent) (doc$ doctor--whereoutp))
1311 401
	((null (doctor-meaning (car sent)))
1312
	 (doctor-wherego (cond ((zerop (random 2))
1313
				(reverse (cdr sent)))
1314
			       (t (cdr sent)))))
1315
	(t
1316 102254
	 (setq doctor-found (car sent))
1317 401
	 (doctor-meaning (car sent)))))
1318
1319
(defun doctor-svo (sent key type mem)
1320
  "Find subject, verb and object in sentence SENT with focus on word KEY.
1321
TYPE is number of words preceding KEY to start looking for subject.
1322
MEM is t if results are to be put on Doctor's memory stack.
1323 102254
Return in the global variables DOCTOR-SUBJ, DOCTOR-VERB, DOCTOR-OBJECT,
1324
and DOCTOR-OBJ."
1325 622
  (let ((foo (doctor-subjsearch sent key type)))
1326 401
    (or foo
1327
	(setq foo sent
1328
	      mem nil))
1329
    (while (and (null (doctor-verbp (car foo))) (cdr foo))
1330
      (setq foo (cdr foo)))
1331 102254
    (setq doctor-verb (car foo))
1332
    (setq doctor-obj (doctor-getnoun (cdr foo)))
1333 103967
    (cond ((eq doctor-object 'i) (setq doctor-object 'me))
1334
	  ((eq doctor-subj 'me) (setq doctor-subj 'i)))
1335 102254
    (cond (mem (doctor-remember (list doctor-subj doctor-verb doctor-obj))))))
1336 401
1337
(defun doctor-possess (sent key)
1338
  "Set possessive in SENT for keyword KEY.
1339 102254
Hack on previous word, setting global variable DOCTOR-OWNER to correct result."
1340 401
  (let* ((i (- (length sent) (length (memq key sent)) 1))
1341
	 (prev (if (< i 0) 'your
1342
		 (nth i sent))))
1343 102254
    (setq doctor-owner
1344
	  (if (or (doctor-possessivepronounp prev)
1345
		  (string-equal "s"
1346
				(substring (doctor-make-string prev)
1347
					   -1)))
1348
	      prev
1349
	    'your))))
1350 401

1351
;; Output of replies.
1352
1353
(defun doctor-txtype (ans)
1354
  "Output to buffer a list of symbols or strings as a sentence."
1355 102254
  (setq doctor--*print-upcase* t doctor--*print-space* nil)
1356 68211
  (mapc 'doctor-type-symbol ans)
1357 401
  (insert "\n"))
1358
1359
(defun doctor-type-symbol (word)
1360
  "Output a symbol to the buffer with some fancy case and spacing hacks."
1361
  (setq word (doctor-make-string word))
1362
  (if (string-equal word "i") (setq word "I"))
1363 102254
  (when doctor--*print-upcase*
1364
    (setq word (capitalize word))
1365
    (if doctor--*print-space* (insert " ")))
1366 401
  (cond ((or (string-match "^[.,;:?! ]" word)
1367 102254
	     (not doctor--*print-space*))
1368 401
	 (insert word))
1369 49780.1.32
	(t (insert ?\s word)))
1370 4250
  (and auto-fill-function
1371
       (> (current-column) fill-column)
1372
       (apply auto-fill-function nil))
1373 102254
  (setq doctor--*print-upcase* (string-match "[.?!]$" word)
1374
	doctor--*print-space* t))
1375 401
1376
(defun doctor-build (str1 str2)
1377
  "Make a symbol out of the concatenation of the two non-list arguments."
1378
  (cond ((null str1) str2)
1379
	((null str2) str1)
1380
	((and (atom str1)
1381
	      (atom str2))
1382
	 (intern (concat (doctor-make-string str1)
1383
			 (doctor-make-string str2))))
1384
	(t nil)))
1385
1386
(defun doctor-make-string (obj)
1387
  (cond ((stringp obj) obj)
1388
	((symbolp obj) (symbol-name obj))
1389
	((numberp obj) (int-to-string obj))
1390
	(t "")))
1391
1392
(defun doctor-concat (x y)
1393
  "Like append, but force atomic arguments to be lists."
1394
  (append
1395
   (if (and x (atom x)) (list x) x)
1396
   (if (and y (atom y)) (list y) y)))
1397
1398
(defun doctor-assm (proto)
1399
  (cond ((null proto) nil)
1400
	((atom proto) (list proto))
1401
	((atom (car proto))
1402
	 (cons (car proto) (doctor-assm (cdr proto))))
1403
	(t (doctor-concat (doctor-assm (eval (car proto))) (doctor-assm (cdr proto))))))
1404

1405
;; Functions that handle specific words or meanings when found.
1406
1407
(defun doctor-go (destination)
1408
  "Call a `doctor-*' function."
1409
  (funcall (intern (concat "doctor-" (doctor-make-string destination)))))
1410
1411
(defun doctor-desire1 ()
1412 102254
  (doctor-go (doc$ doctor--whereoutp)))
1413 401
1414
(defun doctor-huh ()
1415 102254
  (cond ((< (length doctor-sent) 9) (doctor-type (doc$ doctor--huhlst)))
1416
	(t (doctor-type (doc$ doctor--longhuhlst)))))
1417
1418
(defun doctor-rthing () (doctor-type (doc$ doctor--thlst)))
1419
1420 103967
(defun doctor-remem () (cond ((null doctor--history) (doctor-huh))
1421 102254
			     ((doctor-type (doc$ doctor--remlst)))))
1422 401
1423
(defun doctor-howdy ()
1424 102254
  (cond ((not doctor--howdyflag)
1425
	 (doctor-type '((doc$ doctor--hello) what brings you to see me \?))
1426
	 (setq doctor--howdyflag t))
1427 401
	(t
1428 102254
	 (doctor-type '((doc$ doctor--ibelieve) we\'ve introduced ourselves already \.))
1429
	 (doctor-type '((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--things) \.)))))
1430 401
1431
(defun doctor-when ()
1432 103967
  (cond ((< (length (memq doctor-found doctor-sent)) 3) (doctor-short))
1433 401
	(t
1434 102254
	 (setq doctor-sent (cdr (memq doctor-found doctor-sent)))
1435
	 (setq doctor-sent (doctor-fixup doctor-sent))
1436 103967
	 (doctor-type '((doc$ doctor--whatwhen) (doc// doctor-sent) \?)))))
1437 401
1438
(defun doctor-conj ()
1439 103967
  (cond ((< (length (memq doctor-found doctor-sent)) 4) (doctor-short))
1440 401
	(t
1441 102254
	 (setq doctor-sent (cdr (memq doctor-found doctor-sent)))
1442
	 (setq doctor-sent (doctor-fixup doctor-sent))
1443
	 (cond ((eq (car doctor-sent) 'of)
1444
		(doctor-type '(are you (doc$ doctor--sure) that is the real reason \?))
1445
		(setq doctor--things (cons (cdr doctor-sent) doctor--things)))
1446 401
	       (t
1447 102254
		(doctor-remember doctor-sent)
1448
		(doctor-type (doc$ doctor--beclst)))))))
1449 401
1450
(defun doctor-short ()
1451 102254
  (cond ((= (car doctor--repetitive-shortness) (1- doctor--lincount))
1452
	 (rplacd doctor--repetitive-shortness
1453
		 (1+ (cdr doctor--repetitive-shortness))))
1454 401
	(t
1455 102254
	 (rplacd doctor--repetitive-shortness 1)))
1456
  (rplaca doctor--repetitive-shortness doctor--lincount)
1457
  (cond ((> (cdr doctor--repetitive-shortness) 6)
1458
	 (cond ((not doctor--**mad**)
1459
		(doctor-type '((doc$ doctor--areyou)
1460 401
			       just trying to see what kind of things
1461
			       i have in my vocabulary \? please try to
1462
			       carry on a reasonable conversation!))
1463 102254
		(setq doctor--**mad** t))
1464 401
	       (t
1465
		(doctor-type '(i give up \. you need a lesson in creative
1466
				 writing \.\.\.))
1467
		)))
1468
	(t
1469 102254
	 (cond ((equal doctor-sent (doctor-assm '(yes)))
1470
		(doctor-type '((doc$ doctor--isee) (doc$ doctor--inter) (doc$ doctor--whysay) this is so \?)))
1471
	       ((equal doctor-sent (doctor-assm '(because)))
1472
		(doctor-type (doc$ doctor--shortbeclst)))
1473
	       ((equal doctor-sent (doctor-assm '(no)))
1474
		(doctor-type (doc$ doctor--neglst)))
1475
	       (t (doctor-type (doc$ doctor--shortlst)))))))
1476 49583
1477 102254
(defun doctor-alcohol () (doctor-type (doc$ doctor--drnk)))
1478 401
1479
(defun doctor-desire ()
1480 102254
  (let ((foo (memq doctor-found doctor-sent)))
1481 401
    (cond ((< (length foo) 2)
1482 102254
	   (doctor-go (doctor-build (doctor-meaning doctor-found) 1)))
1483 47307
	  ((memq (cadr foo) '(a an))
1484 401
	   (rplacd foo (append '(to have) (cdr foo)))
1485 102254
	   (doctor-svo doctor-sent doctor-found 1 nil)
1486
	   (doctor-remember (list doctor-subj 'would 'like doctor-obj))
1487
	   (doctor-type (doc$ doctor--whywant)))
1488 47307
	  ((not (eq (cadr foo) 'to))
1489 102254
	   (doctor-go (doctor-build (doctor-meaning doctor-found) 1)))
1490 401
	  (t
1491 102254
	   (doctor-svo doctor-sent doctor-found 1 nil)
1492
	   (doctor-remember (list doctor-subj 'would 'like doctor-obj))
1493
	   (doctor-type (doc$ doctor--whywant))))))
1494 401
1495
(defun doctor-drug ()
1496 102254
  (doctor-type (doc$ doctor--drugs))
1497
  (doctor-remember (list 'you 'used doctor-found)))
1498 401
1499
(defun doctor-toke ()
1500 102254
  (doctor-type (doc$ doctor--toklst)))
1501 401
1502
(defun doctor-state ()
1503 103967
  (doctor-type (doc$ doctor--states)) (doctor-remember (list 'you 'were doctor-found)))
1504 401
1505
(defun doctor-mood ()
1506 103967
  (doctor-type (doc$ doctor--moods)) (doctor-remember (list 'you 'felt doctor-found)))
1507 401
1508
(defun doctor-fear ()
1509 102254
  (setq doctor--feared (doctor-setprep doctor-sent doctor-found))
1510
  (doctor-type (doc$ doctor--fears))
1511
  (doctor-remember (list 'you 'were 'afraid 'of doctor--feared)))
1512 401
1513
(defun doctor-hate ()
1514 102254
  (doctor-svo doctor-sent doctor-found 1 t)
1515
  (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh))
1516
	((equal doctor-subj 'you)
1517 103967
	 (doctor-type '(why do you (doc// doctor-verb) (doc// doctor-obj) \?)))
1518
	(t (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj))))))
1519 401
1520
(defun doctor-symptoms ()
1521 102254
  (doctor-type '((doc$ doctor--maybe) you should consult a medical doctor\;
1522 49780.1.32
		 i am a psychotherapist. \.)))
1523 401
1524
(defun doctor-hates ()
1525 102254
  (doctor-svo doctor-sent doctor-found 1 t)
1526 401
  (doctor-hates1))
1527
1528
(defun doctor-hates1 ()
1529 103967
  (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj) \?)))
1530 401
1531
(defun doctor-loves ()
1532 102254
  (doctor-svo doctor-sent doctor-found 1 t)
1533 401
  (doctor-qloves))
1534
1535
(defun doctor-qloves ()
1536 103967
  (doctor-type '((doc$ doctor--bother) (list doctor-subj doctor-verb doctor-obj) \?)))
1537 401
1538
(defun doctor-love ()
1539 102254
  (doctor-svo doctor-sent doctor-found 1 t)
1540
  (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh))
1541
	((memq 'to doctor-sent) (doctor-hates1))
1542 401
	(t
1543 102254
	 (cond ((equal doctor-object 'something)
1544
		(setq doctor-object '(this person you love))))
1545
	 (cond ((equal doctor-subj 'you)
1546
		(setq doctor--lover doctor-obj)
1547
		(cond ((equal doctor--lover '(this person you love))
1548
		       (setq doctor--lover '(your partner))
1549 401
		       (doctor-forget)
1550
		       (doctor-type '(with whom are you in love \?)))
1551 102254
		      ((doctor-type '((doc$ doctor--please)
1552
				      (doc$ doctor--describe)
1553
				      (doc$ doctor--relation)
1554
				      (doc// doctor--lover)
1555 401
				      \.)))))
1556 102254
	       ((equal doctor-subj 'i)
1557 401
		(doctor-txtype '(we were discussing you!)))
1558
	       (t (doctor-forget)
1559 102254
		  (setq doctor-obj 'someone)
1560
		  (setq doctor-verb (doctor-build doctor-verb 's))
1561 401
		  (doctor-qloves))))))
1562
1563
(defun doctor-mach ()
1564 102254
  (setq doctor-found (doctor-plural doctor-found))
1565
  (doctor-type (doc$ doctor--machlst)))
1566 401
1567
(defun doctor-sexnoun () (doctor-sexverb))
1568
1569
(defun doctor-sexverb ()
1570 103967
  (if (or (memq 'me doctor-sent) (memq 'myself doctor-sent) (memq 'i doctor-sent))
1571 401
      (doctor-foul)
1572 102254
    (doctor-type (doc$ doctor--sexlst))))
1573 401
1574 18390
(defun doctor-death ()
1575 102254
  (cond (doctor--suicide-flag (doctor-type (doc$ doctor--deathlst)))
1576
	((or (equal doctor-found 'suicide)
1577
             (and (or (equal doctor-found 'kill)
1578
                      (equal doctor-found 'killing))
1579
                  (memq 'yourself doctor-sent)))
1580
	 (setq doctor--suicide-flag t)
1581 106792
	 (doctor-type '(If you are really suicidal\, you might
1582 18390
			   want to contact the Samaritans via
1583 106792
			   E-mail: jo@samaritans.org or\, at your option\,
1584 32660
			   anonymous E-mail: samaritans@anon.twwells.com\ \.
1585
                           or find a Befrienders crisis center at
1586
			   http://www.befrienders.org/\ \.
1587 102254
			   (doc$ doctor--please) (doc$ doctor--continue) \.)))
1588
	(t (doctor-type (doc$ doctor--deathlst)))))
1589 401
1590
(defun doctor-foul ()
1591 102254
  (doctor-type (doc$ doctor--foullst)))
1592 401
1593
(defun doctor-family ()
1594 102254
  (doctor-possess doctor-sent doctor-found)
1595
  (doctor-type (doc$ doctor--famlst)))
1596 401
1597
;; I did not add this -- rms.
1598
;; But he might have removed it.  I put it back.  --roland
1599
(defun doctor-rms ()
1600 102254
  (cond (doctor--rms-flag (doctor-type (doc$ doctor--stallmanlst)))
1601
	(t (setq doctor--rms-flag t) (doctor-type '(do you know Stallman \?)))))
1602 401
1603 102254
(defun doctor-school nil (doctor-type (doc$ doctor--schoollst)))
1604 401
1605
(defun doctor-eliza ()
1606 102254
  (cond (doctor--eliza-flag (doctor-type (doc$ doctor--elizalst)))
1607
	(t (setq doctor--eliza-flag t)
1608
	   (doctor-type '((doc// doctor-found) \? hah !
1609
			  (doc$ doctor--please) (doc$ doctor--continue) \.)))))
1610
1611
(defun doctor-sports () (doctor-type (doc$ doctor--sportslst)))
1612
1613
(defun doctor-math () (doctor-type (doc$ doctor--mathlst)))
1614 401
1615
(defun doctor-zippy ()
1616 102254
  (cond (doctor--zippy-flag (doctor-type (doc$ doctor--zippylst)))
1617
	(t (setq doctor--zippy-flag t)
1618 401
	   (doctor-type '(yow! are we interactive yet \?)))))
1619
1620
1621 102254
(defun doctor-chat () (doctor-type (doc$ doctor--chatlst)))
1622 401
1623 18384
(provide 'doctor)
1624
1625 663
;;; doctor.el ends here

Loggerhead 1.18.1 is a web-based interface for Bazaar branches