doctor.el

早期freebsd实现

;; Psychological help for frustrated users.
;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.


(defun doctor-cadr (x) (car (cdr x)))
(defun doctor-caddr (x) (car (cdr (cdr x))))
(defun doctor-cddr (x) (cdr (cdr x)))

(defun doctor-member (x y)
  "Like memq, but uses  equal  for comparison"
  (while (and y (not (equal x (car y))))
    (setq y (cdr y)))
  y)

(defun random-range (top)
  "Return a random nonnegative integer less than TOP."
  (let ((tem (% (random) top)))
    (if (< tem 0) (- tem) tem)))

(defun // (x) x)

(defmacro $ (what)
  "quoted arg form of doctor-$"
  (list 'doctor-$ (list 'quote what)))

(defun doctor-$ (what)
  "Return the car of a list, rotating the list each time"
  (let* ((vv (symbol-value what))
	(first (car vv))
	(ww (append (cdr vv) (list first))))
    (set what ww)
    first))

(defvar doctor-mode-map nil)
(if doctor-mode-map
    nil
  (setq doctor-mode-map (make-sparse-keymap))
  (define-key doctor-mode-map "\n" 'doctor-read-print)
  (define-key doctor-mode-map "\r" 'doctor-ret-or-read))

(defun doctor-mode ()
  "Major mode for running the Doctor (Eliza) program.
Like Text mode with Auto Fill mode
except that RET when point is after a newline, or LFD at any time,
reads the sentence before point, and prints the Doctor's answer."
  (interactive)
  (text-mode)
  (make-doctor-variables)
  (use-local-map doctor-mode-map)
  (setq major-mode 'doctor-mode)
  (setq mode-name "Doctor")
  (turn-on-auto-fill)
  (doctor-type '(i am the psychotherapist \.
		 ($ please) ($ describe) your ($ problems) \.
		 each time you are finished talking, type \R\E\T twice \.))
  (insert "\n"))

(defun make-doctor-variables ()
  (make-local-variable 'monosyllables)
  (setq monosyllables
	"
     Your attitude at the end of the session was wholly unacceptable.
     Please try to come back next time with a willingness to speak more
     freely. If you continue to refuse to talk openly, there is little
     I can do to help!
")
  (make-local-variable 'typos)
  (setq typos
	(mapcar (function (lambda (x)
			    (put (car x) 'doctor-correction  (doctor-cadr x))
			    (put (doctor-cadr x) 'doctor-expansion (doctor-caddr x))
			    (car x)))
		'((theyll they\'ll (they will))
		  (theyre they\'re (they are))
		  (hes he\'s (he is))
		  (he7s he\'s (he is))
		  (im i\'m (you are))
		  (i7m i\'m (you are))
		  (isa is\ a (is a))
		  (thier their (their))
		  (dont don\'t (do not))
		  (don7t don\'t (do not))
		  (you7re you\'re (i am))
		  (you7ve you\'ve (i have))
		  (you7ll you\'ll (i will)))))
  (make-local-variable 'found)
  (setq found nil)
  (make-local-variable 'owner)
  (setq owner nil)
  (make-local-variable 'history)
  (setq history nil)
  (make-local-variable '*debug*)
  (setq *debug* nil)
  (make-local-variable 'inter)
  (setq inter
	'((well\,)
	  (hmmm \.\.\.\ so\,)
	  (so)
	  (\.\.\.and)
	  (then)))
  (make-local-variable 'continue)
  (setq continue
	'((continue)
	  (proceed)
	  (go on)
	  (keep going) ))
  (make-local-variable 'relation)
  (setq relation
	'((your relationship with)
	  (something you remember about)
	  (your feelings toward)
	  (some experiences you have had with)
	  (how you feel about)))
  (make-local-variable 'fears)
  (setq fears '( (($ whysay) you are ($ afraidof) (// feared) \?)
		 (you seem terrified by (// feared) \.)
		 (when did you first feel ($ afraidof) (// feared) \?) ))
  (make-local-variable 'sure)
  (setq sure '((sure)(positive)(certain)(absolutely sure)))
  (make-local-variable 'afraidof)
  (setq afraidof '( (afraid of) (frightened by) (scared of) ))
  (make-local-variable 'areyou)
  (setq areyou '( (are you)(have you been)(have you been) ))
  (make-local-variable 'isrelated)
  (setq isrelated '( (has something to do with)(is related to)
		     (could be the reason for) (is caused by)(is because of)))
  (make-local-variable 'arerelated)
  (setq arerelated '((have something to do with)(are related to)
		     (could have caused)(could be the reason for) (are caused by)
		     (are because of)))
  (make-local-variable 'moods)
  (setq moods '( (($ areyou)(// found) often \?)
		 (what causes you to be (// found) \?)
		 (($ whysay) you are (// found) \?) ))
  (make-local-variable 'maybe)
  (setq maybe
	'((maybe)
	  (perhaps)
	  (possibly)))
  (make-local-variable 'whatwhen)
  (setq whatwhen
	'((what happened when)
	  (what would happen if)))
  (make-local-variable 'hello)
  (setq hello
	'((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.)))
  (make-local-variable 'drnk)
  (setq drnk
	'((do you drink a lot of (// found) \?)
	  (do you get drunk often \?)
	  (($ describe) your drinking habits \.) )) 
  (make-local-variable 'drugs)
  (setq drugs '( (do you use (// found) often \?)(($ areyou)
						 addicted to (// found) \?)(do you realize that drugs can
						 be very harmful \?)(($ maybe) you should try to quit using (// found)
						 \.)))
  (make-local-variable 'whywant)
  (setq whywant '( (($ whysay) (// subj) might ($ want) (// obj) \?)
		   (how does it feel to want \?)
		   (why should (// subj) get (// obj) \?)
		   (when did (// subj) first ($ want) (// obj) \?)
		   (($ areyou) obsessed with (// obj) \?)
		   (why should i give (// obj) to (// subj) \?)
		   (have you ever gotten (// obj) \?) ))
  (make-local-variable 'canyou)
  (setq canyou '((of course i can \.)
		 (why should i \?)
		 (what makes you think i would even want to \?)
		 (i am the doctor\, i can do anything i damn please \.)
		 (not really\, it\'s not up to me \.)
		 (depends\, how important is it \?)
		 (i could\, but i don\'t think it would be a wise thing to do \.)
		 (can you \?)
		 (maybe i can\, maybe i can\'t \.\.\.)
		 (i don\'t think i should do that \.)))
  (make-local-variable 'want)
  (setq want '( (want) (desire) (wish) (want) (hope) ))
  (make-local-variable 'shortlst)
  (setq shortlst
	'((can you elaborate on that \?)
	  (($ please) continue \.)
	  (go on\, don\'t be afraid \.)
	  (i need a little more detail please \.)
	  (you\'re being a bit brief\, ($ please) go into detail \.)
	  (can you be more explicit \?)
	  (and \?)
	  (($ please) go into more detail \?)
	  (you aren\'t being very talkative today\!)
	  (is that all there is to it \?)
	  (why must you respond so briefly \?)))

  (make-local-variable 'famlst)
  (setq famlst
	'((tell me ($ something) about (// owner) family \.)
	  (you seem to dwell on (// owner) family \.)
	  (($ areyou) hung up on (// owner) family \?)))
  (make-local-variable 'huhlst)
  (setq huhlst
	'((($ whysay)(// sent) \?)
	  (is it because of ($ things) that you say (// sent) \?) ))
  (make-local-variable 'longhuhlst)
  (setq longhuhlst
	'((($ whysay) that \?)
	  (i don\'t understand \.)
	  (($ thlst))
	  (($ areyou) ($ afraidof) that \?)))
  (make-local-variable 'feelings)
  (setq feelings-about
	'((feelings about)
	  (aprehensions toward)
	  (thoughts on)
	  (emotions toward)))
  (make-local-variable 'random)
  (setq random-adjective
	'((vivid)
	  (emotionally stimulating)
	  (exciting)
	  (boring)
	  (interesting)
	  (recent)
	  (random)   ;How can we omit this?
	  (unusual)
	  (shocking)
	  (embarrassing)))
  (make-local-variable 'whysay)
  (setq whysay
	'((why do you say)
	  (what makes you believe)
	  (are you sure that)
	  (do you really think)
	  (what makes you think) ))
  (make-local-variable 'isee)
  (setq isee
	'((i see \.\.\.)
	  (yes\,)
	  (i understand \.)
	  (oh \.) ))
  (make-local-variable 'please)
  (setq please 
	'((please\,)
	  (i would appreciate it if you would)
	  (perhaps you could)
	  (please\,)
	  (would you please)
	  (why don\'t you)
	  (could you)))
  (make-local-variable 'bye)
  (setq bye
	'((my secretary will send you a bill \.)
	  (bye bye \.)
	  (see ya \.)
	  (ok\, talk to you some other time \.)
	  (talk to you later \.)
	  (ok\, have fun \.)
	  (ciao \.)))
  (make-local-variable 'something)
  (setq something
	'((something)
	  (more)
	  (how you feel)))
  (make-local-variable 'things)
  (setq things 
	'(;(your interests in computers)   ;; let's make this less computer oriented
	  ;(the machines you use)
	  (your plans)
	  ;(your use of computers)
	  (your life)
	  ;(other machines you use)
	  (the people you hang around with)
	  ;(computers you like)
	  (problems at school)
	  (any hobbies you have)
	  ;(other computers you use)
	  (your sex life)
	  (hangups you have)
	  (your inhibitions)
	  (some problems in your childhood)
	  ;(knowledge of computers)
	  (some problems at home)))
  (make-local-variable 'describe)
  (setq describe
	'((describe)
	  (tell me about)
	  (talk about)
	  (discuss)
	  (tell me more about)
	  (elaborate on)))
  (make-local-variable 'ibelieve)
  (setq ibelieve 
	'((i believe) (i think) (i have a feeling) (it seems to me that)
	  (it looks like)))
  (make-local-variable 'problems)
  (setq problems '( (problems)
		    (inhibitions)
		    (hangups)
		    (difficulties)
		    (anxieties)
		    (frustrations) ))
  (make-local-variable 'bother)
  (setq bother
	'((does it bother you that)
	  (are you annoyed that)
	  (did you ever regret)
	  (are you sorry)
	  (are you satisfied with the fact that)))
  (make-local-variable 'machlst)
  (setq machlst 
	'((you have your mind on (// found) \, it seems \.)
	  (you think too much about  (// found) \.)
	  (you should try taking your mind off of (// found)\.)
	  (are you a computer hacker \?)))
  (make-local-variable 'qlist)
  (setq qlist
	'((what do you think \?)
	  (i\'ll ask the questions\, if you don\'t mind!)
	  (i could ask the same thing myself \.)
	  (($ please) allow me to do the questioning \.)
	  (i have asked myself that question many times \.)
	  (($ please) try to answer that question yourself \.)))
  (make-local-variable 'elist)
  (setq elist
	'((($ please) try to calm yourself \.)
	  (you seem very excited \. relax \. ($ please) ($ describe) ($ things)
	       \.)
	  (you\'re being very emotional \. calm down \.)))
  (make-local-variable 'foullst)
  (setq foullst
	'((($ please) watch your tongue!)
	  (($ please) avoid such unwholesome thoughts \.)
	  (($ please) get your mind out of the gutter \.)
	  (such lewdness is not appreciated \.)))
  (make-local-variable 'deathlst)
  (setq deathlst
	'((this is not a healthy way of thinking \.)
	  (($ bother) you\, too\, may die someday \?)
	  (i am worried by your obssession with this topic!)
	  (did you watch a lot of crime and violence on television as a child \?))
	)
  (make-local-variable 'sexlst)
  (setq sexlst 
	'((($ areyou) ($ afraidof) sex \?)
	  (($ describe)($ something) about your sexual history \.)
	  (($ please)($ describe) your sex life \.\.\.)
	  (($ describe) your ($ feelings-about) your sexual partner \.)
	  (($ describe) your most ($ random-adjective) sexual experience \.)
	  (($ areyou) satisfied with (// lover) \.\.\. \?)))
  (make-local-variable 'neglst)
  (setq neglst
	'((why not \?)
	  (($ bother) i ask that \?)
	  (why not \?)
	  (why not \?)
	  (how come \?)
	  (($ bother) i ask that \?)))
  (make-local-variable 'beclst)
  (setq beclst '(
		 (is it because (// sent) that you came to me \?)
		 (($ bother)(// sent) \?)
		 (when did you first know that (// sent) \?)
		 (is the fact that (// sent) the real reason \?)
		 (does the fact that (// sent) explain anything else \?)
		 (($ areyou)($ sure)(// sent) \? ) ))
  (make-local-variable 'shortbeclst)
  (setq shortbeclst '(
		      (($ bother) i ask you that \?)
		      (that\'s not much of an answer!)
		      (($ inter) why won\'t you talk about it \?)
		      (speak up!)
		      (($ areyou) ($ afraidof) talking about it \?)
		      (don\'t be ($ afraidof) elaborating \.)
		      (($ please) go into more detail \.)))
  (make-local-variable 'thlst)
  (setq thlst '(
		(($ maybe)($ things)($ arerelated) this \.)
		(is it because of ($ things) that you are going through all this \?)
		(how do you reconcile ($ things) \? )
		(($ maybe) this ($ isrelated)($ things) \?) ))
  (make-local-variable 'remlst)
  (setq remlst '( (earlier you said ($ history) \?)
		  (you mentioned that ($ history) \?)
		  (($ whysay)($ history) \? ) ))
  (make-local-variable 'toklst)
  (setq toklst
	'((is this how you relax \?)
	  (how long have you been smoking	grass \?)
	  (($ areyou) ($ afraidof) of being drawn to using harder stuff \?)))
  (make-local-variable 'states)
  (setq states