Return to doctor.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

Annotation of 43BSD/contrib/emacs/lisp/doctor.el, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.