;;; doctor.el --- psychological help for frustrated users
-;; Copyright (C) 1985, 1987, 1994, 1996, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2015 Free Software
+;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
;; This file is part of GNU Emacs.
(defun doc// (x) x)
(defmacro doc$ (what)
- "quoted arg form of doctor-$"
+ "Quoted arg form of doctor-$."
`(doctor-$ ',what))
(defun doctor-$ (what)
- "Return the car of a list, rotating the list each time"
+ "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))))
(turn-on-auto-fill)
(doctor-type '(i am the psychotherapist \.
(doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \.
- each time you are finished talking, type \R\E\T twice \.))
+ each time you are finished talking\, type \R\E\T twice \.))
(insert "\n"))
(defun make-doctor-variables ()
(you7re you\'re (i am))
(you7ve you\'ve (i have))
(you7ll you\'ll (i will)))))
+ (set (make-local-variable 'doctor-sent) nil)
(set (make-local-variable 'doctor-found) nil)
(set (make-local-variable 'doctor-owner) nil)
(set (make-local-variable 'doctor--history) nil)
(you seem to dwell on (doc// doctor-owner) family \.)
((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?)))
(set (make-local-variable 'doctor--huhlst)
- '(((doc$ doctor--whysay)(doc// doctor-sent) \?)
+ '(((doc$ doctor--whysay) (doc// doctor-sent) \?)
(is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?)))
(set (make-local-variable 'doctor--longhuhlst)
'(((doc$ doctor--whysay) that \?)
(did you watch a lot of crime and violence on television as a child \?)))
(set (make-local-variable 'doctor--sexlst)
'(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?)
- ((doc$ doctor--describe)(doc$ doctor--something) about your sexual history \.)
- ((doc$ doctor--please)(doc$ doctor--describe) your sex life \.\.\.)
+ ((doc$ doctor--describe) (doc$ doctor--something) about your sexual history \.)
+ ((doc$ doctor--please) (doc$ doctor--describe) your sex life \.\.\.)
((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.)
((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.)
((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?)))
((doc$ doctor--bother) i ask that \?)))
(set (make-local-variable 'doctor--beclst)
'((is it because (doc// doctor-sent) that you came to me \?)
- ((doc$ doctor--bother)(doc// doctor-sent) \?)
+ ((doc$ doctor--bother) (doc// doctor-sent) \?)
(when did you first know that (doc// doctor-sent) \?)
(is the fact that (doc// doctor-sent) the real reason \?)
(does the fact that (doc// doctor-sent) explain anything else \?)
- ((doc$ doctor--areyou)(doc$ doctor--sure)(doc// doctor-sent) \? )))
+ ((doc$ doctor--areyou) (doc$ doctor--sure) (doc// doctor-sent) \? )))
(set (make-local-variable 'doctor--shortbeclst)
'(((doc$ doctor--bother) i ask you that \?)
(that\'s not much of an answer!)
(don\'t be (doc$ doctor--afraidof) elaborating \.)
((doc$ doctor--please) go into more detail \.)))
(set (make-local-variable 'doctor--thlst)
- '(((doc$ doctor--maybe)(doc$ doctor--thing)(doc$ doctor--isrelated) this \.)
- ((doc$ doctor--maybe)(doc$ doctor--things)(doc$ doctor--arerelated) this \.)
+ '(((doc$ doctor--maybe) (doc$ doctor--thing) (doc$ doctor--isrelated) this \.)
+ ((doc$ doctor--maybe) (doc$ doctor--things) (doc$ doctor--arerelated) this \.)
(is it because of (doc$ doctor--things) that you are going through all this \?)
(how do you reconcile (doc$ doctor--things) \? )
- ((doc$ doctor--maybe) this (doc$ doctor--isrelated)(doc$ doctor--things) \?)))
+ ((doc$ doctor--maybe) this (doc$ doctor--isrelated) (doc$ doctor--things) \?)))
(set (make-local-variable 'doctor--remlst)
'((earlier you said (doc$ doctor--history) \?)
(you mentioned that (doc$ doctor--history) \?)
- ((doc$ doctor--whysay)(doc$ doctor--history) \? )))
+ ((doc$ doctor--whysay) (doc$ doctor--history) \? )))
(set (make-local-variable 'doctor--toklst)
'((is this how you relax \?)
(how long have you been smoking grass \?)
'((do you get (doc// doctor-found) often \?)
(do you enjoy being (doc// doctor-found) \?)
(what makes you (doc// doctor-found) \?)
- (how often (doc$ doctor--areyou)(doc// doctor-found) \?)
+ (how often (doc$ doctor--areyou) (doc// doctor-found) \?)
(when were you last (doc// doctor-found) \?)))
(set (make-local-variable 'doctor--replist) '((i . (you))
(my . (your))
(doctor-read-print)
(newline arg)))
-(defun doctor-read-print nil
- "top level loop"
+(defun doctor-read-print ()
+ "Top level loop."
(interactive)
- (let ((sent (doctor-readin)))
- (insert "\n")
- (setq doctor--lincount (1+ doctor--lincount))
- (doctor-doc sent)
- (insert "\n")
- (setq doctor--bak sent)))
-
-(defun doctor-readin nil
+ (setq doctor-sent (doctor-readin))
+ (insert "\n")
+ (setq doctor--lincount (1+ doctor--lincount))
+ (doctor-doc)
+ (insert "\n")
+ (setq doctor--bak doctor-sent))
+
+(defun doctor-readin ()
"Read a sentence. Return it as a list of words."
(let (sentence)
(backward-sentence 1)
sentence))
(defun doctor-read-token ()
- "read one word from buffer"
+ "Read one word from buffer."
(prog1 (intern (downcase (buffer-substring (point)
(progn
(forward-word 1)
\f
;; Main processing function for sentences that have been read.
-(defun doctor-doc (doctor-sent)
+(defun doctor-doc ()
(cond
((equal doctor-sent '(foo))
- (doctor-type '(bar! (doc$ doctor--please)(doc$ doctor--continue) \.)))
+ (doctor-type '(bar! (doc$ doctor--please) (doc$ doctor--continue) \.)))
((member doctor-sent doctor--howareyoulst)
(doctor-type '(i\'m ok \. (doc$ doctor--describe) yourself \.)))
((or (member doctor-sent '((good bye) (see you later) (i quit) (so long)
- (go away) (get lost)))
+ (go away) (get lost)))
(memq (car doctor-sent)
'(bye halt break quit done exit goodbye
bye\, stop pause goodbye\, stop pause)))
'(doc// doctor--bak))))
((memq (car doctor-sent) '(are is do has have how when where who why))
(doctor-type (doc$ doctor--qlist)))
- ;; ((eq (car doctor-sent) 'forget)
- ;; (set (cadr doctor-sent) nil)
- ;; (doctor-type '((doc$ doctor--isee)(doc$ doctor--please)
+ ;; ((eq (car sent) 'forget)
+ ;; (set (cadr sent) nil)
+ ;; (doctor-type '((doc$ doctor--isee) (doc$ doctor--please)
;; (doc$ doctor--continue)\.)))
(t
(if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found))
- (if (> (length doctor-sent) 12)(setq doctor-sent (doctor-shorten doctor-sent)))
- (setq doctor-sent (doctor-correct-spelling (doctor-replace doctor-sent doctor--replist)))
- (cond ((and (not (memq 'me doctor-sent))(not (memq 'i doctor-sent))
+ (if (> (length doctor-sent) 12)
+ (setq doctor-sent (doctor-shorten doctor-sent)))
+ (setq doctor-sent (doctor-correct-spelling
+ (doctor-replace doctor-sent doctor--replist)))
+ (cond ((and (not (memq 'me doctor-sent)) (not (memq 'i doctor-sent))
(memq 'am doctor-sent))
(setq doctor-sent (doctor-replace doctor-sent '((am . (are)))))))
(cond ((equal (car doctor-sent) 'yow) (doctor-zippy))
nil))))
(defun doctor-nounp (x)
- "Returns t if the symbol argument is a noun."
+ "Return t if the symbol argument is a noun."
(or (doctor-pronounp x)
(not (or (doctor-verbp x)
(equal x 'not)
(doctor-modifierp x) )) ))
(defun doctor-pronounp (x)
- "Returns t if the symbol argument is a pronoun."
+ "Return t if the symbol argument is a pronoun."
(memq x '(
i me mine myself
we us ours ourselves ourself
(t 'something))))
(defun doctor-getnoun (x)
- (cond ((null x)(setq doctor-object 'something))
- ((atom x)(setq doctor-object x))
+ (cond ((null x) (setq doctor-object 'something))
+ ((atom x) (setq doctor-object x))
((eq (length x) 1)
(setq doctor-object (cond
((doctor-nounp (setq doctor-object (car x))) doctor-object)
sent)))
(defun doctor-wherego (sent)
- (cond ((null sent)(doc$ doctor--whereoutp))
+ (cond ((null sent) (doc$ doctor--whereoutp))
((null (doctor-meaning (car sent)))
(doctor-wherego (cond ((zerop (random 2))
(reverse (cdr sent)))
(setq foo (cdr foo)))
(setq doctor-verb (car foo))
(setq doctor-obj (doctor-getnoun (cdr foo)))
- (cond ((eq doctor-object 'i)(setq doctor-object 'me))
- ((eq doctor-subj 'me)(setq doctor-subj 'i)))
+ (cond ((eq doctor-object 'i) (setq doctor-object 'me))
+ ((eq doctor-subj 'me) (setq doctor-subj 'i)))
(cond (mem (doctor-remember (list doctor-subj doctor-verb doctor-obj))))))
(defun doctor-possess (sent key)
(defun doctor-rthing () (doctor-type (doc$ doctor--thlst)))
-(defun doctor-remem () (cond ((null doctor--history)(doctor-huh))
+(defun doctor-remem () (cond ((null doctor--history) (doctor-huh))
((doctor-type (doc$ doctor--remlst)))))
(defun doctor-howdy ()
(doctor-type '((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--things) \.)))))
(defun doctor-when ()
- (cond ((< (length (memq doctor-found doctor-sent)) 3)(doctor-short))
+ (cond ((< (length (memq doctor-found doctor-sent)) 3) (doctor-short))
(t
(setq doctor-sent (cdr (memq doctor-found doctor-sent)))
(setq doctor-sent (doctor-fixup doctor-sent))
- (doctor-type '((doc$ doctor--whatwhen)(doc// doctor-sent) \?)))))
+ (doctor-type '((doc$ doctor--whatwhen) (doc// doctor-sent) \?)))))
(defun doctor-conj ()
- (cond ((< (length (memq doctor-found doctor-sent)) 4)(doctor-short))
+ (cond ((< (length (memq doctor-found doctor-sent)) 4) (doctor-short))
(t
(setq doctor-sent (cdr (memq doctor-found doctor-sent)))
(setq doctor-sent (doctor-fixup doctor-sent))
(doctor-type (doc$ doctor--toklst)))
(defun doctor-state ()
- (doctor-type (doc$ doctor--states))(doctor-remember (list 'you 'were doctor-found)))
+ (doctor-type (doc$ doctor--states)) (doctor-remember (list 'you 'were doctor-found)))
(defun doctor-mood ()
- (doctor-type (doc$ doctor--moods))(doctor-remember (list 'you 'felt doctor-found)))
+ (doctor-type (doc$ doctor--moods)) (doctor-remember (list 'you 'felt doctor-found)))
(defun doctor-fear ()
(setq doctor--feared (doctor-setprep doctor-sent doctor-found))
(doctor-svo doctor-sent doctor-found 1 t)
(cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh))
((equal doctor-subj 'you)
- (doctor-type '(why do you (doc// doctor-verb)(doc// doctor-obj) \?)))
- (t (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj))))))
+ (doctor-type '(why do you (doc// doctor-verb) (doc// doctor-obj) \?)))
+ (t (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj))))))
(defun doctor-symptoms ()
(doctor-type '((doc$ doctor--maybe) you should consult a medical doctor\;
(doctor-hates1))
(defun doctor-hates1 ()
- (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj) \?)))
+ (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj) \?)))
(defun doctor-loves ()
(doctor-svo doctor-sent doctor-found 1 t)
(doctor-qloves))
(defun doctor-qloves ()
- (doctor-type '((doc$ doctor--bother)(list doctor-subj doctor-verb doctor-obj) \?)))
+ (doctor-type '((doc$ doctor--bother) (list doctor-subj doctor-verb doctor-obj) \?)))
(defun doctor-love ()
(doctor-svo doctor-sent doctor-found 1 t)
(defun doctor-sexnoun () (doctor-sexverb))
(defun doctor-sexverb ()
- (if (or (memq 'me doctor-sent)(memq 'myself doctor-sent)(memq 'i doctor-sent))
+ (if (or (memq 'me doctor-sent) (memq 'myself doctor-sent) (memq 'i doctor-sent))
(doctor-foul)
(doctor-type (doc$ doctor--sexlst))))
(equal doctor-found 'killing))
(memq 'yourself doctor-sent)))
(setq doctor--suicide-flag t)
- (doctor-type '(If you are really suicidal, you might
+ (doctor-type '(If you are really suicidal\, you might
want to contact the Samaritans via
- E-mail: jo@samaritans.org or, at your option,
+ E-mail: jo@samaritans.org or\, at your option\,
anonymous E-mail: samaritans@anon.twwells.com\ \.
or find a Befrienders crisis center at
http://www.befrienders.org/\ \.
(defun doctor-chat () (doctor-type (doc$ doctor--chatlst)))
-(random t)
-
(provide 'doctor)
;;; doctor.el ends here