/[emacs]/emacs/lisp/play/doctor.el
ViewVC logotype

Diff of /emacs/lisp/play/doctor.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.27 by gerd, Tue Oct 23 16:15:39 2001 UTC revision 1.27.4.1 by miles, Fri Apr 4 06:20:31 2003 UTC
# Line 45  Line 45 
45    
46  ;;; Code:  ;;; Code:
47    
48  (defun doctor-cadr (x) (car (cdr x)))  (defun doc// (x) x)
 (defun doctor-caddr (x) (car (cdr (cdr x))))  
 (defun doctor-cddr (x) (cdr (cdr x)))  
49    
50  (defun // (x) x)  (defmacro doc$ (what)
   
 (defmacro $ (what)  
51    "quoted arg form of doctor-$"    "quoted arg form of doctor-$"
52    (list 'doctor-$ (list 'quote what)))    (list 'doctor-$ (list 'quote what)))
53    
# Line 83  reads the sentence before point, and pri Line 79  reads the sentence before point, and pri
79    (setq mode-name "Doctor")    (setq mode-name "Doctor")
80    (turn-on-auto-fill)    (turn-on-auto-fill)
81    (doctor-type '(i am the psychotherapist \.    (doctor-type '(i am the psychotherapist \.
82                   ($ please) ($ describe) your ($ problems) \.                   (doc$ please) (doc$ describe) your (doc$ problems) \.
83                   each time you are finished talking, type \R\E\T twice \.))                   each time you are finished talking, type \R\E\T twice \.))
84    (insert "\n"))    (insert "\n"))
85    
# Line 91  reads the sentence before point, and pri Line 87  reads the sentence before point, and pri
87    (make-local-variable 'typos)    (make-local-variable 'typos)
88    (setq typos    (setq typos
89          (mapcar (function (lambda (x)          (mapcar (function (lambda (x)
90                              (put (car x) 'doctor-correction  (doctor-cadr x))                              (put (car x) 'doctor-correction  (cadr x))
91                              (put (doctor-cadr x) 'doctor-expansion (doctor-caddr x))                              (put (cadr x) 'doctor-expansion (car (cddr x)))
92                              (car x)))                              (car x)))
93                  '((theyll they\'ll (they will))                  '((theyll they\'ll (they will))
94                    (theyre they\'re (they are))                    (theyre they\'re (they are))
# Line 136  reads the sentence before point, and pri Line 132  reads the sentence before point, and pri
132            (some experiences you have had with)            (some experiences you have had with)
133            (how you feel about)))            (how you feel about)))
134    (make-local-variable 'fears)    (make-local-variable 'fears)
135    (setq fears '( (($ whysay) you are ($ afraidof) (// feared) \?)    (setq fears '( ((doc$ whysay) you are (doc$ afraidof) (doc// feared) \?)
136                   (you seem terrified by (// feared) \.)                   (you seem terrified by (doc// feared) \.)
137                   (when did you first feel ($ afraidof) (// feared) \?) ))                   (when did you first feel (doc$ afraidof) (doc// feared) \?) ))
138    (make-local-variable 'sure)    (make-local-variable 'sure)
139    (setq sure '((sure)(positive)(certain)(absolutely sure)))    (setq sure '((sure)(positive)(certain)(absolutely sure)))
140    (make-local-variable 'afraidof)    (make-local-variable 'afraidof)
# Line 153  reads the sentence before point, and pri Line 149  reads the sentence before point, and pri
149                       (could have caused)(could be the reason for) (are caused by)                       (could have caused)(could be the reason for) (are caused by)
150                       (are because of)))                       (are because of)))
151    (make-local-variable 'moods)    (make-local-variable 'moods)
152    (setq moods '( (($ areyou)(// found) often \?)    (setq moods '( ((doc$ areyou)(doc// found) often \?)
153                   (what causes you to be (// found) \?)                   (what causes you to be (doc// found) \?)
154                   (($ whysay) you are (// found) \?) ))                   ((doc$ whysay) you are (doc// found) \?) ))
155    (make-local-variable 'maybe)    (make-local-variable 'maybe)
156    (setq maybe    (setq maybe
157          '((maybe)          '((maybe)
# Line 170  reads the sentence before point, and pri Line 166  reads the sentence before point, and pri
166          '((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.)))          '((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.)))
167    (make-local-variable 'drnk)    (make-local-variable 'drnk)
168    (setq drnk    (setq drnk
169          '((do you drink a lot of (// found) \?)          '((do you drink a lot of (doc// found) \?)
170            (do you get drunk often \?)            (do you get drunk often \?)
171            (($ describe) your drinking habits \.) ))            ((doc$ describe) your drinking habits \.) ))
172    (make-local-variable 'drugs)    (make-local-variable 'drugs)
173    (setq drugs '( (do you use (// found) often \?)(($ areyou)    (setq drugs '( (do you use (doc// found) often \?)((doc$ areyou)
174                                                   addicted to (// found) \?)(do you realize that drugs can                                                   addicted to (doc// found) \?)(do you realize that drugs can
175                                                   be very harmful \?)(($ maybe) you should try to quit using (// found)                                                   be very harmful \?)((doc$ maybe) you should try to quit using (doc// found)
176                                                   \.)))                                                   \.)))
177    (make-local-variable 'whywant)    (make-local-variable 'whywant)
178    (setq whywant '( (($ whysay) (// subj) might ($ want) (// obj) \?)    (setq whywant '( ((doc$ whysay) (doc// subj) might (doc$ want) (doc// obj) \?)
179                     (how does it feel to want \?)                     (how does it feel to want \?)
180                     (why should (// subj) get (// obj) \?)                     (why should (doc// subj) get (doc// obj) \?)
181                     (when did (// subj) first ($ want) (// obj) \?)                     (when did (doc// subj) first (doc$ want) (doc// obj) \?)
182                     (($ areyou) obsessed with (// obj) \?)                     ((doc$ areyou) obsessed with (doc// obj) \?)
183                     (why should i give (// obj) to (// subj) \?)                     (why should i give (doc// obj) to (doc// subj) \?)
184                     (have you ever gotten (// obj) \?) ))                     (have you ever gotten (doc// obj) \?) ))
185    (make-local-variable 'canyou)    (make-local-variable 'canyou)
186    (setq canyou '((of course i can \.)    (setq canyou '((of course i can \.)
187                   (why should i \?)                   (why should i \?)
# Line 202  reads the sentence before point, and pri Line 198  reads the sentence before point, and pri
198    (make-local-variable 'shortlst)    (make-local-variable 'shortlst)
199    (setq shortlst    (setq shortlst
200          '((can you elaborate on that \?)          '((can you elaborate on that \?)
201            (($ please) continue \.)            ((doc$ please) continue \.)
202            (go on\, don\'t be afraid \.)            (go on\, don\'t be afraid \.)
203            (i need a little more detail please \.)            (i need a little more detail please \.)
204            (you\'re being a bit brief\, ($ please) go into detail \.)            (you\'re being a bit brief\, (doc$ please) go into detail \.)
205            (can you be more explicit \?)            (can you be more explicit \?)
206            (and \?)            (and \?)
207            (($ please) go into more detail \?)            ((doc$ please) go into more detail \?)
208            (you aren\'t being very talkative today\!)            (you aren\'t being very talkative today\!)
209            (is that all there is to it \?)            (is that all there is to it \?)
210            (why must you respond so briefly \?)))            (why must you respond so briefly \?)))
211    
212    (make-local-variable 'famlst)    (make-local-variable 'famlst)
213    (setq famlst    (setq famlst
214          '((tell me ($ something) about (// owner) family \.)          '((tell me (doc$ something) about (doc// owner) family \.)
215            (you seem to dwell on (// owner) family \.)            (you seem to dwell on (doc// owner) family \.)
216            (($ areyou) hung up on (// owner) family \?)))            ((doc$ areyou) hung up on (doc// owner) family \?)))
217    (make-local-variable 'huhlst)    (make-local-variable 'huhlst)
218    (setq huhlst    (setq huhlst
219          '((($ whysay)(// sent) \?)          '(((doc$ whysay)(doc// sent) \?)
220            (is it because of ($ things) that you say (// sent) \?) ))            (is it because of (doc$ things) that you say (doc// sent) \?) ))
221    (make-local-variable 'longhuhlst)    (make-local-variable 'longhuhlst)
222    (setq longhuhlst    (setq longhuhlst
223          '((($ whysay) that \?)          '(((doc$ whysay) that \?)
224            (i don\'t understand \.)            (i don\'t understand \.)
225            (($ thlst))            ((doc$ thlst))
226            (($ areyou) ($ afraidof) that \?)))            ((doc$ areyou) (doc$ afraidof) that \?)))
227    (make-local-variable 'feelings-about)    (make-local-variable 'feelings-about)
228    (setq feelings-about    (setq feelings-about
229          '((feelings about)          '((feelings about)
# Line 260  reads the sentence before point, and pri Line 256  reads the sentence before point, and pri
256            (i understand \.)            (i understand \.)
257            (oh \.) ))            (oh \.) ))
258    (make-local-variable 'please)    (make-local-variable 'please)
259    (setq please    (setq please
260          '((please\,)          '((please\,)
261            (i would appreciate it if you would)            (i would appreciate it if you would)
262            (perhaps you could)            (perhaps you could)
# Line 283  reads the sentence before point, and pri Line 279  reads the sentence before point, and pri
279            (more)            (more)
280            (how you feel)))            (how you feel)))
281    (make-local-variable 'things)    (make-local-variable 'things)
282    (setq things    (setq things
283          '(;(your interests in computers)   ;; let's make this less computer oriented          '(;(your interests in computers)   ;; let's make this less computer oriented
284            ;(the machines you use)            ;(the machines you use)
285            (your plans)            (your plans)
# Line 310  reads the sentence before point, and pri Line 306  reads the sentence before point, and pri
306            (tell me more about)            (tell me more about)
307            (elaborate on)))            (elaborate on)))
308    (make-local-variable 'ibelieve)    (make-local-variable 'ibelieve)
309    (setq ibelieve    (setq ibelieve
310          '((i believe) (i think) (i have a feeling) (it seems to me that)          '((i believe) (i think) (i have a feeling) (it seems to me that)
311            (it looks like)))            (it looks like)))
312    (make-local-variable 'problems)    (make-local-variable 'problems)
# Line 328  reads the sentence before point, and pri Line 324  reads the sentence before point, and pri
324            (are you sorry)            (are you sorry)
325            (are you satisfied with the fact that)))            (are you satisfied with the fact that)))
326    (make-local-variable 'machlst)    (make-local-variable 'machlst)
327    (setq machlst    (setq machlst
328          '((you have your mind on (// found) \, it seems \.)          '((you have your mind on (doc// found) \, it seems \.)
329            (you think too much about  (// found) \.)            (you think too much about  (doc// found) \.)
330            (you should try taking your mind off of (// found)\.)            (you should try taking your mind off of (doc// found)\.)
331            (are you a computer hacker \?)))            (are you a computer hacker \?)))
332    (make-local-variable 'qlist)    (make-local-variable 'qlist)
333    (setq qlist    (setq qlist
334          '((what do you think \?)          '((what do you think \?)
335            (i\'ll ask the questions\, if you don\'t mind!)            (i\'ll ask the questions\, if you don\'t mind!)
336            (i could ask the same thing myself \.)            (i could ask the same thing myself \.)
337            (($ please) allow me to do the questioning \.)            ((doc$ please) allow me to do the questioning \.)
338            (i have asked myself that question many times \.)            (i have asked myself that question many times \.)
339            (($ please) try to answer that question yourself \.)))            ((doc$ please) try to answer that question yourself \.)))
340    (make-local-variable 'foullst)    (make-local-variable 'foullst)
341    (setq foullst    (setq foullst
342          '((($ please) watch your tongue!)          '(((doc$ please) watch your tongue!)
343            (($ please) avoid such unwholesome thoughts \.)            ((doc$ please) avoid such unwholesome thoughts \.)
344            (($ please) get your mind out of the gutter \.)            ((doc$ please) get your mind out of the gutter \.)
345            (such lewdness is not appreciated \.)))            (such lewdness is not appreciated \.)))
346    (make-local-variable 'deathlst)    (make-local-variable 'deathlst)
347    (setq deathlst    (setq deathlst
348          '((this is not a healthy way of thinking \.)          '((this is not a healthy way of thinking \.)
349            (($ bother) you\, too\, may die someday \?)            ((doc$ bother) you\, too\, may die someday \?)
350            (i am worried by your obsession with this topic!)            (i am worried by your obsession with this topic!)
351            (did you watch a lot of crime and violence on television as a child \?))            (did you watch a lot of crime and violence on television as a child \?))
352          )          )
353    (make-local-variable 'sexlst)    (make-local-variable 'sexlst)
354    (setq sexlst    (setq sexlst
355          '((($ areyou) ($ afraidof) sex \?)          '(((doc$ areyou) (doc$ afraidof) sex \?)
356            (($ describe)($ something) about your sexual history \.)            ((doc$ describe)(doc$ something) about your sexual history \.)
357            (($ please)($ describe) your sex life \.\.\.)            ((doc$ please)(doc$ describe) your sex life \.\.\.)
358            (($ describe) your ($ feelings-about) your sexual partner \.)            ((doc$ describe) your (doc$ feelings-about) your sexual partner \.)
359            (($ describe) your most ($ random-adjective) sexual experience \.)            ((doc$ describe) your most (doc$ random-adjective) sexual experience \.)
360            (($ areyou) satisfied with (// lover) \.\.\. \?)))            ((doc$ areyou) satisfied with (doc// lover) \.\.\. \?)))
361    (make-local-variable 'neglst)    (make-local-variable 'neglst)
362    (setq neglst    (setq neglst
363          '((why not \?)          '((why not \?)
364            (($ bother) i ask that \?)            ((doc$ bother) i ask that \?)
365            (why not \?)            (why not \?)
366            (why not \?)            (why not \?)
367            (how come \?)            (how come \?)
368            (($ bother) i ask that \?)))            ((doc$ bother) i ask that \?)))
369    (make-local-variable 'beclst)    (make-local-variable 'beclst)
370    (setq beclst '(    (setq beclst '(
371                   (is it because (// sent) that you came to me \?)                   (is it because (doc// sent) that you came to me \?)
372                   (($ bother)(// sent) \?)                   ((doc$ bother)(doc// sent) \?)
373                   (when did you first know that (// sent) \?)                   (when did you first know that (doc// sent) \?)
374                   (is the fact that (// sent) the real reason \?)                   (is the fact that (doc// sent) the real reason \?)
375                   (does the fact that (// sent) explain anything else \?)                   (does the fact that (doc// sent) explain anything else \?)
376                   (($ areyou)($ sure)(// sent) \? ) ))                   ((doc$ areyou)(doc$ sure)(doc// sent) \? ) ))
377    (make-local-variable 'shortbeclst)    (make-local-variable 'shortbeclst)
378    (setq shortbeclst '(    (setq shortbeclst '(
379                        (($ bother) i ask you that \?)                        ((doc$ bother) i ask you that \?)
380                        (that\'s not much of an answer!)                        (that\'s not much of an answer!)
381                        (($ inter) why won\'t you talk about it \?)                        ((doc$ inter) why won\'t you talk about it \?)
382                        (speak up!)                        (speak up!)
383                        (($ areyou) ($ afraidof) talking about it \?)                        ((doc$ areyou) (doc$ afraidof) talking about it \?)
384                        (don\'t be ($ afraidof) elaborating \.)                        (don\'t be (doc$ afraidof) elaborating \.)
385                        (($ please) go into more detail \.)))                        ((doc$ please) go into more detail \.)))
386    (make-local-variable 'thlst)    (make-local-variable 'thlst)
387    (setq thlst '(    (setq thlst '(
388                  (($ maybe)($ things)($ arerelated) this \.)                  ((doc$ maybe)(doc$ things)(doc$ arerelated) this \.)
389                  (is it because of ($ things) that you are going through all this \?)                  (is it because of (doc$ things) that you are going through all this \?)
390                  (how do you reconcile ($ things) \? )                  (how do you reconcile (doc$ things) \? )
391                  (($ maybe) this ($ isrelated)($ things) \?) ))                  ((doc$ maybe) this (doc$ isrelated)(doc$ things) \?) ))
392    (make-local-variable 'remlst)    (make-local-variable 'remlst)
393    (setq remlst '( (earlier you said ($ history) \?)    (setq remlst '( (earlier you said (doc$ history) \?)
394                    (you mentioned that ($ history) \?)                    (you mentioned that (doc$ history) \?)
395                    (($ whysay)($ history) \? ) ))                    ((doc$ whysay)(doc$ history) \? ) ))
396    (make-local-variable 'toklst)    (make-local-variable 'toklst)
397    (setq toklst    (setq toklst
398          '((is this how you relax \?)          '((is this how you relax \?)
399            (how long have you been smoking       grass \?)            (how long have you been smoking       grass \?)
400            (($ areyou) ($ afraidof) of being drawn to using harder stuff \?)))            ((doc$ areyou) (doc$ afraidof) of being drawn to using harder stuff \?)))
401    (make-local-variable 'states)    (make-local-variable 'states)
402    (setq states    (setq states
403          '((do you get (// found) often \?)          '((do you get (doc// found) often \?)
404            (do you enjoy being (// found) \?)            (do you enjoy being (doc// found) \?)
405            (what makes you (// found) \?)            (what makes you (doc// found) \?)
406            (how often ($ areyou)(// found) \?)            (how often (doc$ areyou)(doc// found) \?)
407            (when were you last (// found) \?)))            (when were you last (doc// found) \?)))
408    (make-local-variable 'replist)    (make-local-variable 'replist)
409    (setq replist    (setq replist
410          '((i . (you))          '((i . (you))
411            (my . (your))            (my . (your))
412            (me . (you))            (me . (you))
# Line 462  reads the sentence before point, and pri Line 458  reads the sentence before point, and pri
458            (hasn\'t . (has not))))            (hasn\'t . (has not))))
459    (make-local-variable 'stallmanlst)    (make-local-variable 'stallmanlst)
460    (setq stallmanlst '(    (setq stallmanlst '(
461                        (($ describe) your ($ feelings-about) him \.)                        ((doc$ describe) your (doc$ feelings-about) him \.)
462                        (($ areyou) a friend of Stallman \?)                        ((doc$ areyou) a friend of Stallman \?)
463                        (($ bother) Stallman is ($ random-adjective) \?)                        ((doc$ bother) Stallman is (doc$ random-adjective) \?)
464                        (($ ibelieve) you are ($ afraidof) him \.)))                        ((doc$ ibelieve) you are (doc$ afraidof) him \.)))
465    (make-local-variable 'schoollst)    (make-local-variable 'schoollst)
466    (setq schoollst '(    (setq schoollst '(
467                      (($ describe) your (// found) \.)                      ((doc$ describe) your (doc// found) \.)
468                      (($ bother) your grades could ($ improve) \?)                      ((doc$ bother) your grades could (doc$ improve) \?)
469                      (($ areyou) ($ afraidof) (// found) \?)                      ((doc$ areyou) (doc$ afraidof) (doc// found) \?)
470                      (($ maybe) this ($ isrelated) to your attitude \.)                      ((doc$ maybe) this (doc$ isrelated) to your attitude \.)
471                      (($ areyou) absent often \?)                      ((doc$ areyou) absent often \?)
472                      (($ maybe) you should study ($ something) \.)))                      ((doc$ maybe) you should study (doc$ something) \.)))
473    (make-local-variable 'improve)    (make-local-variable 'improve)
474    (setq improve '((improve) (be better) (be improved) (be higher)))    (setq improve '((improve) (be better) (be improved) (be higher)))
475    (make-local-variable 'elizalst)    (make-local-variable 'elizalst)
476    (setq elizalst '(    (setq elizalst '(
477                     (($ areyou) ($ sure) \?)                     ((doc$ areyou) (doc$ sure) \?)
478                     (($ ibelieve) you have ($ problems) with (// found) \.)                     ((doc$ ibelieve) you have (doc$ problems) with (doc// found) \.)
479                     (($ whysay) (// sent) \?)))                     ((doc$ whysay) (doc// sent) \?)))
480    (make-local-variable 'sportslst)    (make-local-variable 'sportslst)
481    (setq sportslst '(    (setq sportslst '(
482                      (tell me ($ something) about (// found) \.)                      (tell me (doc$ something) about (doc// found) \.)
483                      (($ describe) ($ relation) (// found) \.)                      ((doc$ describe) (doc$ relation) (doc// found) \.)
484                      (do you find (// found) ($ random-adjective) \?)))                      (do you find (doc// found) (doc$ random-adjective) \?)))
485    (make-local-variable 'mathlst)    (make-local-variable 'mathlst)
486    (setq mathlst '(    (setq mathlst '(
487                    (($ describe) ($ something) about math \.)                    ((doc$ describe) (doc$ something) about math \.)
488                    (($ maybe) your ($ problems) ($ arerelated) (// found) \.)                    ((doc$ maybe) your (doc$ problems) (doc$ arerelated) (doc// found) \.)
489                    (i don\'t know much (// found) \, but ($ continue)                    (i don\'t know much (doc// found) \, but (doc$ continue)
490                       anyway \.)))                       anyway \.)))
491    (make-local-variable 'zippylst)    (make-local-variable 'zippylst)
492    (setq zippylst '(    (setq zippylst '(
493                     (($ areyou) Zippy \?)                     ((doc$ areyou) Zippy \?)
494                     (($ ibelieve) you have some serious ($ problems) \.)                     ((doc$ ibelieve) you have some serious (doc$ problems) \.)
495                     (($ bother) you are a pinhead \?)))                     ((doc$ bother) you are a pinhead \?)))
496    (make-local-variable 'chatlst)    (make-local-variable 'chatlst)
497    (setq chatlst '(    (setq chatlst '(
498                    (($ maybe) we could chat \.)                    ((doc$ maybe) we could chat \.)
499                    (($ please) ($ describe) ($ something) about chat mode \.)                    ((doc$ please) (doc$ describe) (doc$ something) about chat mode \.)
500                    (($ bother) our discussion is so ($ random-adjective) \?)))                    ((doc$ bother) our discussion is so (doc$ random-adjective) \?)))
501    (make-local-variable 'abuselst)    (make-local-variable 'abuselst)
502    (setq abuselst '(    (setq abuselst '(
503                     (($ please) try to be less abusive \.)                     ((doc$ please) try to be less abusive \.)
504                     (($ describe) why you call me (// found) \.)                     ((doc$ describe) why you call me (doc// found) \.)
505                     (i\'ve had enough of you!)))                     (i\'ve had enough of you!)))
506    (make-local-variable 'abusewords)    (make-local-variable 'abusewords)
507    (setq abusewords '(boring bozo clown clumsy cretin dumb dummy    (setq abusewords '(boring bozo clown clumsy cretin dumb dummy
# Line 882  Otherwise call the Doctor to parse prece Line 878  Otherwise call the Doctor to parse prece
878  (defun doctor-doc (sent)  (defun doctor-doc (sent)
879    (cond    (cond
880     ((equal sent '(foo))     ((equal sent '(foo))
881      (doctor-type '(bar! ($ please)($ continue) \.)))      (doctor-type '(bar! (doc$ please)(doc$ continue) \.)))
882     ((member sent howareyoulst)     ((member sent howareyoulst)
883      (doctor-type '(i\'m ok \.  ($ describe) yourself \.)))      (doctor-type '(i\'m ok \.  (doc$ describe) yourself \.)))
884     ((or (member sent '((good bye) (see you later) (i quit) (so long)     ((or (member sent '((good bye) (see you later) (i quit) (so long)
885                         (go away) (get lost)))                         (go away) (get lost)))
886          (memq (car sent)          (memq (car sent)
887                '(bye halt break quit done exit goodbye                '(bye halt break quit done exit goodbye
888                      bye\, stop pause goodbye\, stop pause)))                      bye\, stop pause goodbye\, stop pause)))
889      (doctor-type ($ bye)))      (doctor-type (doc$ bye)))
890     ((and (eq (car sent) 'you)     ((and (eq (car sent) 'you)
891           (memq (doctor-cadr sent) abusewords))           (memq (cadr sent) abusewords))
892      (setq found (doctor-cadr sent))      (setq found (cadr sent))
893      (doctor-type ($ abuselst)))      (doctor-type (doc$ abuselst)))
894     ((eq (car sent) 'whatmeans)     ((eq (car sent) 'whatmeans)
895      (doctor-def (doctor-cadr sent)))      (doctor-def (cadr sent)))
896     ((equal sent '(parse))     ((equal sent '(parse))
897      (doctor-type (list  'subj '= subj ",  "      (doctor-type (list  'subj '= subj ",  "
898                          'verb '= verb "\n"                          'verb '= verb "\n"
# Line 908  Otherwise call the Doctor to parse prece Line 904  Otherwise call the Doctor to parse prece
904                          'is owner "\n"                          'is owner "\n"
905                          'sentence 'used 'was                          'sentence 'used 'was
906                          "..."                          "..."
907                          '(// bak))))                          '(doc// bak))))
908       ((memq (car sent) '(are is do has have how when where who why))
909        (doctor-type (doc$ qlist)))
910     ;;   ((eq (car sent) 'forget)     ;;   ((eq (car sent) 'forget)
911     ;;    (set (doctor-cadr sent) nil)     ;;    (set (cadr sent) nil)
912     ;;    (doctor-type '(($ isee)($ please)     ;;    (doctor-type '((doc$ isee)(doc$ please)
913     ;;     ($ continue)\.)))     ;;     (doc$ continue)\.)))
914     (t     (t
915      (if (doctor-defq sent) (doctor-define sent found))      (if (doctor-defq sent) (doctor-define sent found))
916      (if (> (length sent) 12)(doctor-shorten sent))      (if (> (length sent) 12)(setq sent (doctor-shorten sent)))
917      (setq sent (doctor-correct-spelling (doctor-replace sent replist)))      (setq sent (doctor-correct-spelling (doctor-replace sent replist)))
918      (cond ((and (not (memq 'me sent))(not (memq 'i sent))      (cond ((and (not (memq 'me sent))(not (memq 'i sent))
919                  (memq 'am sent))                  (memq 'am sent))
# Line 929  Otherwise call the Doctor to parse prece Line 927  Otherwise call the Doctor to parse prece
927             (if (memq 'am sent)             (if (memq 'am sent)
928                 (setq sent (doctor-replace sent '((me . (i))))))                 (setq sent (doctor-replace sent '((me . (i))))))
929             (setq sent (doctor-fixup sent))             (setq sent (doctor-fixup sent))
930             (if (and (eq (car sent) 'do) (eq (doctor-cadr sent) 'not))             (if (and (eq (car sent) 'do) (eq (cadr sent) 'not))
931                 (cond ((zerop (random 3))                 (cond ((zerop (random 3))
932                        (doctor-type '(are you ($ afraidof) that \?)))                        (doctor-type '(are you (doc$ afraidof) that \?)))
933                       ((zerop (random 2))                       ((zerop (random 2))
934                        (doctor-type '(don\'t tell me what to do \. i am the                        (doctor-type '(don\'t tell me what to do \. i am the
935                                              psychiatrist here!))                                              psychiatrist here!))
936                        (doctor-rthing))                        (doctor-rthing))
937                       (t                       (t
938                        (doctor-type '(($ whysay) that i shouldn\'t                        (doctor-type '((doc$ whysay) that i shouldn\'t
939                                       (doctor-cddr sent)                                       (cddr sent)
940                                       \?))))                                       \?))))
941               (doctor-go (doctor-wherego sent))))))))               (doctor-go (doctor-wherego sent))))))))
942    
# Line 956  Otherwise call the Doctor to parse prece Line 954  Otherwise call the Doctor to parse prece
954  (defun doctor-shorten (sent)  (defun doctor-shorten (sent)
955    "Make a sentence manageably short using a few hacks."    "Make a sentence manageably short using a few hacks."
956    (let (foo    (let (foo
957          retval          (retval sent)
958          (temp '(because but however besides anyway until          (temp '(because but however besides anyway until
959                      while that except why how)))                      while that except why how)))
960      (while temp      (while temp
961             (setq foo (memq (car temp) sent))             (setq foo (memq (car temp) sent))
962             (if (and foo             (if (and foo
963                      (> (length foo) 3))                      (> (length foo) 3))
964                 (setq sent foo                 (setq retval (doctor-fixup foo)
965                       sent (doctor-fixup sent)                       temp nil)
                      temp nil  
                      retval t)  
966                 (setq temp (cdr temp))))                 (setq temp (cdr temp))))
967      retval))      retval))
968    
# Line 994  Otherwise call the Doctor to parse prece Line 990  Otherwise call the Doctor to parse prece
990    
991  (defun doctor-def (x)  (defun doctor-def (x)
992    (progn    (progn
993     (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me))     (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me))
994     nil))     nil))
995    
996  (defun doctor-forget ()  (defun doctor-forget ()
# Line 1097  the subject noun, and return the portion Line 1093  the subject noun, and return the portion
1093                  luse lusing lust lusts                  luse lusing lust lusts
1094                  made make makes making may mean means meant might                  made make makes making may mean means meant might
1095                  move moved moves moving must                  move moved moves moving must
1096                  need needed needs                  need needed needs
1097                  order ordered orders ought                  order ordered orders ought
1098                  paid pay pays pick picked picking picks                  paid pay pays pick picked picking picks
1099                  placed placing prefer prefers put puts                  placed placing prefer prefers put puts
1100                  ran rape raped rapes                  ran rape raped rapes
1101                  read reading reads recall receive received receives                  read reading reads recall receive received receives
# Line 1138  the subject noun, and return the portion Line 1134  the subject noun, and return the portion
1134  (defun doctor-setprep (sent key)  (defun doctor-setprep (sent key)
1135    (let ((val)    (let ((val)
1136          (foo (memq key sent)))          (foo (memq key sent)))
1137      (cond ((doctor-prepp (doctor-cadr foo))      (cond ((doctor-prepp (cadr foo))
1138             (setq val (doctor-getnoun (doctor-cddr foo)))             (setq val (doctor-getnoun (cddr foo)))
1139             (cond (val val)             (cond (val val)
1140                   (t 'something)))                   (t 'something)))
1141            ((doctor-articlep (doctor-cadr foo))            ((doctor-articlep (cadr foo))
1142             (setq val (doctor-getnoun (doctor-cddr foo)))             (setq val (doctor-getnoun (cddr foo)))
1143             (cond (val (doctor-build (doctor-build (doctor-cadr foo) " ") val))             (cond (val (doctor-build (doctor-build (cadr foo) " ") val))
1144                   (t 'something)))                   (t 'something)))
1145            (t 'something))))            (t 'something))))
1146    
# Line 1170  the subject noun, and return the portion Line 1166  the subject noun, and return the portion
1166                                                     (car x) (car x))))))                                                     (car x) (car x))))))
1167                                       " ")                                       " ")
1168                         (doctor-getnoun (cdr x))))                         (doctor-getnoun (cdr x))))
1169          (t (setq object (car x))) ))          (t (setq object (car x))
1170               (doctor-build (doctor-build (car x) " ") (doctor-getnoun (cdr x))))
1171            ))
1172    
1173  (defun doctor-modifierp (x)  (defun doctor-modifierp (x)
1174    (or (doctor-adjectivep x)    (or (doctor-adjectivep x)
# Line 1202  the subject noun, and return the portion Line 1200  the subject noun, and return the portion
1200                  half quarter                  half quarter
1201                  first second third fourth fifth                  first second third fourth fifth
1202                  sixth seventh eighth ninth tenth)))                  sixth seventh eighth ninth tenth)))
1203                    
1204  (defun doctor-colorp (x)  (defun doctor-colorp (x)
1205    (memq x '(beige black blue brown crimson    (memq x '(beige black blue brown crimson
1206                    gray grey green                    gray grey green
# Line 1275  the subject noun, and return the portion Line 1273  the subject noun, and return the portion
1273    (let ((foo sent))    (let ((foo sent))
1274      (while foo      (while foo
1275        (if (and (eq (car foo) 'me)        (if (and (eq (car foo) 'me)
1276                 (doctor-verbp (doctor-cadr foo)))                 (doctor-verbp (cadr foo)))
1277            (rplaca foo 'i)            (rplaca foo 'i)
1278          (cond ((eq (car foo) 'you)          (cond ((eq (car foo) 'you)
1279                 (cond ((memq (doctor-cadr foo) '(am be been is))                 (cond ((memq (cadr foo) '(am be been is))
1280                        (rplaca (cdr foo) 'are))                        (rplaca (cdr foo) 'are))
1281                       ((memq (doctor-cadr foo) '(has))                       ((memq (cadr foo) '(has))
1282                        (rplaca (cdr foo) 'have))                        (rplaca (cdr foo) 'have))
1283                       ((memq (doctor-cadr foo) '(was))                       ((memq (cadr foo) '(was))
1284                        (rplaca (cdr foo) 'were))))                        (rplaca (cdr foo) 'were))))
1285                ((equal (car foo) 'i)                ((equal (car foo) 'i)
1286                 (cond ((memq (doctor-cadr foo) '(are is be been))                 (cond ((memq (cadr foo) '(are is be been))
1287                        (rplaca (cdr foo) 'am))                        (rplaca (cdr foo) 'am))
1288                       ((memq (doctor-cadr foo) '(were))                       ((memq (cadr foo) '(were))
1289                        (rplaca (cdr foo) 'was))                        (rplaca (cdr foo) 'was))
1290                       ((memq (doctor-cadr foo) '(has))                       ((memq (cadr foo) '(has))
1291                        (rplaca (cdr foo) 'have))))                        (rplaca (cdr foo) 'have))))
1292                ((and (doctor-verbp (car foo))                ((and (doctor-verbp (car foo))
1293                      (eq (doctor-cadr foo) 'i)                      (eq (cadr foo) 'i)
1294                      (not (doctor-verbp (car (doctor-cddr foo)))))                      (not (doctor-verbp (car (cddr foo)))))
1295                 (rplaca (cdr foo) 'me))                 (rplaca (cdr foo) 'me))
1296                ((and (eq (car foo) 'a)                ((and (eq (car foo) 'a)
1297                      (doctor-vowelp (string-to-char                      (doctor-vowelp (string-to-char
1298                                      (doctor-make-string (doctor-cadr foo)))))                                      (doctor-make-string (cadr foo)))))
1299                 (rplaca foo 'an))                 (rplaca foo 'an))
1300                ((and (eq (car foo) 'an)                ((and (eq (car foo) 'an)
1301                      (not (doctor-vowelp (string-to-char                      (not (doctor-vowelp (string-to-char
1302                                           (doctor-make-string (doctor-cadr foo))))))                                           (doctor-make-string (cadr foo))))))
1303                 (rplaca foo 'a)))                 (rplaca foo 'a)))
1304          (setq foo (cdr foo))))          (setq foo (cdr foo))))
1305      sent))      sent))
# Line 1321  element pair in RLIST." Line 1319  element pair in RLIST."
1319            sent)))            sent)))
1320    
1321  (defun doctor-wherego (sent)  (defun doctor-wherego (sent)
1322    (cond ((null sent)($ whereoutp))    (cond ((null sent)(doc$ whereoutp))
1323          ((null (doctor-meaning (car sent)))          ((null (doctor-meaning (car sent)))
1324           (doctor-wherego (cond ((zerop (random 2))           (doctor-wherego (cond ((zerop (random 2))
1325                                  (reverse (cdr sent)))                                  (reverse (cdr sent)))
# Line 1423  Hack on previous word, setting global va Line 1421  Hack on previous word, setting global va
1421    (funcall (intern (concat "doctor-" (doctor-make-string destination)))))    (funcall (intern (concat "doctor-" (doctor-make-string destination)))))
1422    
1423  (defun doctor-desire1 ()  (defun doctor-desire1 ()
1424    (doctor-go ($ whereoutp)))    (doctor-go (doc$ whereoutp)))
1425    
1426  (defun doctor-huh ()  (defun doctor-huh ()
1427    (cond ((< (length sent) 9) (doctor-type ($ huhlst)))    (cond ((< (length sent) 9) (doctor-type (doc$ huhlst)))
1428          (t (doctor-type ($ longhuhlst)))))          (t (doctor-type (doc$ longhuhlst)))))
1429    
1430  (defun doctor-rthing () (doctor-type ($ thlst)))  (defun doctor-rthing () (doctor-type (doc$ thlst)))
1431    
1432  (defun doctor-remem () (cond ((null history)(doctor-huh))  (defun doctor-remem () (cond ((null history)(doctor-huh))
1433                               ((doctor-type ($ remlst)))))                               ((doctor-type (doc$ remlst)))))
1434    
1435  (defun doctor-howdy ()  (defun doctor-howdy ()
1436    (cond ((not howdyflag)    (cond ((not howdyflag)
1437           (doctor-type '(($ hello) what brings you to see me \?))           (doctor-type '((doc$ hello) what brings you to see me \?))
1438           (setq howdyflag t))           (setq howdyflag t))
1439          (t          (t
1440           (doctor-type '(($ ibelieve) we\'ve introduced ourselves already \.))           (doctor-type '((doc$ ibelieve) we\'ve introduced ourselves already \.))
1441           (doctor-type '(($ please) ($ describe) ($ things) \.)))))           (doctor-type '((doc$ please) (doc$ describe) (doc$ things) \.)))))
1442    
1443  (defun doctor-when ()  (defun doctor-when ()
1444    (cond ((< (length (memq found sent)) 3)(doctor-short))    (cond ((< (length (memq found sent)) 3)(doctor-short))
1445          (t          (t
1446           (setq sent (cdr (memq found sent)))           (setq sent (cdr (memq found sent)))
1447           (setq sent (doctor-fixup sent))           (setq sent (doctor-fixup sent))
1448           (doctor-type '(($ whatwhen)(// sent) \?)))))           (doctor-type '((doc$ whatwhen)(doc// sent) \?)))))
1449    
1450  (defun doctor-conj ()  (defun doctor-conj ()
1451    (cond ((< (length (memq found sent)) 4)(doctor-short))    (cond ((< (length (memq found sent)) 4)(doctor-short))
# Line 1455  Hack on previous word, setting global va Line 1453  Hack on previous word, setting global va
1453           (setq sent (cdr (memq found sent)))           (setq sent (cdr (memq found sent)))
1454           (setq sent (doctor-fixup sent))           (setq sent (doctor-fixup sent))
1455           (cond ((eq (car sent) 'of)           (cond ((eq (car sent) 'of)
1456                  (doctor-type '(are you ($ sure) that is the real reason \?))                  (doctor-type '(are you (doc$ sure) that is the real reason \?))
1457                  (setq things (cons (cdr sent) things)))                  (setq things (cons (cdr sent) things)))
1458                 (t                 (t
1459                  (doctor-remember sent)                  (doctor-remember sent)
1460                  (doctor-type ($ beclst)))))))                  (doctor-type (doc$ beclst)))))))
1461    
1462  (defun doctor-short ()  (defun doctor-short ()
1463    (cond ((= (car repetitive-shortness) (1- lincount))    (cond ((= (car repetitive-shortness) (1- lincount))
# Line 1470  Hack on previous word, setting global va Line 1468  Hack on previous word, setting global va
1468    (rplaca repetitive-shortness lincount)    (rplaca repetitive-shortness lincount)
1469    (cond ((> (cdr repetitive-shortness) 6)    (cond ((> (cdr repetitive-shortness) 6)
1470           (cond ((not **mad**)           (cond ((not **mad**)
1471                  (doctor-type '(($ areyou)                  (doctor-type '((doc$ areyou)
1472                                 just trying to see what kind of things                                 just trying to see what kind of things
1473                                 i have in my vocabulary \? please try to                                 i have in my vocabulary \? please try to
1474                                 carry on a reasonable conversation!))                                 carry on a reasonable conversation!))
# Line 1481  Hack on previous word, setting global va Line 1479  Hack on previous word, setting global va
1479                  )))                  )))
1480          (t          (t
1481           (cond ((equal sent (doctor-assm '(yes)))           (cond ((equal sent (doctor-assm '(yes)))
1482                  (doctor-type '(($ isee) ($ inter) ($ whysay) this is so \?)))                  (doctor-type '((doc$ isee) (doc$ inter) (doc$ whysay) this is so \?)))
1483                 ((equal sent (doctor-assm '(because)))                 ((equal sent (doctor-assm '(because)))
1484                  (doctor-type ($ shortbeclst)))                  (doctor-type (doc$ shortbeclst)))
1485                 ((equal sent (doctor-assm '(no)))                 ((equal sent (doctor-assm '(no)))
1486                  (doctor-type ($ neglst)))                  (doctor-type (doc$ neglst)))
1487                 (t (doctor-type ($ shortlst)))))))                 (t (doctor-type (doc$ shortlst)))))))
1488              
1489  (defun doctor-alcohol () (doctor-type ($ drnk)))  (defun doctor-alcohol () (doctor-type (doc$ drnk)))
1490    
1491  (defun doctor-desire ()  (defun doctor-desire ()
1492    (let ((foo (memq found sent)))    (let ((foo (memq found sent)))
1493      (cond ((< (length foo) 2)      (cond ((< (length foo) 2)
1494             (doctor-go (doctor-build (doctor-meaning found) 1)))             (doctor-go (doctor-build (doctor-meaning found) 1)))
1495            ((memq (doctor-cadr foo) '(a an))            ((memq (cadr foo) '(a an))
1496             (rplacd foo (append '(to have) (cdr foo)))             (rplacd foo (append '(to have) (cdr foo)))
1497             (doctor-svo sent found 1 nil)             (doctor-svo sent found 1 nil)
1498             (doctor-remember (list subj 'would 'like obj))             (doctor-remember (list subj 'would 'like obj))
1499             (doctor-type ($ whywant)))             (doctor-type (doc$ whywant)))
1500            ((not (eq (doctor-cadr foo) 'to))            ((not (eq (cadr foo) 'to))
1501             (doctor-go (doctor-build (doctor-meaning found) 1)))             (doctor-go (doctor-build (doctor-meaning found) 1)))
1502            (t            (t
1503             (doctor-svo sent found 1 nil)             (doctor-svo sent found 1 nil)
1504             (doctor-remember (list subj 'would 'like obj))             (doctor-remember (list subj 'would 'like obj))
1505             (doctor-type ($ whywant))))))             (doctor-type (doc$ whywant))))))
1506    
1507  (defun doctor-drug ()  (defun doctor-drug ()
1508    (doctor-type ($ drugs))    (doctor-type (doc$ drugs))
1509    (doctor-remember (list 'you 'used found)))    (doctor-remember (list 'you 'used found)))
1510    
1511  (defun doctor-toke ()  (defun doctor-toke ()
1512    (doctor-type ($ toklst)))    (doctor-type (doc$ toklst)))
1513    
1514  (defun doctor-state ()  (defun doctor-state ()
1515    (doctor-type ($ states))(doctor-remember (list 'you 'were found)))    (doctor-type (doc$ states))(doctor-remember (list 'you 'were found)))
1516    
1517  (defun doctor-mood ()  (defun doctor-mood ()
1518    (doctor-type ($ moods))(doctor-remember (list 'you 'felt found)))    (doctor-type (doc$ moods))(doctor-remember (list 'you 'felt found)))
1519    
1520  (defun doctor-fear ()  (defun doctor-fear ()
1521    (setq feared (doctor-setprep sent found))    (setq feared (doctor-setprep sent found))
1522    (doctor-type ($ fears))    (doctor-type (doc$ fears))
1523    (doctor-remember (list 'you 'were 'afraid 'of feared)))    (doctor-remember (list 'you 'were 'afraid 'of feared)))
1524    
1525  (defun doctor-hate ()  (defun doctor-hate ()
1526    (doctor-svo sent found 1 t)    (doctor-svo sent found 1 t)
1527    (cond ((memq 'not sent) (doctor-forget) (doctor-huh))    (cond ((memq 'not sent) (doctor-forget) (doctor-huh))
1528          ((equal subj 'you)          ((equal subj 'you)
1529           (doctor-type '(why do you (// verb)(// obj) \?)))           (doctor-type '(why do you (doc// verb)(doc// obj) \?)))
1530          (t (doctor-type '(($ whysay)(list subj verb obj))))))          (t (doctor-type '((doc$ whysay)(list subj verb obj))))))
1531    
1532  (defun doctor-symptoms ()  (defun doctor-symptoms ()
1533    (doctor-type '(($ maybe) you should consult a doctor of medicine\,    (doctor-type '((doc$ maybe) you should consult a doctor of medicine\,
1534                   i am a psychiatrist \.)))                   i am a psychiatrist \.)))
1535    
1536  (defun doctor-hates ()  (defun doctor-hates ()
# Line 1540  Hack on previous word, setting global va Line 1538  Hack on previous word, setting global va
1538    (doctor-hates1))    (doctor-hates1))
1539    
1540  (defun doctor-hates1 ()  (defun doctor-hates1 ()
1541    (doctor-type '(($ whysay)(list subj verb obj))))    (doctor-type '((doc$ whysay)(list subj verb obj) \?)))
1542    
1543  (defun doctor-loves ()  (defun doctor-loves ()
1544    (doctor-svo sent found 1 t)    (doctor-svo sent found 1 t)
1545    (doctor-qloves))    (doctor-qloves))
1546    
1547  (defun doctor-qloves ()  (defun doctor-qloves ()
1548    (doctor-type '(($ bother)(list subj verb obj) \?)))    (doctor-type '((doc$ bother)(list subj verb obj) \?)))
1549    
1550  (defun doctor-love ()  (defun doctor-love ()
1551    (doctor-svo sent found 1 t)    (doctor-svo sent found 1 t)
# Line 1562  Hack on previous word, setting global va Line 1560  Hack on previous word, setting global va
1560                         (setq lover '(your partner))                         (setq lover '(your partner))
1561                         (doctor-forget)                         (doctor-forget)
1562                         (doctor-type '(with whom are you in love \?)))                         (doctor-type '(with whom are you in love \?)))
1563                        ((doctor-type '(($ please)                        ((doctor-type '((doc$ please)
1564                                        ($ describe)                                        (doc$ describe)
1565                                        ($ relation)                                        (doc$ relation)
1566                                        (// lover)                                        (doc// lover)
1567                                        \.)))))                                        \.)))))
1568                 ((equal subj 'i)                 ((equal subj 'i)
1569                  (doctor-txtype '(we were discussing you!)))                  (doctor-txtype '(we were discussing you!)))
# Line 1576  Hack on previous word, setting global va Line 1574  Hack on previous word, setting global va
1574    
1575  (defun doctor-mach ()  (defun doctor-mach ()
1576    (setq found (doctor-plural found))    (setq found (doctor-plural found))
1577    (doctor-type ($ machlst)))    (doctor-type (doc$ machlst)))
1578    
1579  (defun doctor-sexnoun () (doctor-sexverb))  (defun doctor-sexnoun () (doctor-sexverb))
1580    
1581  (defun doctor-sexverb ()  (defun doctor-sexverb ()
1582    (if (or (memq 'me sent)(memq 'myself sent)(memq 'i sent))    (if (or (memq 'me sent)(memq 'myself sent)(memq 'i sent))
1583        (doctor-foul)        (doctor-foul)
1584      (doctor-type ($ sexlst))))      (doctor-type (doc$ sexlst))))
1585    
1586  (defun doctor-death ()  (defun doctor-death ()
1587    (cond (suicide-flag (doctor-type ($ deathlst)))    (cond (suicide-flag (doctor-type (doc$ deathlst)))
1588          ((or (equal found 'suicide)          ((or (equal found 'suicide)
1589               (and (or (equal found 'kill)               (and (or (equal found 'kill)
1590                        (equal found 'killing))                        (equal found 'killing))
# Line 1598  Hack on previous word, setting global va Line 1596  Hack on previous word, setting global va
1596                             anonymous E-mail: samaritans@anon.twwells.com\ \.                             anonymous E-mail: samaritans@anon.twwells.com\ \.
1597                             or find a Befrienders crisis center at                             or find a Befrienders crisis center at
1598                             http://www.befrienders.org/\ \.                             http://www.befrienders.org/\ \.
1599                             ($ please) ($ continue) \.)))                             (doc$ please) (doc$ continue) \.)))
1600          (t (doctor-type ($ deathlst)))))          (t (doctor-type (doc$ deathlst)))))
1601    
1602  (defun doctor-foul ()  (defun doctor-foul ()
1603    (doctor-type ($ foullst)))    (doctor-type (doc$ foullst)))
1604    
1605  (defun doctor-family ()  (defun doctor-family ()
1606    (doctor-possess sent found)    (doctor-possess sent found)
1607    (doctor-type ($ famlst)))    (doctor-type (doc$ famlst)))
1608    
1609  ;; I did not add this -- rms.  ;; I did not add this -- rms.
1610  ;; But he might have removed it.  I put it back.  --roland  ;; But he might have removed it.  I put it back.  --roland
1611  (defun doctor-rms ()  (defun doctor-rms ()
1612    (cond (rms-flag (doctor-type ($ stallmanlst)))    (cond (rms-flag (doctor-type (doc$ stallmanlst)))
1613          (t (setq rms-flag t) (doctor-type '(do you know Stallman \?)))))          (t (setq rms-flag t) (doctor-type '(do you know Stallman \?)))))
1614    
1615  (defun doctor-school nil (doctor-type ($ schoollst)))  (defun doctor-school nil (doctor-type (doc$ schoollst)))
1616    
1617  (defun doctor-eliza ()  (defun doctor-eliza ()
1618    (cond (eliza-flag (doctor-type ($ elizalst)))    (cond (eliza-flag (doctor-type (doc$ elizalst)))
1619          (t (setq eliza-flag t)          (t (setq eliza-flag t)
1620             (doctor-type '((// found) \? hah !             (doctor-type '((doc// found) \? hah !
1621                            ($ please) ($ continue) \.)))))                            (doc$ please) (doc$ continue) \.)))))
             
 (defun doctor-sports ()  (doctor-type ($ sportslst)))  
1622    
1623  (defun doctor-math () (doctor-type ($ mathlst)))  (defun doctor-sports ()  (doctor-type (doc$ sportslst)))
1624    
1625    (defun doctor-math () (doctor-type (doc$ mathlst)))
1626    
1627  (defun doctor-zippy ()  (defun doctor-zippy ()
1628    (cond (zippy-flag (doctor-type ($ zippylst)))    (cond (zippy-flag (doctor-type (doc$ zippylst)))
1629          (t (setq zippy-flag t)          (t (setq zippy-flag t)
1630             (doctor-type '(yow! are we interactive yet \?)))))             (doctor-type '(yow! are we interactive yet \?)))))
1631    
1632    
1633  (defun doctor-chat () (doctor-type ($ chatlst)))  (defun doctor-chat () (doctor-type (doc$ chatlst)))
   
 (defun doctor-strangelove ()  
   (interactive)  
   (insert "Mein fuehrer!!\n")  
   (doctor-read-print))  
1634    
1635  (provide 'doctor)  (provide 'doctor)
1636    

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.27.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26