comparison lisp/play/doctor.el @ 47314:0b575bd912a4

(doctor-doc): Recognize question words and use qlist. Use doctor-shorten's return value. (doctor-shorten): Compute a return value, don't alter `sent'. (doctor-hates1): Add a question mark. (doctor-strangelove): Unused function deleted.
author Richard M. Stallman <rms@gnu.org>
date Mon, 09 Sep 2002 00:25:09 +0000
parents 31cee69dfd2c
children 8a11a2109567
comparison
equal deleted inserted replaced
47313:52f90db3f174 47314:0b575bd912a4
907 'most 'recent 'possessive 907 'most 'recent 'possessive
908 'is owner "\n" 908 'is owner "\n"
909 'sentence 'used 'was 909 'sentence 'used 'was
910 "..." 910 "..."
911 '(// bak)))) 911 '(// bak))))
912 ((memq (car sent) '(do has have how when where who why))
913 (doctor-type ($ qlist)))
912 ;; ((eq (car sent) 'forget) 914 ;; ((eq (car sent) 'forget)
913 ;; (set (doctor-cadr sent) nil) 915 ;; (set (doctor-cadr sent) nil)
914 ;; (doctor-type '(($ isee)($ please) 916 ;; (doctor-type '(($ isee)($ please)
915 ;; ($ continue)\.))) 917 ;; ($ continue)\.)))
916 (t 918 (t
917 (if (doctor-defq sent) (doctor-define sent found)) 919 (if (doctor-defq sent) (doctor-define sent found))
918 (if (> (length sent) 12)(doctor-shorten sent)) 920 (if (> (length sent) 12)(setq sent (doctor-shorten sent)))
919 (setq sent (doctor-correct-spelling (doctor-replace sent replist))) 921 (setq sent (doctor-correct-spelling (doctor-replace sent replist)))
920 (cond ((and (not (memq 'me sent))(not (memq 'i sent)) 922 (cond ((and (not (memq 'me sent))(not (memq 'i sent))
921 (memq 'am sent)) 923 (memq 'am sent))
922 (setq sent (doctor-replace sent '((am . (are))))))) 924 (setq sent (doctor-replace sent '((am . (are)))))))
923 (cond ((equal (car sent) 'yow) (doctor-zippy)) 925 (cond ((equal (car sent) 'yow) (doctor-zippy))
954 sent)))) 956 sent))))
955 957
956 (defun doctor-shorten (sent) 958 (defun doctor-shorten (sent)
957 "Make a sentence manageably short using a few hacks." 959 "Make a sentence manageably short using a few hacks."
958 (let (foo 960 (let (foo
959 retval 961 (retval sent)
960 (temp '(because but however besides anyway until 962 (temp '(because but however besides anyway until
961 while that except why how))) 963 while that except why how)))
962 (while temp 964 (while temp
963 (setq foo (memq (car temp) sent)) 965 (setq foo (memq (car temp) sent))
964 (if (and foo 966 (if (and foo
965 (> (length foo) 3)) 967 (> (length foo) 3))
966 (setq sent foo 968 (setq retval (doctor-fixup foo)
967 sent (doctor-fixup sent) 969 temp nil)
968 temp nil
969 retval t)
970 (setq temp (cdr temp)))) 970 (setq temp (cdr temp))))
971 retval)) 971 retval))
972 972
973 (defun doctor-define (sent found) 973 (defun doctor-define (sent found)
974 (doctor-svo sent found 1 nil) 974 (doctor-svo sent found 1 nil)
1538 (defun doctor-hates () 1538 (defun doctor-hates ()
1539 (doctor-svo sent found 1 t) 1539 (doctor-svo sent found 1 t)
1540 (doctor-hates1)) 1540 (doctor-hates1))
1541 1541
1542 (defun doctor-hates1 () 1542 (defun doctor-hates1 ()
1543 (doctor-type '(($ whysay)(list subj verb obj)))) 1543 (doctor-type '(($ whysay)(list subj verb obj) \?)))
1544 1544
1545 (defun doctor-loves () 1545 (defun doctor-loves ()
1546 (doctor-svo sent found 1 t) 1546 (doctor-svo sent found 1 t)
1547 (doctor-qloves)) 1547 (doctor-qloves))
1548 1548
1632 (doctor-type '(yow! are we interactive yet \?))))) 1632 (doctor-type '(yow! are we interactive yet \?)))))
1633 1633
1634 1634
1635 (defun doctor-chat () (doctor-type ($ chatlst))) 1635 (defun doctor-chat () (doctor-type ($ chatlst)))
1636 1636
1637 (defun doctor-strangelove ()
1638 (interactive)
1639 (insert "Mein fuehrer!!\n")
1640 (doctor-read-print))
1641
1642 (provide 'doctor) 1637 (provide 'doctor)
1643 1638
1644 ;;; doctor.el ends here 1639 ;;; doctor.el ends here