[elpa] 222/255: asynchronous IGS game listing

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 7d713cdf70df8fdcce498c8982f21d65b25f6d4a
Author: Eric Schulte <address@hidden>
Date:   Thu Aug 8 10:19:10 2013 -0600

    asynchronous IGS game listing
---
 NOTES            |   15 ++++++++++--
 back-ends/igs.el |   65 +++++++++++++++++++++++++++--------------------------
 2 files changed, 45 insertions(+), 35 deletions(-)

diff --git a/NOTES b/NOTES
index f01c288..c5caa94 100644
--- a/NOTES
+++ b/NOTES
@@ -1,6 +1,6 @@
 #+Options: ^:nil                                      -*- mode:org -*-
 
-* Development [4/5]
+* Development [5/6]
 ** TODO scale image sizes
 See the TODO and note in file:go-board-faces.el.
 
@@ -42,11 +42,20 @@ for controlling the shape of the map.
     sudo tcpick -i wlan0 -yP
   #+end_src
 
-** Asynchronous Process Interaction
+** DONE Asynchronous Process Interaction
 Use process filters (see [[info:elisp#Filter%20Functions][info:elisp#Filter 
Functions]]) to act only on
 whole completed commands.
 
-* Issues [0/1]
+Don't need to use a sentinel, just using the existing process filters,
+and added another case to the filter which will perform long-term
+actions in response to the "prompt" command from IGS.
+
+* Issues [0/2]
+** TODO bug in painting the board
+: Invalid face reference: go-board-filler
+
+Noticed when observing a game from IGS.
+
 ** TODO the black/white turn underlining can get off
 Probably better to explicitly set this every turn, rather than just
 alternating.
diff --git a/back-ends/igs.el b/back-ends/igs.el
index 407f5f6..f012090 100644
--- a/back-ends/igs.el
+++ b/back-ends/igs.el
@@ -102,8 +102,8 @@
   "Time stamp of the last command sent.
 This is used to re-send messages to keep the IGS server from timing out.")
 
-(defvar *igs-ready* nil
-  "Indicates if the IGS server is waiting for input.")
+(defvar *igs-last-command* nil
+  "Last command sent to the IGS process.")
 
 (defvar *igs-games* nil
   "List holding the current games on the IGS server.")
@@ -123,17 +123,24 @@ This is used to re-send messages to keep the IGS server 
from timing out.")
   "Send string COMMAND to the IGS process in the current buffer."
   (goto-char (process-mark (get-buffer-process (current-buffer))))
   (insert command)
-  (setq *igs-time-last-sent* (current-time)
-        *igs-ready* nil)
+  (setq *igs-time-last-sent* (current-time))
+  (setq *igs-last-command* (and (string-match "^\\([^ ]*\\)" command)
+                                (match-string 1 command)))
   (comint-send-input))
 
