diff options
author | Amin Bandali <bandali@gnu.org> | 2020-09-09 23:20:34 -0400 |
---|---|---|
committer | Amin Bandali <bandali@gnu.org> | 2020-09-10 00:19:37 -0400 |
commit | dcab4d0f0c3e480846c4337ff231dc55eb26124f (patch) | |
tree | 93ce6abef96b136410391da1e0044b16aaf8e2e5 /lisp/erc/erc-chess.el | |
parent | 931b9f5953013c1e8844d0c723411b87ccfedb1a (diff) | |
download | emacs-scratch/erc-oldies.tar.gz |
Import erc-bbdb.el, erc-chess.el, erc-nicklist.el, and erc-speak.elscratch/erc-oldies
* lisp/erc/erc-bbdb.el, lisp/erc/erc-chess.el,
lisp/erc/erc-nicklist.el, lisp/erc/erc-speak.el: Import these files
from commit 9497cc92bf1feb63c24425c46b1e033265c2cea9 of
https://git.savannah.gnu.org/cgit/erc.git, the old ERC repository
outside the GNU Emacs source tree. These FSF-copyrighted files were
part of ERC before erc.git was (for the most part) folded into
emacs.git, but they were left out largely due to depending on packages
outside Emacs. It is worth noting that their dependencies are all
free software, and bbdb and chess are actually available on GNU ELPA.
Diffstat (limited to 'lisp/erc/erc-chess.el')
-rw-r--r-- | lisp/erc/erc-chess.el | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/lisp/erc/erc-chess.el b/lisp/erc/erc-chess.el new file mode 100644 index 00000000000..94715439c99 --- /dev/null +++ b/lisp/erc/erc-chess.el @@ -0,0 +1,181 @@ +;;; erc-chess.el --- CTCP chess playing support for ERC + +;; Copyright (C) 2002, 2004, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Mario Lang <mlang@delysid.org> +;; Keywords: games, comm + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This module requires chess.el by John Wiegley. +;; You need to have chess.el installed (load-path properly set) + +;;; Code: + +(require 'erc) +(require 'chess-network) +(require 'chess-display) +(require 'chess) + +;;;; Variables + +(defgroup erc-chess nil + "Playing chess over IRC." + :group 'erc) + +(defcustom erc-chess-verbose-flag nil + "*If non-nil, inform about bogus CTCP CHESS messages in the server buffer." + :group 'erc-chess + :type 'boolean) + +(defcustom erc-chess-debug-flag t + "*If non-nil, print all chess CTCP messages received in the server buffer." + :group 'erc-chess + :type 'boolean) + +;;;###autoload +(defvar erc-ctcp-query-CHESS-hook '(erc-chess-ctcp-query-handler)) + +(defvar erc-chess-alist nil + "Alist of chess sessions. It has the form of (NICK ENGINE)") +(make-variable-buffer-local 'erc-chess-alist) + +(defvar erc-chess-regexp-alist chess-network-regexp-alist) +(defvar erc-chess-partner) +(make-variable-buffer-local 'erc-chess-partner) + +;;;; Catalog messages + +(erc-define-catalog + 'english + '((ctcp-chess-debug . "CTCPchess: %n (%u@%h) sent: '%m'") + (ctcp-chess-quit . "Chess game with %n (%u@%h) quit"))) + + +(defun erc-chess-response-handler (event &rest args) + (when (and (eq event 'accept) + (eq chess-engine-pending-offer 'match)) + (let ((display (chess-game-data (chess-engine-game nil) 'display))) + (chess-display-enable-popup display) + (chess-display-popup display))) + + (apply 'chess-engine-default-handler event args)) + + +(defun erc-chess-handler (game event &rest args) + "Handle erc-chess events. +This is the main handler for the erc-chess module." + (cond + ((eq event 'initialize) + (setq erc-chess-partner (car args)) + (setq erc-server-process (nth 1 args)) + t) + + ((eq event 'send) + ;; Transmit the string given in `(car args)' to the nick + ;; saved in `erc-chess-partner'. + (let ((nick erc-chess-partner) + (msg (substring (car args) 0 (1- (length (car args)))))) + (erc-with-server-buffer + (erc-send-ctcp-message nick (concat "CHESS " msg) t)))) + + (t + (cond + ((eq event 'accept) + (let ((display (chess-game-data (chess-engine-game nil) 'display))) + (chess-display-enable-popup display) + (chess-display-popup display))) + + ((eq event 'destroy) + (let* ((buf (process-buffer erc-server-process)) + (nick (erc-downcase erc-chess-partner)) + (engine (current-buffer))) + (erc-with-server-buffer + (let ((elt (assoc nick erc-chess-alist))) + (when (and elt (eq (nth 1 elt) engine)) + (message "Removed from erc-chess-alist in destroy event") + (setq erc-chess-alist (delq elt erc-chess-alist)))))))) + + ;; Pass all other events down to chess-network + (apply 'chess-network-handler game event args)))) + +;;;; Game initialisation + +(defun erc-chess-engine-create (nick) + "Initialize a game for a particular nick. +This function adds to `erc-chess-alist' too." + ;; Maybe move that into the connect callback? + (let* ((objects (chess-session 'erc-chess t 'erc-chess-response-handler + nick erc-server-process)) + (engine (car objects)) + (display (cadr objects))) + (when engine + (if display + (chess-game-set-data (chess-display-game display) + 'display display)) + (push (list (erc-downcase nick) engine) erc-chess-alist) + engine))) + +;;;; IRC /commands + +;;;###autoload +(defun erc-cmd-CHESS (line &optional force) + "Initiate a chess game via CTCP to NICK. +NICK should be the first and only arg to /chess" + (cond + ((string-match (concat "^\\s-*\\(" erc-valid-nick-regexp "\\)\\s-*$") line) + (let ((nick (match-string 1 line))) + (erc-with-server-buffer + (if (assoc (erc-downcase nick) erc-chess-alist) + ;; Maybe check for correctly connected game, and switch here. + (erc-display-message + nil 'notice 'active + (concat "Invitation for a game already sent to " nick)) + (with-current-buffer (erc-chess-engine-create nick) + (erc-chess-handler nil 'match) + t))))) + (t nil))) + +;;; CTCP handler +;;;###autoload +(defun erc-chess-ctcp-query-handler (proc nick login host to msg) + (if erc-chess-debug-flag + (erc-display-message + nil 'notice (current-buffer) + 'ctcp-chess-debug ?n nick ?m msg ?u login ?h host)) + (when (string-match "^CHESS\\s-+\\(.*\\)$" msg) + (let ((str (concat (match-string 1 msg) "\n")) + (elt (assoc (erc-downcase nick) erc-chess-alist))) + (if (not elt) + (chess-engine-submit (erc-chess-engine-create nick) str) + (if (buffer-live-p (nth 1 elt)) + (chess-engine-submit (nth 1 elt) str) + (setq erc-chess-alist (delq elt erc-chess-alist))))))) + +(provide 'erc-chess) + +;;; erc-chess.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: beb148d1-db16-48da-8145-9f3a7ff27b7b |