diff options
| -rw-r--r-- | chess-database.el | 78 | ||||
| -rw-r--r-- | chess-engine.el | 2 | ||||
| -rw-r--r-- | chess-file.el | 69 | ||||
| -rw-r--r-- | chess-pgn.el | 9 | ||||
| -rw-r--r-- | chess-scid.el | 77 |
5 files changed, 230 insertions, 5 deletions
diff --git a/chess-database.el b/chess-database.el new file mode 100644 index 0000000..b3aefc0 --- /dev/null +++ b/chess-database.el @@ -0,0 +1,78 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Basic code for manipulating game databases +;; +;; $Revision$ + +(defvar chess-database-event-handler nil) + +(make-variable-buffer-local 'chess-database-event-handler) + +(defmacro chess-with-current-buffer (buffer &rest body) + `(let ((buf ,buffer)) + (if buf + (with-current-buffer buf + ,@body) + ,@body))) + +(chess-message-catalog 'english + '((no-such-style . "There is no such chess database module '%s'"))) + +(defun chess-database-open (module file) + "Returns the opened database object, or nil." + (let* ((name (symbol-name module)) + (handler (intern-soft (concat name "-handler"))) + buffer) + (unless handler + (chess-error 'no-such-database name)) + (when (setq buffer (funcall handler 'open file)) + (with-current-buffer buffer + (setq chess-database-event-handler handler) + (add-hook 'kill-buffer-hook 'chess-database-close nil t) + (add-hook 'after-revert-hook 'chess-database-rescan nil t) + (current-buffer))))) + +(defsubst chess-database-command (database event &rest args) + (chess-with-current-buffer database + (apply 'chess-database-event-handler nil (current-buffer) + event args))) + +(defun chess-database-close (database) + (let ((buf (or database (current-buffer)))) + (when (buffer-live-p buf) + (chess-database-command buf 'save) + (chess-database-command buf 'close) + (with-current-buffer buf + (remove-hook 'kill-buffer-hook 'chess-database-quit t)) + (kill-buffer buf)))) + +(defun chess-database-save (database) + (chess-database-command database 'save)) + +(defun chess-database-rescan (&optional database) + (chess-database-command database 'rescan)) + +(defun chess-database-count (database) + (chess-database-command database 'count)) + +(defun chess-database-read (database index) + (chess-database-command database 'read index)) + +(defun chess-database-write (database game) + (chess-database-command database 'write game)) + +(defun chess-database-replace (database game &optional index) + (chess-database-command database 'replace game index)) + +(defun chess-database-query (database &rest terms) + (chess-database-command database 'query terms)) + +(defun chess-database-event-handler (game database event &rest args) + (if (eq event 'shutdown) + (chess-database-close database) + (chess-with-current-buffer database + (apply chess-database-event-handler event args)))) + +(provide 'chess-database) + +;;; chess-database.el ends here diff --git a/chess-engine.el b/chess-engine.el index d8299fa..d23778d 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -287,7 +287,7 @@ (defun chess-engine-destroy (engine) (let ((buf (or engine (current-buffer)))) (when (buffer-live-p buf) - (chess-engine-command engine 'destroy) + (chess-engine-command buf 'destroy) (with-current-buffer buf (remove-hook 'kill-buffer-hook 'chess-engine-on-kill t)) (kill-buffer buf)))) diff --git a/chess-file.el b/chess-file.el new file mode 100644 index 0000000..9667c06 --- /dev/null +++ b/chess-file.el @@ -0,0 +1,69 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; A game database that stores PGN format games in a single file. +;; +;; This is basically what you expect from a file ending in .pgn. +;; +;; $Revision$ + +(defvar chess-file-locations) + +(make-variable-buffer-local 'chess-file-locations) + +(defun chess-file-handler (event &rest args) + (cond + ((eq event 'open) + (with-current-buffer (find-file-noselect (car args)) + (chess-file-handler 'rescan) + (current-buffer))) + + ((eq event 'rescan) + (goto-char (point-min)) + (setq chess-file-locations nil) + (while (search-forward "[Event" nil t) + (goto-char (match-beginning 0)) + (push (point) chess-file-locations)) + (setq chess-file-locations (nreverse chess-file-locations))) + + ((eq event 'save) + (save-buffer)) + + ((eq event 'count) + (length chess-file-locations)) + + ((eq event 'read) + (let ((index (car args)) game) + (when (and (>= index 0) + (< index (chess-file-handler 'count))) + (goto-char (nth index chess-file-locations)) + (when (setq game (chess-pgn-to-game)) + (chess-game-set-data game 'database (current-buffer)) + (chess-game-set-data game 'database-index index) + (chess-game-set-data game 'database-count + (chess-file-handler 'count)))))) + + ((eq event 'write) + (goto-char (point-max)) + (while (memq (char-before) '(? ?\t ?\n ?\r)) + (delete-backward-char 1)) + (insert ?\n ?\n) + (push (point) chess-file-locations) + (chess-game-to-pgn (car args)) + (1- (chess-file-handler 'count))) + + ((eq event 'replace) + (let ((index (or (cadr args) + (chess-game-data (car args) 'database-index))) + (count (chess-file-handler 'count))) + (when (and (>= index 0) + (< index count)) + (goto-char (nth index chess-file-locations)) + (delete-region (point) (if (= (1+ index) count) + (point-max) + (nth (1+ index) chess-file-locations))) + (chess-game-to-pgn (car args)) + (insert ?\n)))))) + +(provide 'chess-file) + +;;; chess-file.el ends here diff --git a/chess-pgn.el b/chess-pgn.el index 67ec901..230dc18 100644 --- a/chess-pgn.el +++ b/chess-pgn.el @@ -66,11 +66,12 @@ (chess-parse-pgn))) (defun chess-parse-pgn () - (when (search-forward "[" nil t) + (when (or (looking-at "\\[") + (and (search-forward "[" nil t) + (goto-char (match-beginning 0)))) (let ((game (chess-game-create))) - (setcar game nil) - (backward-char) - (while (looking-at "^\\s-*\\[\\(\\S-+\\)\\s-+\\(\".+?\"\\)\\][ \t\n]+") + (chess-game-set-tags game nil) + (while (looking-at "\\[\\(\\S-+\\)\\s-+\\(\".+?\"\\)\\][ \t\n]+") (chess-game-set-tag game (match-string-no-properties 1) (read (match-string-no-properties 2))) (goto-char (match-end 0))) diff --git a/chess-scid.el b/chess-scid.el new file mode 100644 index 0000000..965673c --- /dev/null +++ b/chess-scid.el @@ -0,0 +1,77 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; A game database that uses SCID for storage/retrieval +;; +;; The advantage is that it's much faster than PGN, and far, far more +;; compact. +;; +;; $Revision$ + +(defvar chess-scid-process) + +(make-variable-buffer-local 'chess-scid-process) + +(defun chess-scid-get-result (command) + (let ((here (point-max))) + (process-send-string chess-scid-process command) + (accept-process-output chess-scid-process) + (goto-char (point-max)) + (while (memq (char-before) '(? ?\t ?\n ?\r ?\%)) + (backward-char 1)) + (buffer-substring here (point)))) + +(defun chess-scid-handler (event &rest args) + (cond + ((eq event 'open) + (let* ((buffer (generate-new-buffer " *chess-scid*")) + (proc (start-process "*chess-scid*" buffer + (executable-find "tcscid")))) + (if (and proc (eq (process-status proc) 'run)) + (with-current-buffer buffer + (accept-process-output proc) + (setq chess-scid-process proc) + (if (= 1 (string-to-int + (chess-scid-get-result + (format "sc_base open %s\n" + (expand-file-name (car args)))))) + buffer + (kill-process proc) + (kill-buffer buffer) + nil)) + (kill-buffer buffer) + nil))) + + ((eq event 'close) + (process-send-string chess-scid-process "sc_base close\nexit\n")) + + ((eq event 'count) + (string-to-int (chess-scid-get-result "sc_base numGames\n"))) + + ((eq event 'read) + (let ((here (point-max))) + (process-send-string chess-scid-process + (format "sc_game load %d\nsc_game pgn\n" + (car args))) + (accept-process-output chess-scid-process) + (goto-char here) + (when (setq game (chess-pgn-to-game)) + (chess-game-set-data game 'database (current-buffer)) + (chess-game-set-data game 'database-index index) + (chess-game-set-data game 'database-count + (chess-scid-handler 'count)) + game))) + + ((eq event 'write) + (chess-scid-handler 'replace 0 (car args))) + + ((eq event 'replace) + (let ((index (or (cadr args) + (chess-game-data (car args) 'database-index)))) + (process-send-string chess-scid-process + (format "sc_game import \"%s\"\n" + (chess-game-to-string (cadr args)))) + (process-send-string chess-scid-process "sc_game save %d\n" index))))) + +(provide 'chess-scid) + +;;; chess-scid.el ends here |