diff options
| -rw-r--r-- | chess-ics.el | 142 |
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))) |