code.delx.au - gnu-emacs-elpa/blob - chess-module.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Basic module support code underlying all chess.el modules
   4 ;;
   5
   6 (require 'chess-game)
   7
   8 (defvar chess-module-game nil)
   9 (defvar chess-module-event-handler nil)
  10 (defvar chess-module-leader nil)
  11
  12 (make-variable-buffer-local 'chess-module-game)
  13 (make-variable-buffer-local 'chess-module-event-handler)
  14 (make-variable-buffer-local 'chess-module-leader)
  15
  16 (chess-message-catalog 'english
  17   '((no-such-module . "There is no module named '%s'")))
  18
  19 (defmacro chess-with-current-buffer (buffer &rest body)
  20   `(let ((buf ,buffer))
  21      (if buf
  22          (with-current-buffer buf
  23            ,@body)
  24        ,@body)))
  25
  26 (defun chess-module-create (derived game &optional buffer-name
  27                                     &rest ctor-args)
  28   (let* ((name (symbol-name derived))
  29          handler buffer)
  30     (unless (and (require derived nil t)
  31                  (setq handler (intern-soft (concat name "-handler"))))
  32       (chess-error 'no-such-module name))
  33     (with-current-buffer (generate-new-buffer (or buffer-name
  34                                                   (format " *%s*" name)))
  35       (if (not (apply handler game 'initialize ctor-args))
  36           (ignore
  37            (kill-buffer (current-buffer)))
  38         (add-hook 'kill-buffer-hook 'chess-module-destroy nil t)
  39         (setq chess-module-event-handler handler)
  40         (chess-module-set-game* nil game)
  41         (current-buffer)))))
  42
  43 (defun chess-module-game (module)
  44   (chess-with-current-buffer module
  45     chess-module-game))
  46
  47 (defun chess-module-game-index (module)
  48   (chess-with-current-buffer module
  49     (chess-game-index chess-module-game)))
  50
  51 (defun chess-module-detach-game (module)
  52   (chess-with-current-buffer module
  53     (chess-game-remove-hook chess-module-game
  54                             'chess-module-event-handler
  55                             (or module (current-buffer)))
  56     ;; if we are the leader, shutdown the game we were attached to
  57     ;; previously
  58     (if chess-module-leader
  59         (chess-game-run-hooks chess-module-game 'destroy))))
  60
  61 (defun chess-module-set-game (module game &optional no-setup)
  62   (chess-with-current-buffer module
  63     (let ((chess-game-inhibit-events no-setup))
  64       (chess-game-copy-game chess-module-game game))))
  65
  66 (defun chess-module-set-game* (module game)
  67   (chess-with-current-buffer module
  68     (assert game)
  69     (if chess-module-game
  70         (chess-module-detach-game nil))
  71     (setq chess-module-game game)
  72     (chess-game-add-hook game 'chess-module-event-handler
  73                          (or module (current-buffer)))))
  74
  75 (defsubst chess-module-leader-p (module)
  76   (chess-with-current-buffer module
  77     chess-module-leader))
  78
  79 (defsubst chess-module-set-leader (module)
  80   (chess-with-current-buffer module
  81     (setq chess-module-leader t)))
  82
  83 (defsubst chess-module-clear-leader (module)
  84   (chess-with-current-buffer module
  85     (setq chess-module-leader nil)))
  86
  87 (defun chess-module-destroy (&optional module)
  88   (let ((buf (or module (current-buffer))))
  89     (when (buffer-live-p buf)
  90       (with-current-buffer buf
  91         (remove-hook 'kill-buffer-hook 'chess-module-destroy t))
  92       (chess-module-detach-game nil)
  93       (kill-buffer buf))))
  94
  95 (defun chess-module-event-handler (game object event &rest args)
  96   (with-current-buffer object
  97     (apply chess-module-event-handler game event args)
  98     (if (eq event 'destroy)
  99         (chess-module-destroy nil))))
 100
 101 (provide 'chess-module)
 102
 103 ;;; chess-module.el ends here