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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; A special kind of display that merely autosaves the game
   4 ;;
   5
   6 (require 'chess-game)
   7 (require 'chess-database)
   8
   9 (defgroup chess-autosave nil
  10   "A special display that autosaves after each move."
  11   :group 'chess-display)
  12
  13 (defcustom chess-autosave-file "~/.chess-save"
  14   "Filename in which to autosave chess games."
  15   :type '(choice file (const :tag "Do not auto-save" nil))
  16   :group 'chess-autosave)
  17
  18 (defcustom chess-autosave-database nil
  19   "If non-nil, a chess database file in which completed games are appended.
  20 If a function, it will receive a game object and is expected to do the
  21 work of saving the game object to whichever database(s) it chooses.
  22 Whether it closes those databases or caches them for later use is up
  23 to the user."
  24   :type '(choice (const :tag "Do not save completed games" nil)
  25                  file function)
  26   :group 'chess-autosave)
  27
  28 (chess-message-catalog 'english
  29   '((chess-read-autosave    . "There is a chess autosave file, read it? ")
  30     (chess-delete-autosave  . "Delete the autosave file? ")
  31     (chess-disable-autosave . "Disable autosaving for this game? ")
  32     (autosave-available     . "There is an autosave file; type ~ after connecting to read it")))
  33
  34 (defun chess-autosave-handler (game event &rest args)
  35   (cond
  36    ((eq event 'initialize)
  37     (kill-buffer (current-buffer))
  38     (set-buffer (find-file-noselect chess-autosave-file t))
  39     (buffer-disable-undo)
  40     (setq buffer-auto-save-file-name nil)
  41     t)
  42
  43    ((eq event 'check-autosave)
  44     (if (file-readable-p chess-autosave-file)
  45         (if (y-or-n-p (chess-string 'chess-read-autosave))
  46             (progn
  47               (chess-autosave-read game chess-autosave-file)
  48               (erase-buffer))
  49           (if (y-or-n-p (chess-string 'chess-delete-autosave))
  50               (erase-buffer)
  51             (if (y-or-n-p (chess-string 'chess-disable-autosave))
  52                 (chess-autosave-handler game 'disable-autosave))))))
  53
  54    ((eq event 'announce-autosave)
  55     (if (file-readable-p chess-autosave-file)
  56         (chess-message 'autosave-available)))
  57
  58    ((eq event 'disable-autosave)
  59     (chess-autosave-handler game 'destroy)
  60     (chess-module-destroy (current-buffer)))
  61
  62    ((eq event 'post-move)
  63     (if (not (chess-game-over-p game))
  64         (chess-autosave-write game chess-autosave-file)
  65       (erase-buffer)
  66       (if chess-autosave-database
  67           (if (functionp chess-autosave-database)
  68               (funcall chess-autosave-database game)
  69             (let ((database (chess-database-open chess-autosave-database)))
  70               (when database
  71                 (chess-database-write database game)
  72                 (chess-database-close database)))))))
  73
  74    ((eq event 'destroy)
  75     (set-buffer-modified-p nil)
  76     (if (file-exists-p chess-autosave-file)
  77         (delete-file chess-autosave-file)))))
  78
  79 (defun chess-prin1-ply (ply)
  80   (insert "([")
  81   (let ((pos (chess-ply-pos ply)))
  82     (dotimes (i 74)
  83       (prin1 (aref pos i) (current-buffer))
  84       (insert ? )))
  85   (insert "nil]")
  86   (let ((changes (chess-ply-changes ply)))
  87     (if changes
  88         (insert ? ))
  89     (while changes
  90       (if (eq (car changes) :next-pos)
  91           (setq changes (cddr changes))
  92         (prin1 (car changes) (current-buffer))
  93         (if (cdr changes)
  94             (insert ? ))
  95         (setq changes (cdr changes)))))
  96   (insert ")"))
  97
  98 (defun chess-autosave-write (game file)
  99   "Write a chess GAME to FILE as raw Lisp."
 100   (let ((index (chess-game-index game)))
 101     (if (or (= 1 index) (and (bobp) (eobp)))
 102         (progn
 103           (erase-buffer)
 104           (prin1 (chess-game-tags game)
 105                  (current-buffer))
 106           (insert "\n(\n;;## ply 0\n"))
 107       (goto-char (point-max))
 108       (re-search-backward "^;;## ply")
 109       (forward-line)
 110       (delete-region (point) (point-max)))
 111     (chess-prin1-ply (chess-game-ply game (1- index)))
 112     (insert (format "\n;;## ply %d\n" index))
 113     (chess-prin1-ply (chess-game-ply game))
 114     (insert ")\n")
 115     (basic-save-buffer)
 116     (message nil)))
 117
 118 (defun chess-autosave-read (game file)
 119   "Read a chess game as raw Lisp from FILE."
 120   (goto-char (point-min))
 121   (chess-game-set-tags game (read (current-buffer)))
 122   (let* ((plies (read (current-buffer)))
 123          (game-plies plies)
 124          prev-ply)
 125     (while plies
 126       (if prev-ply
 127           (chess-pos-set-preceding-ply (chess-ply-pos (car plies))
 128                                        prev-ply))
 129       (if (cdr plies)
 130           (chess-ply-set-keyword (car plies) :next-pos
 131                                  (chess-ply-pos (cadr plies))))
 132       (setq prev-ply (car plies)
 133             plies (cdr plies)))
 134
 135     (chess-game-set-plies game game-plies)))
 136
 137 (provide 'chess-autosave)
 138
 139 ;;; chess-autosave.el ends here