[elpa] 11/13: [gnugo int] Simplify towards-root loop termination check.

[Thien-Thi Nguyen]

ttn pushed a commit to branch master
in repository elpa.

commit 434cdba049c5ed1e990972f4208bf3965e03883d
Author: Thien-Thi Nguyen <address@hidden>
Date:   Mon Apr 21 23:05:39 2014 +0200

    [gnugo int] Simplify towards-root loop termination check.
    
    * packages/gnugo/gnugo.el (gnugo--climb-towards-root):
    Don't construct local func ‘done’; instead, pre-compute
    final MEM and loop until it's reached, as per ‘eq’.
---
 packages/gnugo/gnugo.el |   46 +++++++++++++++++++---------------------------
 1 files changed, 19 insertions(+), 27 deletions(-)

diff --git a/packages/gnugo/gnugo.el b/packages/gnugo/gnugo.el
index ad6f15b..8cf2a7c 100644
--- a/packages/gnugo/gnugo.el
+++ b/packages/gnugo/gnugo.el
@@ -1942,44 +1942,36 @@ If FILENAME already exists, Emacs confirms that you 
wish to overwrite it."
 
 (defun gnugo--climb-towards-root (spec &optional noalt keep)
   (gnugo-gate)
-  (let* ((n 0)
-         (user-color (gnugo-get :user-color))
+  (let* ((user-color (gnugo-get :user-color))
          (monkey (gnugo-get :monkey))
          (tree (gnugo-get :sgf-gametree))
          (ends (gnugo--tree-ends tree))
          (remorseful (not (gnugo--no-regrets monkey ends)))
-         done)
-    (cond ((numberp spec)
-           (setq n (if (zerop spec)
-                       (if (string= user-color (gnugo-get :last-mover))
-                           1
-                         2)
-                     spec)
-                 done (lambda () (zerop n))))
-          ((string-match "^[a-z]" spec)
-           (let ((pos (upcase spec)))
-             (setq done `(lambda ()
-                           (gnugo-goto-pos ,pos)
-                           (memq (following-char) '(?. ?+))))
-             (when (funcall done)
-               (user-error "%s already clear" pos))
-             (when (= (save-excursion
-                        (gnugo-goto-pos pos)
-                        (following-char))
-                      (if (gnugo--blackp user-color)
-                          ?O
-                        ?X))
-               (user-error "%s not occupied by %s" pos user-color))))
-          (t (user-error "Bad spec: %S" spec)))
+         (stop (if (numberp spec)
+                   (nthcdr (if (zerop spec)
+                               (if (string= (gnugo-get :last-mover)
+                                            user-color)
+                                   1
+                                 2)
+                             spec)
+                           (aref monkey 0))
+                 (let* ((pos spec)
+                        (hmm (or (gnugo--mem-with-played-stone pos)
+                                 (user-error "%s already clear" pos))))
+                   ;; todo: relax ‘gnugo--user-play’ then lift restriction
+                   (unless (eq (gnugo--prop<-color user-color)
+                               (car (gnugo--move-prop (car hmm))))
+                     (user-error "%s not occupied by %s"
+                                 pos user-color))
+                   (cdr hmm)))))
     (when (gnugo-get :game-over)
       (gnugo--unclose-game))
-    (while (not (funcall done))
+    (while (not (eq stop (aref monkey 0)))
       (gnugo--q/ue "undo")
       (pop (aref monkey 0))
       (gnugo-put :last-mover (gnugo-current-player))
       (gnugo-merge-showboard-results)   ; all
       (gnugo-refresh)                   ; this
-      (decf n)                          ; is
       (redisplay))                      ; eye candy
     (let* ((ulastp (string= (gnugo-get :last-mover) user-color))