[elpa] 68/255: misc

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 696c58541e342eb008ee6a78ad5b1d8993cbdac0
Author: Eric Schulte <address@hidden>
Date:   Tue May 22 14:35:08 2012 -0400

    misc
---
 sgf-board.el |   70 ++++++++++++++++++++++++++++++++++------------------------
 sgf-util.el  |    8 +++++-
 sgf2el.el    |   26 ++++++++++++---------
 3 files changed, 62 insertions(+), 42 deletions(-)

diff --git a/sgf-board.el b/sgf-board.el
index 10d50a4..c5abaa3 100644
--- a/sgf-board.el
+++ b/sgf-board.el
@@ -105,10 +105,32 @@
     (dolist (piece pieces board)
       (setf (aref board (cdr piece)) (car piece)))))
 
+(defun sgf-board-options ()
+  (let ((count 0))
+    (mapcar (lambda (alt)
+              (prog1 (if (alistp alt)
+                         count
+                       (if (alistp (car alt))
+                           (list count 0)
+                         :other))
+                (incf count)))
+            (sgf-nthcdr *sgf* *index*))))
+
+(defun get-create-pieces ()
+  (let ((pieces (aget (sgf-ref sgf-sgf sgf-index) :pieces)))
+    (if pieces
+        (when (listp pieces) pieces)
+      (clear-labels sgf-board)
+      (apply-moves sgf-board (sgf-ref sgf-sgf sgf-index))
+      (setq pieces (board-to-pieces sgf-board))
+      (push (cons :pieces pieces) (sgf-ref sgf-sgf sgf-index))
+      pieces)))
+
 (defun update-display ()
   (unless sgf-sgf (error "sgf: buffer has not associated sgf data"))
   (delete-region (point-min) (point-max))
   (goto-char (point-min))
+  (setq sgf-board (pieces-to-board (get-create-pieces) (length sgf-board)))
   (insert
    "\n"
    (board-to-string sgf-board)
@@ -139,8 +161,6 @@
                        (error "sgf: game has no associated size"))))
         (when name (rename-buffer name 'unique))
         (set (make-local-variable 'sgf-board) (make-board size))
-        (push (cons :pieces (board-to-pieces sgf-board))
-              (sgf-ref sgf-sgf sgf-index))
         (update-display)))
     (pop-to-buffer buffer)))
 
@@ -148,65 +168,54 @@
   (interactive "f")
   (display-sgf (sgf2el-file-to-el path)))
 
-(defun get-create-pieces ()
-  (if (aget (sgf-ref sgf-sgf sgf-index) :pieces)
-      (setf sgf-board (pieces-to-board
-                     (aget (sgf-ref sgf-sgf sgf-index) :pieces)
-                     (length sgf-board)))
-    (clear-labels sgf-board)
-    (apply-moves sgf-board (sgf-ref sgf-sgf sgf-index))
-    (push (cons :pieces (board-to-pieces sgf-board))
-          (sgf-ref sgf-sgf sgf-index))))
-
 (defun up (&optional num)
   (interactive "p")
   (prog1 (dotimes (n num n)
-           (unless (sgf-ref sgf-sgf sgf-index)
+           (unless (alistp (sgf-ref sgf-sgf sgf-index))
              (update-display)
              (error "sgf: no more upwards moves."))
            (decf (car (last sgf-index 2)))
-           (setq sgf-board (pieces-to-board
-                          (aget (sgf-ref sgf-sgf sgf-index) :pieces)
-                          (length sgf-board))))
-    (update-display)))
+           (update-display))))
 
 (defun down (&optional num)
   (interactive "p")
   (prog1 (dotimes (n num n)
            (incf (car (last sgf-index 2)))
            (setf (car (last sgf-index)) 0)
-           (unless (sgf-ref sgf-sgf sgf-index)
+           (unless (alistp (sgf-ref sgf-sgf sgf-index))
              (update-display)
              (error "sgf: no more downwards moves."))
-           (get-create-pieces))
-    (update-display)))
+           (update-display))))
 
 (defun left (&optional num)
   (interactive "p")
   (prog1 (dotimes (n num n)
-           (unless (sgf-ref sgf-sgf sgf-index)
+           (unless (alistp (sgf-ref sgf-sgf sgf-index))
              (update-display)
              (error "sgf: no more backwards moves."))
            (decf (car (last sgf-index)))
-           (let ((pieces (aget (sgf-ref sgf-sgf sgf-index) :pieces)))
-             (setq sgf-board (pieces-to-board
-                            (if (listp pieces) pieces nil)
-                            (length sgf-board)))))
-    (update-display)))
+           (update-display))))
 
 (defun right (&optional num)
   (interactive "p")
   (prog1 (dotimes (n num n)
            (incf (car (last sgf-index)))
-           (unless (sgf-ref sgf-sgf sgf-index)
+           (unless (alistp (sgf-ref sgf-sgf sgf-index))
              (decf (car (last sgf-index)))
              (update-display)
              (error "sgf: no more forward moves."))
-           (get-create-pieces))
-    (update-display)))
+           (update-display))))
 
 
 ;;; Board manipulation functions
