[Emacs-diffs] Changes to emacs/lisp/play/doctor.el

[John Paul Wallington]

Index: emacs/lisp/play/doctor.el
diff -c emacs/lisp/play/doctor.el:1.28 emacs/lisp/play/doctor.el:1.29
*** emacs/lisp/play/doctor.el:1.28      Sun Sep  8 20:25:09 2002
--- emacs/lisp/play/doctor.el   Mon Sep  9 01:50:58 2002
***************
*** 45,54 ****
  
  ;;; Code:
  
- (defun doctor-cadr (x) (car (cdr x)))
- (defun doctor-caddr (x) (car (cdr (cdr x))))
- (defun doctor-cddr (x) (cdr (cdr x)))
- 
  (defun // (x) x)
  
  (defmacro $ (what)
--- 45,50 ----
***************
*** 91,98 ****
    (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))
--- 87,94 ----
    (make-local-variable 'typos)
    (setq typos
        (mapcar (function (lambda (x)
!                           (put (car x) 'doctor-correction  (cadr x))
!                           (put (cadr x) 'doctor-expansion (car (cddr x)))
                            (car x)))
                '((theyll they\'ll (they will))
                  (theyre they\'re (they are))
***************
*** 892,902 ****
                    bye\, stop pause goodbye\, stop pause)))
      (doctor-type ($ bye)))
     ((and (eq (car sent) 'you)
!        (memq (doctor-cadr sent) abusewords))
!     (setq found (doctor-cadr sent))
      (doctor-type ($ abuselst)))
     ((eq (car sent) 'whatmeans)
!     (doctor-def (doctor-cadr sent)))
     ((equal sent '(parse))
      (doctor-type (list  'subj '= subj ",  "
                        'verb '= verb "\n"
--- 888,898 ----
                    bye\, stop pause goodbye\, stop pause)))
      (doctor-type ($ bye)))
     ((and (eq (car sent) 'you)
!        (memq (cadr sent) abusewords))
!     (setq found (cadr sent))
      (doctor-type ($ abuselst)))
     ((eq (car sent) 'whatmeans)
!     (doctor-def (cadr sent)))
     ((equal sent '(parse))
      (doctor-type (list  'subj '= subj ",  "
                        'verb '= verb "\n"
***************
*** 912,918 ****
     ((memq (car sent) '(do has have how when where who why))
      (doctor-type ($ qlist)))
     ;;   ((eq (car sent) 'forget)
!    ;;    (set (doctor-cadr sent) nil)
     ;;    (doctor-type '(($ isee)($ please)
     ;;     ($ continue)\.)))
     (t
--- 908,914 ----
     ((memq (car sent) '(do has have how when where who why))
      (doctor-type ($ qlist)))
     ;;   ((eq (car sent) 'forget)
!    ;;    (set (cadr sent) nil)
     ;;    (doctor-type '(($ isee)($ please)
     ;;     ($ continue)\.)))
     (t
***************
*** 931,937 ****
           (if (memq 'am sent)
               (setq sent (doctor-replace sent '((me . (i))))))
           (setq sent (doctor-fixup sent))
!          (if (and (eq (car sent) 'do) (eq (doctor-cadr sent) 'not))
               (cond ((zerop (random 3))
                      (doctor-type '(are you ($ afraidof) that \?)))
                     ((zerop (random 2))
--- 927,933 ----
           (if (memq 'am sent)
               (setq sent (doctor-replace sent '((me . (i))))))
           (setq sent (doctor-fixup sent))
!          (if (and (eq (car sent) 'do) (eq (cadr sent) 'not))
               (cond ((zerop (random 3))
                      (doctor-type '(are you ($ afraidof) that \?)))
                     ((zerop (random 2))
***************
*** 940,946 ****
                      (doctor-rthing))
                     (t
                      (doctor-type '(($ whysay) that i shouldn\'t
!                                    (doctor-cddr sent)
                                     \?))))
             (doctor-go (doctor-wherego sent))))))))
  
--- 936,942 ----
                      (doctor-rthing))
                     (t
                      (doctor-type '(($ whysay) that i shouldn\'t
!                                    (cddr sent)
                                     \?))))
             (doctor-go (doctor-wherego sent))))))))
  
***************
*** 1138,1150 ****
  (defun doctor-setprep (sent key)
    (let ((val)
        (foo (memq key sent)))
!     (cond ((doctor-prepp (doctor-cadr foo))
!          (setq val (doctor-getnoun (doctor-cddr foo)))
           (cond (val val)
                 (t 'something)))
!         ((doctor-articlep (doctor-cadr foo))
!          (setq val (doctor-getnoun (doctor-cddr foo)))
!          (cond (val (doctor-build (doctor-build (doctor-cadr foo) " ") val))
                 (t 'something)))
          (t 'something))))
  
--- 1134,1146 ----
  (defun doctor-setprep (sent key)
    (let ((val)
        (foo (memq key sent)))
!     (cond ((doctor-prepp (cadr foo))
!          (setq val (doctor-getnoun (cddr foo)))
           (cond (val val)
                 (t 'something)))
!         ((doctor-articlep (cadr foo))
!          (setq val (doctor-getnoun (cddr foo)))
!          (cond (val (doctor-build (doctor-build (cadr foo) " ") val))
                 (t 'something)))
          (t 'something))))
  
***************
*** 1275,1307 ****
    (let ((foo sent))
      (while foo
        (if (and (eq (car foo) 'me)
!              (doctor-verbp (doctor-cadr foo)))
          (rplaca foo 'i)
        (cond ((eq (car foo) 'you)
!              (cond ((memq (doctor-cadr foo) '(am be been is))
                      (rplaca (cdr foo) 'are))
!                    ((memq (doctor-cadr foo) '(has))
                      (rplaca (cdr foo) 'have))
!                    ((memq (doctor-cadr foo) '(was))
                      (rplaca (cdr foo) 'were))))
              ((equal (car foo) 'i)
!              (cond ((memq (doctor-cadr foo) '(are is be been))
                      (rplaca (cdr foo) 'am))
!                    ((memq (doctor-cadr foo) '(were))
                      (rplaca (cdr foo) 'was))
!                    ((memq (doctor-cadr foo) '(has))
                      (rplaca (cdr foo) 'have))))
              ((and (doctor-verbp (car foo))
!                   (eq (doctor-cadr foo) 'i)
!                   (not (doctor-verbp (car (doctor-cddr foo)))))
               (rplaca (cdr foo) 'me))
              ((and (eq (car foo) 'a)
                    (doctor-vowelp (string-to-char
!                                   (doctor-make-string (doctor-cadr foo)))))
               (rplaca foo 'an))
              ((and (eq (car foo) 'an)
                    (not (doctor-vowelp (string-to-char
!                                        (doctor-make-string (doctor-cadr 
foo))))))
               (rplaca foo 'a)))
        (setq foo (cdr foo))))
      sent))
--- 1271,1303 ----
    (let ((foo sent))
      (while foo
        (if (and (eq (car foo) 'me)
!              (doctor-verbp (cadr foo)))
          (rplaca foo 'i)
        (cond ((eq (car foo) 'you)
!              (cond ((memq (cadr foo) '(am be been is))
                      (rplaca (cdr foo) 'are))
!                    ((memq (cadr foo) '(has))
                      (rplaca (cdr foo) 'have))
!                    ((memq (cadr foo) '(was))
                      (rplaca (cdr foo) 'were))))
              ((equal (car foo) 'i)
!              (cond ((memq (cadr foo) '(are is be been))
                      (rplaca (cdr foo) 'am))
!                    ((memq (cadr foo) '(were))
                      (rplaca (cdr foo) 'was))
!                    ((memq (cadr foo) '(has))
                      (rplaca (cdr foo) 'have))))
              ((and (doctor-verbp (car foo))
!                   (eq (cadr foo) 'i)
!                   (not (doctor-verbp (car (cddr foo)))))
               (rplaca (cdr foo) 'me))
              ((and (eq (car foo) 'a)
                    (doctor-vowelp (string-to-char
!                                   (doctor-make-string (cadr foo)))))
               (rplaca foo 'an))
              ((and (eq (car foo) 'an)
                    (not (doctor-vowelp (string-to-char
!                                        (doctor-make-string (cadr foo))))))
               (rplaca foo 'a)))
        (setq foo (cdr foo))))
      sent))
***************
*** 1494,1505 ****
    (let ((foo (memq found sent)))
      (cond ((< (length foo) 2)
           (doctor-go (doctor-build (doctor-meaning found) 1)))
!         ((memq (doctor-cadr foo) '(a an))
           (rplacd foo (append '(to have) (cdr foo)))
           (doctor-svo sent found 1 nil)
           (doctor-remember (list subj 'would 'like obj))
           (doctor-type ($ whywant)))
!         ((not (eq (doctor-cadr foo) 'to))
           (doctor-go (doctor-build (doctor-meaning found) 1)))
          (t
           (doctor-svo sent found 1 nil)
--- 1490,1501 ----
    (let ((foo (memq found sent)))
      (cond ((< (length foo) 2)
           (doctor-go (doctor-build (doctor-meaning found) 1)))
!         ((memq (cadr foo) '(a an))
           (rplacd foo (append '(to have) (cdr foo)))
           (doctor-svo sent found 1 nil)
           (doctor-remember (list subj 'would 'like obj))
           (doctor-type ($ whywant)))
!         ((not (eq (cadr foo) 'to))
           (doctor-go (doctor-build (doctor-meaning found) 1)))
          (t
           (doctor-svo sent found 1 nil)