如何写出 doctor.el*

  (global-set-key (kbd "C-z") 'undo)

  (defmacro doc$ (what)
    "Quoted arg form of `doctor-$'."
    `(doctor-$ ',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))

  
在进行纠错和全名部分的处理时，我会建议使用一个更简洁和高效的方法来实现。以下是一个可能的最佳实践：

elisp
Copy code
(defvar doctor--typos
  '((theyll . ("they'll" . "they will"))
    (don7t . ("don't" . "do not"))
    (you7re . ("you're" . "i am"))
    (you7ll . ("you'll" . "i will"))))

(defun doctor-make-variables ()
  (dolist (typo doctor--typos)
    (let ((spelltypo (car typo))
          (correction (car (cdr (cdr typo))))
          (expansion (cdr (cdr typo))))
      (put spelltypo 'doctor-correction correction)
      (put spelltypo 'doctor-expansion expansion)))

    (setq-local doctor--famlst
              '((tell me (doc$ doctor--something) about (doc// doctor-owner) family \.)
                (you seem to dwell on (doc// doctor-owner) family \.)
                ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?)))

    (setq-local doctor--something '((something)
                                  (more)
                                  (how you feel)))

(defun doctor-meaning (x) (get x 'doctor-meaning))

(defmacro doctor-put-meaning (symb val)
  "Store the base meaning of a word on the property list."
  `(put ',symb 'doctor-meaning ,val))

    
  ;;;###autoload
(defun doctor ()
  "Switch to *doctor* buffer and start giving psychotherapy."
  (interactive)
  (switch-to-buffer "*doctor*")
  (doctor-mode))

(defun doctor-ret-or-read (arg)
  "Insert a newline if preceding character is not a newline.
Otherwise call the Doctor to parse preceding sentence."
  (interactive "*p" doctor-mode)
  (if (= (preceding-char) ?\n)
      (doctor-read-print)
    (newline arg)))

  (defun doctor-read-print ()
    "Top level loop."
    (interactive nil doctor-mode)
    (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)
      (while (not (eobp))
	(setq sentence (append sentence (list (doctor-read-token)))))
      sentence))

  (defun doctor-read-token ()
    "Read one word from buffer."
    (prog1 (intern (downcase (buffer-substring (point)
					       (progn
						 (forward-word 1)
						 (point)))))
      (re-search-forward "\\Sw*")))
  

  (defun doctor-doc ()
  (cond
   ((equal doctor-sent '(foo))
    (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)))
	(memq (car doctor-sent)
	      '(bye halt break quit done exit goodbye
		    bye\, stop pause goodbye\, stop pause)))
    (doctor-type (doc$ doctor--bye)))
   ((and (eq (car doctor-sent) 'you)
	 (memq (cadr doctor-sent) doctor--abusewords))
    (setq doctor-found (cadr doctor-sent))
    (doctor-type (doc$ doctor--abuselst)))
   ((eq (car doctor-sent) 'whatmeans)
    (doctor-def (cadr doctor-sent)))
   ((equal doctor-sent '(parse))
    (doctor-type (list  'subj '= doctor-subj ",  "
			'verb '= doctor-verb "\n"
			'object 'phrase '= doctor-obj ","
			'noun 'form '=  doctor-object "\n"
			'current 'keyword 'is doctor-found
			", "
			'most 'recent 'possessive
			'is doctor-owner "\n"
			'sentence 'used 'was
			"..."
			'(doc// doctor--bak))))
   ((memq (car doctor-sent) '(are is do has have how when where who why))
    (doctor-type (doc$ doctor--qlist)))
   ;;   ((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))
		(memq 'am doctor-sent))
	   (setq doctor-sent (doctor-replace doctor-sent '((am . (are)))))))
    (cond ((equal (car doctor-sent) 'yow) (doctor-zippy))
	  ((< (length doctor-sent) 2)
	   (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy)
		  (doctor-howdy))
		 (t (doctor-short))))
	  (t
	   (if (memq 'am doctor-sent)
	       (setq doctor-sent (doctor-replace doctor-sent '((me . (i))))))
	   (setq doctor-sent (doctor-fixup doctor-sent))
	   (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not))
	       (cond ((zerop (random 3))
		      (doctor-type '(are you (doc$ doctor--afraidof) that \?)))
		     ((zerop (random 2))
		      (doctor-type '(don\'t tell me what to do \. i am the
					    doctor here!))
		      (doctor-rthing))
		     (t
		      (doctor-type '((doc$ doctor--whysay) that i shouldn\'t
				     (cddr doctor-sent)
				     \?))))
	     (doctor-go (doctor-wherego doctor-sent))))))))


  (defun doctor-correct-spelling (sent)
  "Correct the spelling and expand each word in sentence."
  (if sent
      (apply 'append (mapcar (lambda (word)
				(if (memq word doctor--typos)
				    (get (get word 'doctor-correction)
					 'doctor-expansion)
				  (list word)))
			     sent))))

(defun doctor-shorten (sent)
  "Make a sentence manageably short using a few hacks."
  (let (foo
	(retval sent)
	(temp '(because but however besides anyway until
		    while that except why how)))
    (while temp
	   (setq foo (memq (car temp) sent))
	   (if (and foo
		    (> (length foo) 3))
	       (setq retval (doctor-fixup foo)
		     temp nil)
	       (setq temp (cdr temp))))
    retval))

  (defun doctor-define (sent found)
  (doctor-svo sent found 1 nil)
  (and
   (doctor-nounp doctor-subj)
   (not (doctor-pronounp doctor-subj))
   doctor-subj
   (doctor-meaning doctor-object)
   (put doctor-subj 'doctor-meaning (doctor-meaning doctor-object))
   t))

  (defun doctor-defq (sent)
  "Set global var DOCTOR-FOUND to first keyword found in sentence SENT."
  (setq doctor-found nil)
  (let ((temp '(means applies mean refers refer related
		      similar defined associated linked like same)))
    (while temp
	   (if (memq (car temp) sent)
	       (setq doctor-found (car temp)
		     temp nil)
	       (setq temp (cdr temp)))))
  doctor-found)
  (defun doctor-def (x)
  (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me))
  nil)
  (defun doctor-forget ()
  "Delete the last element of the history list."
  (setq doctor--history (reverse (cdr (reverse doctor--history)))))
  (defun doctor-query (x)
  "Prompt for a line of input from the minibuffer until a noun or verb is seen.
Put dialogue in buffer."
  (let (a
	(prompt (concat (doctor-make-string x)
			" what ?  "))
	retval)
    (while (not retval)
	   (while (not a)
	     (insert ?\n
		     prompt
		     (read-string prompt)
		     ?\n)
	     (setq a (doctor-readin)))
	   (while (and a (not retval))
		  (cond ((doctor-nounp (car a))
			 (setq retval (car a)))
			((doctor-verbp (car a))
			 (setq retval (doctor-build
				       (doctor-build x " ")
				       (car a))))
			((setq a (cdr a))))))
    retval))

    (defun doctor-subjsearch (sent key type)
    "Search for the subject of a sentence SENT, looking for the noun closest
  to and preceding KEY by at least TYPE words.  Set global variable `doctor-subj'
  to the subject noun, and return the portion of the sentence following it."
    (let ((i (- (length sent) (length (memq key sent)) type)))
      (while (and (> i -1) (not (doctor-nounp (nth i sent))))
	(setq i (1- i)))
      (cond ((> i -1)
	     (setq doctor-subj (nth i sent))
	     (nthcdr (1+ i) sent))
	    (t
	     (setq doctor-subj 'you)
	     nil))))

  (defun doctor-nounp (x)
    "Return non-nil if the symbol argument is a noun."
	  (or (doctor-pronounp x)
	      (not (or (doctor-verbp x)
		       (equal x 'not)
		       (doctor-prepp x)
		       (doctor-modifierp x) )) ))

  (defun doctor-pronounp (x)
    "Return non-nil if the symbol argument is a pronoun."
    (memq x '(
	  i me mine myself
	  we us ours ourselves ourself
	  you yours yourself yourselves
	  he him himself she hers herself
	  it that those this these things thing
	  they them themselves theirs
	  anybody everybody somebody
	  anyone everyone someone
	  anything something everything)))


  (dolist (x
	   '(abort aborted aborts ask asked asks am
	     applied applies apply are associate
	     ...
	     write writes writing wrote use used uses using))
    (put x 'doctor-sentence-type 'verb))

  (defun doctor-verbp (x) (if (symbolp x)
			      (eq (get x 'doctor-sentence-type) 'verb)))

  (defun doctor-plural (x)
    "Form the plural of the word argument."
    (let ((foo (doctor-make-string x)))
      (cond ((string-equal (substring foo -1) "s")
	     (cond ((string-equal (substring foo -2 -1) "s")
		    (intern (concat foo "es")))
		   (t x)))
	     ((string-equal (substring foo -1) "y")
	      (intern (concat (substring foo 0 -1)
			      "ies")))
	     (t (intern (concat foo "s"))))))

  (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))))

  (defun doctor-getnoun (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)
			 (t (doctor-query doctor-object)))))
	  ((eq (car x) 'to)
	   (doctor-build 'to\  (doctor-getnoun (cdr x))))
	  ((doctor-prepp (car x))
	   (doctor-getnoun (cdr x)))
	  ((not (doctor-nounp (car x)))
	   (doctor-build (doctor-build (cdr (assq (car x)
						  (append
						   '((a . this)
						     (some . this)
						     (one . that))
						   (list
						    (cons
						     (car x) (car x))))))
				       " ")
			 (doctor-getnoun (cdr x))))
	  (t (setq doctor-object (car x))
	     (doctor-build (doctor-build (car x) " ") (doctor-getnoun (cdr x))))
	  ))