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

   1 ;;; chess-autosave.el --- A special kind of display that merely autosaves the game
   2 ;;
   3 ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6 ;; Maintainer: Mario Lang <mlang@delysid.org>
   7 ;; Keywords: games
   8
   9 ;; This is free software; you can redistribute it and/or modify it under
  10 ;; the terms of the GNU General Public License as published by the Free
  11 ;; Software Foundation; either version 3, or (at your option) any later
  12 ;; version.
  13 ;;
  14 ;; This is distributed in the hope that it will be useful, but WITHOUT
  15 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 ;; for more details.
  18 ;;
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Code:
  23
  24 (require 'chess-game)
  25 (require 'chess-database)
  26 (require 'chess-message)
  27 (require 'chess-module)
  28
  29 (defgroup chess-autosave nil
  30   "A special display that autosaves after each move."
  31   :group 'chess-display)
  32
  33 (defcustom chess-autosave-file "~/.chess-save"
  34   "Filename in which to autosave chess games."
  35   :type '(choice file (const :tag "Do not auto-save" nil))
  36   :group 'chess-autosave)
  37
  38 (defcustom chess-autosave-database nil
  39   "If non-nil, a chess database file in which completed games are appended.
  40 If a function, it will receive a game object and is expected to do the
  41 work of saving the game object to whichever database(s) it chooses.
  42 Whether it closes those databases or caches them for later use is up
  43 to the user."
  44   :type '(choice (const :tag "Do not save completed games" nil)
  45                  file function)
  46   :group 'chess-autosave)
  47
  48 (chess-message-catalog 'english
  49   '((chess-read-autosave    . "There is a chess autosave file, read it? ")
  50     (chess-delete-autosave  . "Delete the autosave file? ")
  51     (chess-disable-autosave . "Disable autosaving for this game? ")
  52     (autosave-available     . "There is an autosave file; type ~ after connecting to read it")))
  53
  54 (defun chess-autosave-handler (game event &rest args)
  55   (cond
  56    ((eq event 'initialize)
  57     (kill-buffer (current-buffer))
  58     (set-buffer (find-file-noselect chess-autosave-file t))
  59     (buffer-disable-undo)
  60     (setq buffer-auto-save-file-name nil)
  61     t)
  62
  63    ((eq event 'check-autosave)
  64     (if (file-readable-p chess-autosave-file)
  65         (if (y-or-n-p (chess-string 'chess-read-autosave))
  66             (progn
  67               (chess-autosave-read game chess-autosave-file)
  68               (erase-buffer))
  69           (if (y-or-n-p (chess-string 'chess-delete-autosave))
  70               (erase-buffer)
  71             (if (y-or-n-p (chess-string 'chess-disable-autosave))
  72                 (chess-autosave-handler game 'disable-autosave))))))
  73
  74    ((eq event 'announce-autosave)
  75     (if (file-readable-p chess-autosave-file)
  76         (chess-message 'autosave-available)))
  77
  78    ((eq event 'disable-autosave)
  79     (chess-autosave-handler game 'destroy)
  80     (chess-module-destroy (current-buffer)))
  81
  82    ((eq event 'post-move)
  83     (if (not (chess-game-over-p game))
  84         (chess-autosave-write game chess-autosave-file)
  85       (erase-buffer)
  86       (if chess-autosave-database
  87           (if (functionp chess-autosave-database)
  88               (funcall chess-autosave-database game)
  89             (let ((database (chess-database-open chess-autosave-database)))
  90               (when database
  91                 (chess-database-write database game)
  92                 (chess-database-close database)))))))
  93
  94    ((eq event 'destroy)
  95     (set-buffer-modified-p nil)
  96     (if (file-exists-p chess-autosave-file)
  97         (delete-file chess-autosave-file)))))
  98
  99 (defun chess-prin1-ply (ply)
 100   (insert "([")
 101   (let ((pos (chess-ply-pos ply)))
 102     (dotimes (i 74)
 103       (prin1 (aref pos i) (current-buffer))
 104       (insert ? )))
 105   (insert "nil]")
 106   (let ((changes (chess-ply-changes ply)))
 107     (if changes
 108         (insert ? ))
 109     (while changes
 110       (if (eq (car changes) :next-pos)
 111           (setq changes (cddr changes))
 112         (prin1 (car changes) (current-buffer))
 113         (if (cdr changes)
 114             (insert ? ))
 115         (setq changes (cdr changes)))))
 116   (insert ")"))
 117
 118 (defun chess-autosave-write (game file)
 119   "Write a chess GAME to FILE as raw Lisp."
 120   (let ((index (chess-game-index game)))
 121     (if (or (= 1 index) (and (bobp) (eobp)))
 122         (progn
 123           (erase-buffer)
 124           (prin1 (chess-game-tags game)
 125                  (current-buffer))
 126           (insert "\n(\n;;## ply 0\n"))
 127       (goto-char (point-max))
 128       (re-search-backward "^;;## ply")
 129       (forward-line)
 130       (delete-region (point) (point-max)))
 131     (chess-prin1-ply (chess-game-ply game (1- index)))
 132     (insert (format "\n;;## ply %d\n" index))
 133     (chess-prin1-ply (chess-game-ply game))
 134     (insert ")\n")
 135     (basic-save-buffer)
 136     (message nil)))
 137
 138 (defun chess-autosave-read (game file)
 139   "Read a chess game as raw Lisp from FILE."
 140   (goto-char (point-min))
 141   (chess-game-set-tags game (read (current-buffer)))
 142   (let* ((plies (read (current-buffer)))
 143          (game-plies plies)
 144          prev-ply)
 145     (while plies
 146       (if prev-ply
 147           (chess-pos-set-preceding-ply (chess-ply-pos (car plies))
 148                                        prev-ply))
 149       (if (cdr plies)
 150           (chess-ply-set-keyword (car plies) :next-pos
 151                                  (chess-ply-pos (cadr plies))))
 152       (setq prev-ply (car plies)
 153             plies (cdr plies)))
 154
 155     (chess-game-set-plies game game-plies)))
 156
 157 (provide 'chess-autosave)
 158
 159 ;;; chess-autosave.el ends here