[elpa] 01/06: [gnugo] New command: ‘ C-c C-a’ (gnugo-toggle-abdication)

[Thien-Thi Nguyen]

ttn pushed a commit to branch master
in repository elpa.

commit 3c4b9d4c277a2aca71f105d17ee31177ed076431
Author: Thien-Thi Nguyen <address@hidden>
Date:   Tue Apr 15 19:02:09 2014 +0200

    [gnugo] New command: ‘C-c C-a’ (gnugo-toggle-abdication)
    
    * packages/gnugo/gnugo.el (gnugo-refresh):
    Include "Abd" in mode line if abdication enabled.
    (gnugo-get-move-insertion-filter): If abdication enabled,
    create and save a timer object to call ‘gnugo-get-move’
    w/ the opposite of the current ‘color’.
    (gnugo-toggle-abdication): New command.
    (gnugo-board-mode-map): Add binding for ‘C-c C-a’.
---
 packages/gnugo/NEWS     |    1 +
 packages/gnugo/gnugo.el |   57 ++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 55 insertions(+), 3 deletions(-)

diff --git a/packages/gnugo/NEWS b/packages/gnugo/NEWS
index 0c17337..02c9337 100644
--- a/packages/gnugo/NEWS
+++ b/packages/gnugo/NEWS
@@ -26,6 +26,7 @@ NB: "RCS: X..Y " means that the particular release includes
   - new command: ‘o’ (gnugo-oops)
   - new command: ‘O’ (gnugo-okay)
   - new command: ‘L’ (gnugo-frolic-in-the-leaves)
+  - new command: ‘C-c C-a’ (gnugo-toggle-abdication)
   - new major mode: GNUGO Frolic (gnugo-frolic-mode)
   - ‘gnugo-move-history’ returns last two moves w/ RSEL ‘two’
   - performance improvements
diff --git a/packages/gnugo/gnugo.el b/packages/gnugo/gnugo.el
index 97d406d..0224f9f 100644
--- a/packages/gnugo/gnugo.el
+++ b/packages/gnugo/gnugo.el
@@ -1555,7 +1555,10 @@ its move."
                    ;; this dynamicism is nice but excessive in its wantonness
                    ;;- `(" [" (:eval ,form) "]")
                    ;; this dynamicism is ok because the user triggers it
-                   (list (format " [%s]" (eval form))))))
+                   (list (format " [%s]" (eval form))
+                         '(:eval (if (gnugo-get :abd)
+                                     " Abd"
+                                   ""))))))
       (force-mode-line-update))
     ;; last user move
     (when (setq last (gnugo-get :last-user-bpos))
@@ -1597,8 +1600,19 @@ its move."
                 (message "%sSuggestion: %s"
                          (gnugo-get :diamond)
                          pos-or-pass))
-            (gnugo-push-move color pos-or-pass)
-            (gnugo--finish-move (current-buffer))))))))
+            (let* ((donep (gnugo-push-move color pos-or-pass))
+                   (buf (current-buffer)))
+              (gnugo--finish-move buf)
+              (when (gnugo-get :abd)
+                (gnugo-put :abd
+                  (unless donep
+                    (run-at-time
+                     2 ;;; sec (frettoloso? dubioso!)
+                     nil (lambda (buf color)
+                           (with-current-buffer buf
+                             (gnugo-get-move color)))
+                     buf
+                     (gnugo-other color))))))))))))
 
 (defun gnugo-get-move (color &optional suggestion)
   (gnugo-put :waiting (cons color suggestion))
@@ -2238,6 +2252,42 @@ If COMMENT is nil or the empty string, remove the 
property entirely."
   (unless (zerop (length comment))
     (gnugo--decorate node `((:C . ,comment)))))
 
+(defun gnugo-toggle-abdication ()
+  "Toggle abdication, i.e., letting GNU Go play for you.
+When enabled, the mode line includes \"Abd\".
+Enabling signals error if the game is over.
+Disabling signals error if the color \"to play\" is the user color.
+This is to ensure that the user is the next to play after disabling."
+  (interactive)
+  (let ((last-mover (gnugo-get :last-mover))
+        (abd (gnugo-get :abd))
+        (warning ""))
+    (if abd
+        ;; disable
+        (destructuring-bind (gcolor ucolor &optional color . suggestion)
+            (list* (gnugo-get :gnugo-color)
+                   (gnugo-get :user-color)
+                   (gnugo-get :waiting))
+          (assert (not suggestion))
+          (when (string= last-mover gcolor)
+            (user-error "Sorry, too soon -- please wait for \"(%s to play\)\""
+                        gcolor))
+          (when (timerp abd)
+            (cancel-timer abd))
+          (gnugo-put :abd nil)
+          (unless color
+            (gnugo-get-move gcolor)))
+      ;; enable
+      (when (gnugo-get :game-over)
+        (user-error "Sorry, game over"))
+      (gnugo-put :abd t)
+      (gnugo-get-move (gnugo-other last-mover)))
+    (message "Abdication %sabled%s"
+             (if (gnugo-get :abd)
+                 "en"
+               "dis")
+             warning)))
+
 ;;;---------------------------------------------------------------------------
 ;;; Command properties and gnugo-command
 
@@ -2551,6 +2601,7 @@ starting a new one.  See `gnugo-board-mode' documentation 
for more info."
           ("F"        . gnugo-display-final-score)
           ("A"        . gnugo-switch-to-another)
           ("C"        . gnugo-comment)
+          ("\C-c\C-a" . gnugo-toggle-abdication)
           ;; mouse
           ([(down-mouse-1)] . gnugo-mouse-move)
           ([(down-mouse-2)] . gnugo-mouse-move) ; mitigate accidents