1 files changed, 111 insertions, 0 deletions
diff --git a/chess-pgn.el b/chess-pgn.el
new file mode 100644
index 0000000..56fab5a
--- /dev/null
+++ b/chess-pgn.el
@@ -0,0 +1,111 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Convert a chess game to/from PGN notation
+;;
+;; $Revision$
+
+(require 'chess-game)
+(require 'chess-algebraic)
+
+(defun chess-pgn-read-plies (position &optional top-level)
+  (let ((plies (list t)) prevpos done)
+    (while (not (or done (eobp)))
+      (cond
+       ((looking-at "[1-9][0-9]*\\.[. ]*")
+	(goto-char (match-end 0)))
+       ((looking-at chess-algebraic-regexp)
+	(goto-char (match-end 0))
+	(setq prevpos position)
+	(let ((ply (chess-algebraic-to-ply position (match-string 0))))
+	  (setq position (chess-ply-next-pos ply))
+	  (nconc plies (list ply))))
+       ((and top-level
+	     (looking-at "\\(\\*\\|1-0\\|0-1\\|1/2-1/2\\)"))
+	(goto-char (match-end 0))
+	(chess-game-set-tag game "Result" (match-string-no-properties 0))
+	(setq done t))
+       ((looking-at "{")
+	(forward-char)
+	(let ((begin (point)))
+	  (search-forward "}")
+	  (forward-char)
+	  (chess-pos-add-annotation prevpos (buffer-substring-no-properties
+					     begin (- (point) 2)))))
+       ((looking-at "(")
+	(forward-char)
+	(skip-chars-forward " \t\n")
+	(chess-pos-add-annotation prevpos (chess-pgn-read-plies
+					   (chess-pos-copy prevpos))))
+       ((and (not top-level)
+	     (looking-at ")"))
+	(forward-char)
+	(setq done t))
+       (t (error "Error parsing PGN syntax")))
+      (skip-chars-forward " \t\n"))
+    (cdr plies)))
+
+(defun chess-pgn-to-game ()
+  "Convert PGN notation at point into a chess game."
+  (when (search-forward "[" nil t)
+    (let ((game (chess-game-create)))
+      (setcar game nil)
+      (backward-char)
+      (while (looking-at "^\\s-*\\[\\(\\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)))
+      (let ((fen (chess-game-tag game "FEN")))
+	(chess-game-set-plies
+	 game (chess-pgn-read-plies
+	       (if fen
+		   (chess-fen-to-position fen)
+		 (chess-pos-copy chess-starting-position)) t)))
+      game)))
+
+(defun chess-pgn-insert-annotations (ply)
+  (dolist (ann (chess-pos-annotations (chess-ply-pos ply)))
+    (if (stringp ann)
+	(insert (format " {%s}" ann))
+      (assert (listp ann))
+      (chess-pgn-insert-plies index ann))))
+
+(defun chess-pgn-insert-plies (index plies &optional for-black indented)
+  "NYI: Still have to implement INDENTED argument."
+  (while plies
+    (unless for-black
+      (insert (format "%d. %s" index
+		      (chess-ply-to-algebraic (car plies))))
+      (chess-pgn-insert-annotations (car plies)) 
+      (setq plies (cdr plies) index (1+ index)))
+    (when plies
+      (when for-black
+	(insert (format "%d. ..." index))
+	(setq for-black nil))
+      (insert (format " %s" (chess-ply-to-algebraic (car plies))))
+      (chess-pgn-insert-annotations (car plies)) 
+      (setq plies (cdr plies)))
+    (if plies
+	(insert ? ))))
+
+(defun chess-game-to-pgn (game &optional indented)
+  "Convert a chess GAME to PGN notation.
+If INDENTED is non-nil, indent the move texts."
+  (let ((fen (chess-game-tag game "FEN"))
+	(first-pos (chess-ply-pos (chess-game-ply game 0))))
+    (when (and fen (not (equal fen (chess-pos-to-fen first-pos))))
+      (chess-game-del-tag game "FEN")
+      (setq fen nil))
+    (if (and (not fen)
+	     (not (equal chess-starting-position first-pos)))
+	(chess-game-set-tag game "FEN" (chess-pos-to-fen first-pos))))
+  (dolist (tag (chess-game-tags game))
+    (insert (format "[%s \"%s\"]\n" (car tag) (cdr tag))))
+  (insert ?\n)
+  (let ((begin (point)))
+    (chess-pgn-insert-plies 1 (chess-game-plies game))
+    (insert (or (chess-game-tag game "Result") "*") ?\n)
+    (fill-region begin (point))))
+
+(provide 'chess-pgn)
+
+;;; chess-pgn.el ends here