better icc datagram support

1 files changed, 140 insertions, 2 deletions

diff --git a/chess-ics.el b/chess-ics.el
index 0bb5e0c..278b127 100644
--- a/chess-ics.el
+++ b/chess-ics.el
@@ -110,10 +110,11 @@ Possible values are currently FICS (the default, and best supported)
 and ICC.")
 (make-variable-buffer-local 'chess-ics-server-type)
 
-(defcustom chess-ics-icc-datagrams '(33 50 51 56 110 111)
+(defcustom chess-ics-icc-datagrams '(26 33 50 51 56 110 111)
   "*A list of datagrams to request when connecting to ICC."
   :group 'chess-ics
   :type '(repeat (choice (const :tag "DG_SEND_MOVES" 24)
+			 (const :tag "DG_KIBITZ" 26)
 			 (const :tag "DG_MOVE_ALGEBRAIC" 33)
 			 (const :tag "DG_SEEK" 50)
 			 (const :tag "DG_SEEK_REMOVED" 51)
@@ -190,7 +191,8 @@ standard position).  In those cases, this variable should be set to nil.")
 	  (lambda ()
 	    (when chess-ics-handling-login
 	      (setq chess-ics-server-type 'ICC
-		    comint-preoutput-filter-functions '(chess-ics-icc-preoutput-filter)))
+		    comint-preoutput-filter-functions
+		    '(chess-icc-preoutput-filter)))
 	    'once)))
    (cons "\\(ogin\\|name\\):"
 	 (function
@@ -884,6 +886,142 @@ This function should be put on `comint-preoutput-filter-functions'."
 	(accept-process-output (get-buffer-process (current-buffer)) 0 100)))
     (switch-to-buffer buf)))
 
+(defvar chess-icc-unprocessed nil)
+(defun chess-icc-datagram-handler (string)
+  (if (not (string-match "^\\([0-9]+\\) \\(.*\\)$" string))
+      (format "\nUnknown datagram format: %s\n" string)
+    (let ((chess-engine-handling-event t)
+	  (dg (string-to-int (match-string 1 string)))
+	  (args (match-string 2 string)))
+      (cond
+       ((and (or (= dg 101) (= dg 110))
+	     (string-match "\\([0-9]+\\) {\\(.+\\) \\(?:[0-9]+\\) \\(?:[0-9]+\\)} \\([0-9]+\\)" args))
+	(let ((pos (chess-fen-to-pos (match-string 2 args))))
+	  (chess-game-set-start-position
+	   (chess-ics-game (string-to-int (match-string 1 args))) pos))
+	"")
+       ((and (or (= dg 24) (= dg 111))
+	     (string-match "^\\([0-9]+\\) \\(.+\\)$" args))
+	(let* ((move (match-string 2 args))
+	       (game (chess-ics-game (string-to-int (match-string 1 args))))
+	       (pos (chess-game-pos game))
+	       (ply (chess-algebraic-to-ply pos move)))
+	  (chess-game-move game ply)
+	  ""))
+       ((and (= dg 26)
+	     (string-match "^\\([0-9]+\\) \\(\\S-+\\) {\\([^}]*\\)} \\([01]\\) {\\(.*\\)}"
+			   args))
+	(let ((game-number (match-string 1 args))
+	      (action (if (string= (match-string 4 args) "1")
+			  "kibitzes" "whispers"))
+	      (name (match-string 2 args))
+	      (titles (match-string 3 args))
+	      (text (match-string 5 args)))
+	  (setq name
+		(concat name
+			(mapconcat (lambda (title)
+				     (concat "(" title ")"))
+				   (split-string titles " ") "")))
+	  (format "\n%s[%s] %s: %s\n" name game-number action text)))
+       ((and (= dg 56)
+	     (string-match "^\\([0-9]+\\) \\([WB]\\) \\([0-9]+\\) \\([01]\\)"
+			   args))
+	(let ((sec (/ (string-to-int (match-string 3 args)) 1000))
+	      (color (if (string= (match-string 2 args) "W")
+			 'white-remaining 'black-remaining))
+	      (game (chess-ics-game (string-to-int (match-string 1 args)))))
+	  (chess-game-set-data game color sec))
+	"")
+       ((and (= dg 50)
+	    (string-match "^\\([0-9]+\\) \\(\\S-+\\) {\\([^}]*\\)} \\([0-9]+\\) \\([0-2]\\) \\([0-9]+\\) \\(\\S-+\\) \\([0-9]+\\) \\([0-9]+\\) \\([01]\\) \\(-?[01]\\) \\([0-9]+\\) \\([0-9]+\\) \\([01]\\) \\([01]\\) {\\([^}]*\\)}" args))
+	(let* ((name (concat (match-string 2 args)
+			     (if (not (string= (match-string 3 args) ""))
+				 (format "(%s)" (match-string 3 args))
+			       "")))
+	       (rating (string-to-int (match-string 4 args)))
+	       (time (string-to-int (match-string 8 args)))
+	       (inc (string-to-int (match-string 9 args)))
+	       (rated (if (string= (match-string 10 args) "1") "yes" "no"))
+	       (variant (concat (match-string 7 args)
+				(if (not (string= (match-string 6 args) "0"))
+				    (concat " " (match-string 6 args))
+				  "")
+				(if (string= (match-string 14 args) "0")
+				    " m"
+				  "")
+				(if (string= (match-string 15 args) "1")
+				    " f"
+				  "")))
+	       (cmd (concat "play " (match-string 1 args)))
+	       (id (substring cmd 5))
+	       (ics-buffer (current-buffer)))
+	  (setq id (concat id (make-string (- 4 (length id)) ? )))
+	  (setq name (concat name (make-string (- 20 (length name)) ? )))
+	  (setq variant (concat variant (make-string (- 25 (length variant)) ? )))
+	  (with-current-buffer
+	      (or (get-buffer chess-ics-sought-buffer-name)
+		  (with-current-buffer (get-buffer-create
+					chess-ics-sought-buffer-name)
+		    (chess-ics-sought-mode)
+		    (setq chess-ics-sought-parent-buffer ics-buffer)
+		    (and chess-ics-popup-sought (display-buffer (current-buffer)))
+		    (current-buffer)))
+	    (let ((here (point)))
+	      (when (re-search-forward (concat "^" (regexp-quote id) " ") nil t)
+		(goto-char (line-beginning-position))
+		(delete-region (point) (1+ (line-end-position))))
+	      (goto-char (point-min))
+	      (let ((beg (point)))
+		(insert (format "%s %s %4d %4s  %3d/%3d %s"
+				id name rating rated time inc variant))
+		(add-text-properties
+		 beg (point)
+		 (list 'rear-nonsticky t
+		       'mouse-face 'highlight
+		       'ics-command cmd))
+		(insert "\n"))
+	      (chess-ics-sought-sort)
+	      (goto-char here))))
+	"")
+       ((= dg 51)
+	(let ((id (car (split-string args " ")))
+	      (buf (get-buffer chess-ics-sought-buffer-name)))
+	  (when (buffer-live-p buf)
+	    (with-current-buffer buf
+	      (let ((here (point)))
+		(goto-char (point-min))
+		(when (re-search-forward (concat "^" id " ") nil t)
+		  (delete-region (line-beginning-position)
+				 (1+ (line-end-position))))
+		(goto-char here)))))
+	"")
+       (t
+	(format "\nIgnoring datagram DG%03d: %s\n" dg args))))))
+(defun chess-icc-preoutput-filter (string)
+  (if chess-icc-unprocessed
+      (let ((string (concat chess-icc-unprocessed string)))
+	(if (string-match ")" string)
+	    (let ((newstr (unwind-protect
+			      (chess-icc-datagram-handler
+			       (substring string 0 (match-beginning 0)))
+			    (setq chess-icc-unprocessed nil))))
+	      (chess-icc-preoutput-filter (concat (or newstr "")
+						  (substring string
+							     (match-end 0)))))
+	  (setq chess-icc-unprocessed string)
+	  ""))
+    (if (string-match "(" string)
+	(let ((pre (substring string 0 (match-beginning 0)))
+	      (substr (substring string (match-end 0))))
+	  (if (string-match ")" substr)
+	      (let ((post (substring substr (match-end 0)))
+		    (newstr (chess-icc-datagram-handler
+			     (substring substr 0 (match-beginning 0)))))
+		(chess-icc-preoutput-filter (concat pre newstr post)))
+	    (setq chess-icc-unprocessed substr)
+	    pre))
+      string)))
+
 (defun chess-ics-icc-preoutput-filter (string)
   (while (string-match "(\\([0-9]+\\) \\(.*?\\))" string)
     (let ((dg (string-to-int (match-string 1 string)))