schemeコードバトン(もどき)をelispで

emacs上だったら、もっとおもしろいことが出来そうだけれど。思いつかない。
関数名などは変えてしまっています。(elispでx->yとか見たことがないので)

(defvar he:word-list-path "word-list.sexp")

(defun he:call-with-input-buffer (buf &optional resumep)
  (when (and (not resumep) (get-buffer buf))
    (with-current-buffer buf (goto-char (point-min))))
  (let (result) 
    (condition-case err
	(while (setq elt (read buf))
	  (push elt result)) 
      (error (nreverse result)))))

(defvar he:get-word-list nil)
(defun he:get-word-list ()
  "ファイルを読み込んでリストにする。(`he:word-list-path'に束縛されているファイルから読み込む"
  (or he:get-word-list
      (setq he:get-word-list (he:call-with-input-buffer (find-file-noselect he:word-list-path)))))

(defun he:create-spec-from-word-list (word-list)
  (let ((spec
	 (loop for (word mean ok-count ng-count) in (he:get-word-list)
	       if (and (null ok-count) (null ng-count))
	       collect (list word mean 0 0)
	       else
	       collect (list word mean ok-count ng-count))))
    ;;間違いが多い順にsort
    (sort spec #'(lambda (x y) (destructuring-bind (_ _ x-ok x-ng) x
				   (destructuring-bind (_ _ y-ok y-ng) y
				     (< (- x-ng x-ok) (- y-ng y-ok))))))))
(defun he:merge-spec (new old)
  (let ((result))
    (loop for x in new 
	  do (push x result)
	  do (setq old (cdr old)))
    (loop for x in old
	  do (push x result))
    (nreverse result)))
      
(defun he:quiz () (interactive)
  (let ((spec (he:create-spec-from-word-list (he:get-word-list)))
	(result-spec))
    (destructuring-bind (yvec nvec cgvec) 
	(mapcar #'(lambda (s) (string-to-vector (read-kbd-macro s)))
		'("y" "n" "C-g"))
      (loop for (word mean ok-count ng-count) in spec
	    for keyv = (read-key-sequence-vector (format "%s: (exit C-g)" word))
	    do (progn (message mean) (sit-for 1))
	    do (cond ((equal cgvec keyv) (return nil))
		     ((equal yvec keyv) (push (list word mean (1+ ok-count) ng-count) result-spec))
		     ((equal nvec keyv) (push (list word mean ok-count (1+ ng-count)) result-spec))
		     (t (push (list word mean ok-count (1+ ng-count)) result-spec)))) ;;fix
      (setq he:get-word-list (he:merge-spec (nreverse result-spec) spec)))))

追記

いつ状態を保存すれば良いか思いつかない。
とりあえず、C-gを効くようにして、保存もコマンドでできるようにする。

(defun he:quiz () (interactive)
  (let ((spec (he:create-spec-from-word-list (he:get-word-list)))
	(result-spec))
    (destructuring-bind (yvec nvec cgvec) 
	(mapcar #'(lambda (s) (string-to-vector (read-kbd-macro s)))
		'("y" "n" "C-g"))
      (loop for (word mean ok-count ng-count) in spec
	    for keyv = (read-key-sequence-vector (format "%s: (exit C-g)" word))
	    never (equal cgvec keyv)
	    do (progn (message mean)
		      (sit-for 1)
		      (cond ((equal yvec keyv) (push (list word mean (1+ ok-count) ng-count) result-spec))
			    ((equal nvec keyv) (push (list word mean ok-count (1+ ng-count)) result-spec))
			    (t (push (list word mean ok-count (1+ ng-count)) result-spec))))) ;;fix
      (setq he:get-word-list (he:merge-spec (nreverse result-spec) spec)))))

(defun he:quiz-save () (interactive)
  (when he:get-word-list
    (with-current-buffer (find-file-noselect he:word-list-path)
      (erase-buffer)
      (dolist (elt he:get-word-list) 
	(insert (format "%s" elt) "\n"))
      (save-buffer))))