-(defun igs-filter-process (proc string)
+(defun igs-process-filter (proc string)
   (when (string-match "^\\([[:digit:]]+\\) \\(.+\\)$" string)
     (let* ((number  (read (match-string 1 string)))
            (type    (car (rassoc number igs-message-types)))
            (content (match-string 2 string)))
       (case type
-        (:prompt (igs-w-proc proc (setq *igs-ready* t)))
+        (:prompt
+         (case (if *igs-last-command*
+                   (intern (concat ":" (downcase *igs-last-command*)))
+                 :none)
+           (:games (igs-list-games *igs-instance* *igs-games*))
+           (t nil))
+         (setq *igs-last-command* nil))
         (:info   (unless (string= content "yes")
                    (message "igs-info: %s" content)))
         (:games  (igs-w-proc proc (igs-handle-game content)))
@@ -142,8 +149,9 @@ This is used to re-send messages to keep the IGS server 
from timing out.")
         (:tell   (igs-handle-tell content))
         (:beep   nil)
         (t       (message "igs-unknown: [%s]%s" type content)))
-      (when (> (time-to-seconds (time-since *igs-time-last-sent*))
-               igs-server-ping-delay)
+      (when (and *igs-time-last-sent*
+                 (> (time-to-seconds (time-since *igs-time-last-sent*))
+                    igs-server-ping-delay))
         (igs-send "ayt")))))
 
 (defun igs-insertion-filter (proc string)
@@ -161,12 +169,13 @@ This is used to re-send messages to keep the IGS server 
from timing out.")
               (setf *igs-partial-line* nil)
             (setf *igs-partial-line* (car (last lines)))
             (setf lines (butlast lines)))
-          (mapc (lambda (s) (igs-filter-process proc s)) lines)))
+          (mapc (lambda (s) (igs-process-filter proc s)) lines)))
       (when moving (goto-char (process-mark proc))))))
 
 (defun igs-connect (igs)
   "Open a connection to `igs-server'."
   (cl-flet ((wait (prompt)
+                  (message "IGS waiting for %S..." prompt)
                   (while (and (goto-char (or comint-last-input-end 
(point-min)))
                               (not (re-search-forward prompt nil t)))
                     (accept-process-output proc))))
@@ -178,7 +187,7 @@ This is used to re-send messages to keep the IGS server 
from timing out.")
       (with-current-buffer buffer
         (comint-mode)
         (set (make-local-variable '*igs-instance*) igs)
-        (set (make-local-variable '*igs-ready*) nil)
+        (set (make-local-variable '*igs-last-command*) "")
         (set (make-local-variable '*igs-games*) nil)
         (set (make-local-variable '*igs-current-game*) nil)
         (set (make-local-variable '*igs-partial-line*) nil)
@@ -195,13 +204,19 @@ This is used to re-send messages to keep the IGS server 
from timing out.")
 (defun igs-toggle (setting value)
   (igs-send (format "toggle %s %s" setting (if value "true" "false"))))
 
-(defun igs-observe (&optional game)
-  (interactive)
-  (let ((game (or game (read (org-icompleting-read
-                              "game: "
-                              (mapcar #'number-to-string
-                                      (mapcar #'car *igs-games*)))))))
-    (igs-send (format "observe %s" game))))
+(defun igs-observe (game) (igs-send (format "observe %s" game)))
+
+(defun igs-list-games (instance games)
+  (lexical-let ((instance instance))
+    (list-buffer-create
+     "*igs-game-list*"
+     (cl-mapcar #'cons
+                (mapcar #'car games)
+                (mapcar (curry #'mapcar #'cdr) (mapcar #'cdr games)))
+     '("#" "white" "rk" "black" "rk" "move" "size" "H" "Komi" "by" "fr" "#")
+     (lambda (row col)
+       (let ((id (car (nth row *buffer-list*))))
+         (with-igs instance (igs-observe id)))))))
 
 
 ;;; Specific handlers
@@ -362,21 +377,7 @@ This is used to re-send messages to keep the IGS server 
from timing out.")
   (interactive)
   (set-buffer (buffer (or instance (igs-start))))
   (setf *igs-games* nil)
-  (message "requesting games...")
-  (igs-send "games")
-  (while (not *igs-ready*)
-    (accept-process-output (get-buffer-process (current-buffer))))
-  (with-igs *igs-instance*
-    (lexical-let ((instance *igs-instance*))
-      (list-buffer-create
-       "*igs-game-list*"
-       (cl-mapcar #'cons
-                  (mapcar #'car *igs-games*)
-                  (mapcar (curry #'mapcar #'cdr) (mapcar #'cdr *igs-games*)))
-       '("#" "white" "rk" "black" "rk" "move" "size" "H" "Komi" "by" "fr" "#")
-       (lambda (row col)
-         (let ((id (car (nth row *buffer-list*))))
-           (with-igs instance (igs-observe id))))))))
+  (igs-send "games"))
 
 
 ;;; Class and interface