[elpa] 245/255: misc fixes

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 723a5bd40cfb4b2effb8dc2298837987da37b79b
Author: Eric Schulte <address@hidden>
Date:   Fri Aug 9 16:56:33 2013 -0600

    misc fixes
---
 back-ends/gtp-pipe.el |   37 +++++++++++++++++++++++--------------
 go-board.el           |    2 +-
 2 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/back-ends/gtp-pipe.el b/back-ends/gtp-pipe.el
index fe01623..3b0529c 100644
--- a/back-ends/gtp-pipe.el
+++ b/back-ends/gtp-pipe.el
@@ -36,6 +36,9 @@
 (defvar *gtp-pipe-last* nil
   "Last move of the current game.")
 
+(defvar *gtp-pipe-inhibit* nil
+  "Prevent infinite loops of commands.")
+
 (defun gtp-pipe-start (command)
   "Connect a `gtp-pipe' instance to the process created by COMMAND.
 Pass \"netcat -lp 6666\" as COMMAND to listen on a local port, or
@@ -47,22 +50,21 @@ port."
 (defun gtp-pipe-process-filter (proc string)
   (go-re-cond string
     ("^\\(black\\|white\\) \\(.*\\)$"
-     (let ((color (match-string 1 string))
+     (let ((color (go-re-cond (match-string 1 string)
+                    ("black" :B)
+                    ("white" :W)))
            (action (match-string 2 string)))
        (go-re-cond action
-         ("^pass"   (go-pass   *gtp-pipe-board*))
-         ("^resign" (go-resign *gtp-pipe-board*))
-         (t (let ((move (gtp-to-pos (go-re-cond 
-                                        ("black" :B)
-                                      ("white" :W))
-                                    (match-string 2 string))))
+         ("^pass"   (let ((*gtp-pipe-inhibit* t)) (go-pass   
*gtp-pipe-board*)))
+         ("^resign" (let ((*gtp-pipe-inhibit* t)) (go-resign 
*gtp-pipe-board*)))
+         (t (let ((move (gtp-to-pos color action)))
               (setf *gtp-pipe-last* move)
               (setf (go-move *gtp-pipe-board*) move))))))
-    ("^genmove_\\(black\\|white\\)" (message "gtp-pipe: %s's turn"
-                                             (match-string 1 string)))
+    ("^genmove_\\(black\\|white\\)"
+     (message "gtp-pipe: %s's turn" (match-string 1 string)))
     ("^last_move" (go-to-gtp-command *gtp-pipe-last*))
-    ("^quit" (message "gtp-pipe: QUIT") (go-quit *gtp-pipe-board*))
-    ("^undo" (go-undo *gtp-pipe-board*))
+    ("^quit" (let ((*gtp-pipe-inhibit* t)) (go-quit *gtp-pipe-board*)))
+    ("^undo" (let ((*gtp-pipe-inhibit* t)) (go-undo *gtp-pipe-board*)))
     ("^string \\(.*\\)$" (message "gtp-pipe: %S" (match-string 1 string)))
     (t (message "gtp-pipe unknown command: %S" string))))
 
@@ -80,6 +82,7 @@ port."
           (with-current-buffer buf
             (comint-mode)
             (set (make-local-variable '*gtp-pipe-last*) nil)
+            (set (make-local-variable '*gtp-pipe-inhibit*) nil)
             (set (make-local-variable '*gtp-pipe-board*)
                  (save-excursion
                    (make-instance 'board
@@ -91,9 +94,10 @@ port."
 
 (defmethod gtp-command ((gtp-pipe gtp-pipe) command)
   (with-current-buffer (buffer gtp-pipe)
-    (goto-char (process-mark (get-buffer-process (current-buffer))))
-    (insert command)
-    (comint-send-input)))
+    (unless *gtp-pipe-inhibit*
+      (goto-char (process-mark (get-buffer-process (current-buffer))))
+      (insert command)
+      (comint-send-input))))
 
 (defmethod go-comment ((gtp-pipe gtp-pipe))
   (signal 'unsupported-back-end-command (list gtp-pipe :comment)))
@@ -109,6 +113,11 @@ port."
 (defmethod go-size ((gtp-pipe gtp-pipe))
   (read-from-minibuffer "GTP board size: " nil nil 'read))
 
+(defmethod go-quit ((gtp-pipe gtp-pipe))
+  (gtp-command gtp-pipe "quit")
+  (with-current-buffer (buffer gtp-pipe)
+    (signal-process (get-buffer-process) 'KILL)))
+
 (defmethod go-player-name ((gtp-pipe gtp-pipe) color) "GTP pipe")
 
 (defmethod set-player-name ((gtp-pipe gtp-pipe) color name)
diff --git a/go-board.el b/go-board.el
index b82712f..6ed29e9 100644
--- a/go-board.el
+++ b/go-board.el
@@ -566,6 +566,6 @@
     (update-display)))
 
 (defmethod go-quit ((board board))
-  (with-board board (board-quit)))
+  (with-board board (go-quit)))
 
 (provide 'go-board)