[elpa] 04/04: [gnugo] New command: ‘ S’ (gnugo-request-suggestion)

[Thien-Thi Nguyen]

ttn pushed a commit to branch master
in repository elpa.

commit f15fc58309e1ed489d672bd0c18c030a50d42607
Author: Thien-Thi Nguyen <address@hidden>
Date:   Tue Apr 15 10:57:07 2014 +0200

    [gnugo] New command: ‘S’ (gnugo-request-suggestion)
    
    * packages/gnugo/gnugo.el (gnugo-gate):
    If waiting for a suggestion, say "Still thinking"
    instead of "Not your turn yet" in error message.
    (gnugo--q): If waiting for a suggestion, say
    "receive a suggestion" instead of "play" in error message.
    (gnugo--rename-buffer-portion): New func.
    (gnugo-get-move-insertion-filter): On received suggestion,
    rename buffer w/ "to play", warp the cursor unless nonsensical
    or inhibited, and display the suggestion in the echo area.
    (gnugo-get-move): Take optional arg SUGGESTION;
    save it as well as color in :waiting.
    (gnugo-request-suggestion): New command.
    (gnugo-board-mode-map): Add binding for ‘S’.
---
 packages/gnugo/NEWS     |    1 +
 packages/gnugo/gnugo.el |   62 +++++++++++++++++++++++++++++++++++++---------
 2 files changed, 51 insertions(+), 12 deletions(-)

diff --git a/packages/gnugo/NEWS b/packages/gnugo/NEWS
index a6be4b8..0c17337 100644
--- a/packages/gnugo/NEWS
+++ b/packages/gnugo/NEWS
@@ -21,6 +21,7 @@ NB: "RCS: X..Y " means that the particular release includes
   - ‘C-u F’ adds the (abbreviated) blurb as a comment to the last node
   - new keybinding for ‘gnugo-undo-one-move’: M-u
   - ‘gnugo-undo-one-move’ can optionally arrange for you to play next
+  - new command: ‘S’ (gnugo-request-suggestion)
   - new command: ‘C’ (gnugo-comment)
   - new command: ‘o’ (gnugo-oops)
   - new command: ‘O’ (gnugo-okay)
diff --git a/packages/gnugo/gnugo.el b/packages/gnugo/gnugo.el
index b15e0bb..37d5a5b 100644
--- a/packages/gnugo/gnugo.el
+++ b/packages/gnugo/gnugo.el
@@ -334,9 +334,13 @@ Handle the big, slow-to-render, and/or uninteresting ones 
specially."
     (user-error "Wrong buffer -- try M-x gnugo"))
   (unless (gnugo-get :proc)
     (user-error "No \"gnugo\" process!"))
-  (when (gnugo-get :waiting)
-    (user-error "Not your turn yet -- please wait for \"\(%s to play\)\""
-                (gnugo-get :user-color)))
+  (let ((slow (gnugo-get :waiting)))
+    (when slow
+      (user-error "%s -- please wait for \"\(%s to play\)\""
+                  (if (cdr slow)
+                      "Still thinking"
+                    "Not your turn yet")
+                  (gnugo-get :user-color))))
   (when (and in-progress-p (gnugo-get :game-over))
     (user-error "Sorry, game over")))
 
@@ -368,7 +372,10 @@ status of the command.  See also `gnugo-query'."
   (let ((slow (gnugo-get :waiting))
         (proc (gnugo-get :proc)))
     (when slow
-      (user-error "Sorry, still waiting for %s to play" slow))
+      (user-error "Sorry, still waiting for %s to %s"
+                  (car slow) (if (cdr slow)
+                                 "receive a suggestion"
+                               "play")))
     (process-put proc :incomplete t)
     (process-put proc :srs "")          ; synchronous return stash
     (gnugo--begin-exchange
@@ -1554,21 +1561,38 @@ its move."
 ;;;---------------------------------------------------------------------------
 ;;; Game play actions
 
+(defun gnugo--rename-buffer-portion (old new)
+  (let ((name (buffer-name)))
+    (when (string-match old name)
+      (rename-buffer (replace-match new t t name)))))
+
 (defun gnugo-get-move-insertion-filter (proc string)
   (with-current-buffer (process-buffer proc)
     (let* ((so-far (gnugo-get :get-move-string))
            (full   (gnugo-put :get-move-string (concat so-far string))))
       (when (string-match "^= \\(.+\\)\n\n" full)
-        (let ((pos-or-pass (match-string 1 full))
-              (color (gnugo-get :waiting)))
+        (destructuring-bind (pos-or-pass color . suggestion)
+            (cons (match-string 1 full)
+                  (gnugo-get :waiting))
           (gnugo-put :get-move-string nil)
           (gnugo-put :waiting nil)
-          (gnugo-push-move (string= color (gnugo-get :user-color))
-                           pos-or-pass)
-          (gnugo--finish-move (current-buffer)))))))
-
-(defun gnugo-get-move (color)
-  (gnugo-put :waiting color)
+          (if suggestion
+              (progn
+                (gnugo--rename-buffer-portion "waiting for suggestion"
+                                              "to play")
+                (unless (or (gnugo--passp full)
+                            (eq 'nowarp suggestion))
+                  (gnugo-goto-pos pos-or-pass))
+                (message "%sSuggestion: %s"
+                         (gnugo-get :diamond)
+                         pos-or-pass))
+            (gnugo-push-move (string= (gnugo-get :user-color)
+                                      color)
+                             pos-or-pass)
+            (gnugo--finish-move (current-buffer))))))))
+
+(defun gnugo-get-move (color &optional suggestion)
+  (gnugo-put :waiting (cons color suggestion))
   (gnugo--begin-exchange
       (gnugo-get :proc) 'gnugo-get-move-insertion-filter
     ;; We used to use ‘genmove’ here, but that forced asymmetry in
@@ -1600,6 +1624,19 @@ its move."
   (or (get-text-property (point) 'gnugo-position)
       (user-error "Not a proper position point")))
 
+(defun gnugo-request-suggestion (&optional nowarp)
+  "Request a move suggestion from GNU Go.
+After some time (during which you can do other stuff),
+Emacs displays the suggestion in the echo area and warps the
+cursor to the suggested position.  Prefix arg inhibits warp."
+  (interactive "P")
+  (gnugo-gate t)
+  (gnugo--rename-buffer-portion "to play" "waiting for suggestion")
+  (gnugo-get-move (gnugo-get :user-color)
+                  (if nowarp
+                      'nowarp
+                    t)))
+
 (defun gnugo-move ()
   "Make a move on the GNUGO Board buffer.
 The position is computed from current point.
@@ -2470,6 +2507,7 @@ starting a new one.  See `gnugo-board-mode' documentation 
for more info."
   (mapc (lambda (pair)
           (define-key gnugo-board-mode-map (car pair) (cdr pair)))
         '(("?"        . describe-mode)
+          ("S"        . gnugo-request-suggestion)
           ("\C-m"     . gnugo-move)
           (" "        . gnugo-move)
           ("P"        . gnugo-pass)