+(defun sgf-nthcdr (sgf index)
+  (let ((part sgf))
+    (while (cdr index)
+      (setq part (nth (car index) part))
+      (setq index (cdr index)))
+    (setq part (nthcdr (car index) part))
+    part))
+
 (defun sgf-ref (sgf index)
   (let ((part sgf))
     (while (car index)
@@ -226,6 +235,9 @@
    ((member (car move) '(:B  :W))  :move)
    ((member (car move) '(:LB :LW)) :label)))
 
+(defun other-color (color)
+  (if (equal color :B) :W :B))
+
 (defun apply-moves (board moves)
   (flet ((bset (val data)
            (let ((data (if (listp (car data)) data (list data))))
diff --git a/sgf-util.el b/sgf-util.el
index 5c86295..a77d4cf 100644
--- a/sgf-util.el
+++ b/sgf-util.el
@@ -40,11 +40,15 @@
       (let ((res (number-sequence a b)))
         (if tmp (nreverse res) res)))))
 
+(defun take (num list) (subseq list 0 num))
+
 (defmacro until (test &rest body)
   (declare (indent 1))
   `(while (not ,test) ,@body))
 
-(defun other-color (color)
-  (if (equal color :B) :W :B))
+(defun alistp (list)
+  (and (listp list)
+       (listp (car list))
+       (not (listp (caar list)))))
 
 (provide 'sgf-util)
diff --git a/sgf2el.el b/sgf2el.el
index 6fcdfb2..be1c685 100644
--- a/sgf2el.el
+++ b/sgf2el.el
@@ -92,11 +92,6 @@
       (when last-node (insert ")")))
     (message "parsing DONE")))
 
-(defmacro sgf2el-set-to-var (var &optional buffer)
-  "Assign the value of the board in BUFFER to VAR."
-  `(let ((buffer ,(or buffer (current-buffer))))
-     (setq ,var (save-excursion (goto-char (point-min)) (read buffer)))))
-
 (defun sgf2el-normalize (&optional buffer)
   "Cleanup the formatting of the elisp sgf data in BUFFER."
   (interactive)
@@ -121,20 +116,29 @@
       (emacs-lisp-mode))
     (pop-to-buffer buffer)))
 
-(defun sgf2el-current-buffer-to-el ()
-  (sgf2el-region (point-min) (point-max))
-  (goto-char (point-min))
-  (read (current-buffer)))
+(defun sgf2el-read (&optional buf)
+  (with-current-buffer (or buf (current-buffer))
+    (goto-char (point-min))
+    (read (current-buffer))))
+
+(defun sgf2el-buffer-to-el (&optional bufffer)
+  "Convert the sgf contents of BUFFER to emacs lisp."
+  (interactive "b")
+  (with-current-buffer (or bufffer (current-buffer))
+    (sgf2el-region (point-min) (point-max))
+    (sgf2el-read)))
 
 (defun sgf2el-str-to-el (str)
   "Convert a string of sgf into the equivalent Emacs Lisp."
-  (with-temp-buffer (insert str) (sgf2el-current-buffer-to-el)))
+  (interactive)
+  (with-temp-buffer (insert str) (sgf2el-buffer-to-el)))
 
 (defun sgf2el-file-to-el (file)
+  "Convert the sgf contents of FILE to emacs lisp."
   (interactive "f")
   (with-temp-buffer
     (insert-file-contents-literally file)
-    (sgf2el-current-buffer-to-el)))
+    (sgf2el-buffer-to-el)))
 
 
 ;;; Specific property converters