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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; A game database that stores PGN format games or EPD format positions in
   4 ;; a single file.
   5 ;;
   6 ;; This is basically what you expect from a file ending in .pgn or .epd.
   7 ;;
   8
   9 (defvar chess-file-locations nil
  10   "A list of starting positions of individual records of this collection.")
  11 (make-variable-buffer-local 'chess-file-locations)
  12
  13 (defvar chess-file-type nil
  14   "The file format type of this database instance (a symbol).
  15 See `chess-file-types' for details.")
  16 (make-variable-buffer-local 'chess-file-type)
  17
  18 (defvar chess-file-types
  19   `((pgn "^\\[Event " chess-pgn-to-game chess-game-to-pgn (?\n ?\n))
  20     (epd ,(concat chess-fen-regexp "\\(\\s-+.+\\);\\s-*$")
  21          chess-epd-to-game chess-game-to-epd (?\n)))
  22   "Alist of different file types.
  23 Entries have the form (TYPE BEGIN-REGEXP TO-GAME FROM-GAME SEPARATOR)
  24 where TYPE is a symbol (usually either 'pgn or 'epd),
  25 BEGIN-REGEXP is the regexp to use for matching the beginning of new records,
  26 TO-GAME and FROM-GAME are functions to use for reading and writing a game
  27 object from/into the buffer and SEPARATOR is a list of characters to insert
  28 inbetween of individual records.")
  29
  30 (defun chess-file-handler (event &rest args)
  31   "Event handler for file database objects."
  32   (cond
  33    ((eq event 'open)
  34     (with-current-buffer (find-file-noselect (car args))
  35       (when (setq chess-file-type
  36                   (cond
  37                    ((or (string-match "\\.pgn\\'" (car args))
  38                         (save-excursion (re-search-forward "^\\[Event" nil t)))
  39                     'pgn)
  40                    ((string-match "\\.epd\\'" (car args))
  41                     'epd)))
  42         (chess-file-handler 'rescan)
  43         (current-buffer))))
  44
  45    ((eq event 'rescan)
  46     (save-excursion
  47       (goto-char (point-min))
  48       (setq chess-file-locations nil)
  49       (while (re-search-forward (nth 1 (assq chess-file-type chess-file-types))
  50                                 nil t)
  51         (goto-char (match-beginning 0))
  52         (push (point) chess-file-locations)
  53         (forward-char 1))
  54       (setq chess-file-locations (nreverse chess-file-locations))))
  55
  56    ((eq event 'read-only-p)
  57     buffer-read-only)
  58
  59    ((eq event 'filename)
  60     buffer-file-name)
  61
  62    ((eq event 'save)
  63     (save-buffer))
  64
  65    ((eq event 'count)
  66     (length chess-file-locations))
  67
  68    ((eq event 'read)
  69     (let ((index (car args)) game)
  70       (when (and (>= index 0)
  71                  (< index (chess-file-handler 'count)))
  72         (goto-char (nth index chess-file-locations))
  73         (when (setq game (funcall (nth 2 (assq chess-file-type
  74                                                chess-file-types))))
  75           (chess-game-set-data game 'database (current-buffer))
  76           (chess-game-set-data game 'database-index index)
  77           (chess-game-set-data game 'database-count
  78                                (chess-file-handler 'count))
  79           game))))
  80
  81    ((eq event 'write)
  82     (goto-char (point-max))
  83     (while (memq (char-before) '(?  ?\t ?\n ?\r))
  84       (delete-backward-char 1))
  85     (apply 'insert (nth 4 (assq chess-file-type chess-file-types)))
  86     (push (point) chess-file-locations)
  87     (funcall (nth 3 (assq chess-file-type chess-file-types)) (car args))
  88     (1- (chess-file-handler 'count)))
  89
  90    ((eq event 'replace)
  91     (let ((index (or (cadr args)
  92                      (chess-game-data (car args) 'database-index)))
  93           (count (chess-file-handler 'count)))
  94       (when (and (>= index 0)
  95                  (< index count))
  96         (goto-char (nth index chess-file-locations))
  97         (delete-region (point) (if (= (1+ index) count)
  98                                    (point-max)
  99                                  (nth (1+ index) chess-file-locations)))
 100         (funcall (nth 3 (assq chess-file-type chess-file-types)) (car args))
 101         (when (eq chess-file-type 'pgn) (insert ?\n)))))))
 102
 103 (provide 'chess-file)
 104
 105 ;;; chess-file.el ends here