[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/gnugo a4dcef8 150/357: [gnugo frolic int] Parameterize,
From: |
Stefan Monnier |
Subject: |
[elpa] externals/gnugo a4dcef8 150/357: [gnugo frolic int] Parameterize, centralize awakening. |
Date: |
Sun, 29 Nov 2020 14:51:10 -0500 (EST) |
branch: externals/gnugo
commit a4dcef8df2b32cec22e6284564fa76d789881682
Author: Thien-Thi Nguyen <ttn@gnu.org>
Commit: Thien-Thi Nguyen <ttn@gnu.org>
[gnugo frolic int] Parameterize, centralize awakening.
* packages/gnugo/gnugo.el (gnugo--awake):
Take arg HOW, a list of forms; vary ‘line’ extraction using HOW;
likewise, conditionally throw "No branch here" user-error.
(gnugo--awakened): Add ‘declare’ form for indentation;
take first arg HOW; pass it quoted to ‘gnugo--awake’.
(gnugo--swiz, gnugo-frolic-prune-branch)
(gnugo-frolic-backward-branch, gnugo-frolic-forward-branch):
Update ‘gnugo--awakened’ call; drop centralized code.
---
gnugo.el | 138 ++++++++++++++++++++++++++++++++++-----------------------------
1 file changed, 74 insertions(+), 64 deletions(-)
diff --git a/gnugo.el b/gnugo.el
index 527e7d5..f1adbd0 100644
--- a/gnugo.el
+++ b/gnugo.el
@@ -957,59 +957,75 @@ are dimmed. Type \\[describe-mode] in that buffer for
details."
(set (make-local-variable 'gnugo-frolic-origin) finish)
(gnugo-frolic-return-to-origin))))
-(defun gnugo--awake ()
+(defun gnugo--awake (how)
+ ;; Valid HOW elements:
+ ;; require-valid-branch
+ ;; (line . numeric)
+ ;; (line . move-string)
+ ;; Invalid elements blissfully ignored. :-D
(let* ((tree (gnugo-get :sgf-gametree))
(ends (gnugo--tree-ends tree))
(width (length ends))
(monkey (gnugo-get :monkey))
- (line (count-lines (point-min) (line-beginning-position)))
- (col (current-column)))
+ (line (case (cdr (assq 'line how))
+ (numeric
+ (count-lines (point-min) (line-beginning-position)))
+ (move-string
+ (save-excursion
+ (when (re-search-backward "^ *[0-9]+ [BW]" nil t)
+ (match-string 0))))
+ (t nil)))
+ (col (current-column))
+ (a (unless (> 10 col)
+ (let ((try (/ (- col 10)
+ 6)))
+ (unless (<= width try)
+ try)))))
+ (when (memq 'require-valid-branch how)
+ (unless a
+ (user-error "No branch here")))
(values tree ends width
monkey (aref monkey 1)
- line col (unless (> 10 col)
- (let ((try (/ (- col 10)
- 6)))
- (unless (<= width try)
- try))))))
+ line col a)))
-(defmacro gnugo--awakened (&rest body)
+(defmacro gnugo--awakened (how &rest body)
+ (declare (indent 1))
`(multiple-value-bind (tree ends width
monkey bidx
line col
a)
- (gnugo--awake)
+ (gnugo--awake ',how)
,@body))
(defsubst gnugo--move-to-bcol (bidx)
(move-to-column (+ 10 (* 6 bidx))))
(defun gnugo--swiz (direction &optional blunt)
- (gnugo--awakened
- (unless a
- (user-error "No branch here"))
- (let* ((b (cond ((numberp blunt)
- (unless (and (< -1 blunt)
- (< blunt width))
- (user-error "No such branch: %s" blunt))
- blunt)
- (t (mod (+ direction a) width))))
- (flit (if blunt (lambda (n)
- (cond ((= n a) b)
- ((= n b) a)
- (t n)))
- (lambda (n)
- (mod (+ direction n) width))))
- (was (copy-sequence ends))
- (new-bidx (funcall flit bidx)))
- (loop for bx below width
- do (aset ends (funcall flit bx)
- (aref was bx)))
- (unless (= new-bidx bidx)
- (aset monkey 1 new-bidx))
- (gnugo-frolic-in-the-leaves)
- (goto-char (point-min))
- (forward-line line)
- (gnugo--move-to-bcol b))))
+ (gnugo--awakened (require-valid-branch
+ (line . numeric))
+ (let* ((b (cond ((numberp blunt)
+ (unless (and (< -1 blunt)
+ (< blunt width))
+ (user-error "No such branch: %s" blunt))
+ blunt)
+ (t (mod (+ direction a) width))))
+ (flit (if blunt (lambda (n)
+ (cond ((= n a) b)
+ ((= n b) a)
+ (t n)))
+ (lambda (n)
+ (mod (+ direction n) width))))
+ (was (copy-sequence ends))
+ (new-bidx (funcall flit bidx)))
+ (loop for bx below width
+ do (aset ends (funcall flit bx)
+ (aref was bx)))
+ (unless (= new-bidx bidx)
+ (aset monkey 1 new-bidx))
+ (gnugo-frolic-in-the-leaves)
+ (goto-char (point-min))
+ (forward-line line)
+ (gnugo--move-to-bcol b))))
(defun gnugo-frolic-exchange-left ()
"Exchange the current branch with the one to its left."
@@ -1042,42 +1058,36 @@ This fails if there is only one branch in the tree.
This fails if the monkey is on the current branch
\(a restriction that will probably be lifted Real Soon Now\)."
(interactive)
- (gnugo--awakened
- (unless a
- (user-error "No branch here"))
- ;; todo: define meaningful eviction semantics; remove restriction
- (when (= a bidx)
- (user-error "Cannot prune with monkey on branch"))
- (when (= 1 width)
- (user-error "Cannot prune last remaining branch"))
- ;; A numeric line number is unreliable; branch points might vanish.
- ;; Hang on to something more useful, instead.
- (setq line (save-excursion
- (when (re-search-backward "^ *[0-9]+ [BW]" nil t)
- (match-string 0))))
- (let* ((new (append ends nil))
- ;; Gratuitous ‘pop’ rv assignment avoids byte-compiler warning.
- (bye (pop (nthcdr a new))))
- (gnugo--set-tree-ends tree (apply 'vector new)))
- (when (< a bidx)
- (aset monkey 1 (decf bidx)))
- (gnugo-frolic-in-the-leaves)
- (when line
- (goto-char (point-min))
- (search-forward line)
- (gnugo--move-to-bcol (min a (- width 2))))))
+ (gnugo--awakened (require-valid-branch
+ (line . move-string))
+ ;; todo: define meaningful eviction semantics; remove restriction
+ (when (= a bidx)
+ (user-error "Cannot prune with monkey on branch"))
+ (when (= 1 width)
+ (user-error "Cannot prune last remaining branch"))
+ (let* ((new (append ends nil))
+ ;; Gratuitous ‘pop’ rv assignment avoids byte-compiler warning.
+ (bye (pop (nthcdr a new))))
+ (gnugo--set-tree-ends tree (apply 'vector new)))
+ (when (< a bidx)
+ (aset monkey 1 (decf bidx)))
+ (gnugo-frolic-in-the-leaves)
+ (when line
+ (goto-char (point-min))
+ (search-forward line)
+ (gnugo--move-to-bcol (min a (- width 2))))))
(defun gnugo-frolic-backward-branch (&optional n)
"Move backward N (default 1) branches."
(interactive "p")
- (gnugo--awakened
- (gnugo--move-to-bcol (mod (- (or a width) n) width))))
+ (gnugo--awakened nil
+ (gnugo--move-to-bcol (mod (- (or a width) n) width))))
(defun gnugo-frolic-forward-branch (&optional n)
"Move forward N (default 1) branches."
(interactive "p")
- (gnugo--awakened
- (gnugo--move-to-bcol (mod (+ (or a -1) n) width))))
+ (gnugo--awakened nil
+ (gnugo--move-to-bcol (mod (+ (or a -1) n) width))))
(defun gnugo-boss-is-near ()
"Do `bury-buffer' until the current one is not a GNU Board."
- [elpa] externals/gnugo 10d29a9 301/357: [gnugo] Only set AP for modified gametrees in the collection., (continued)
- [elpa] externals/gnugo 10d29a9 301/357: [gnugo] Only set AP for modified gametrees in the collection., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo da98bc8 288/357: [gnugo int] Replace COND expression w/ IF., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 26c849f 330/357: [gnugo int] Decruft: Don't declare hook and keymap vars., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo b5b3fd6 337/357: [gnugo int] Reduce ‘setq’ usage., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo c885c9c 020/357: [gnugo int] Avoid variable FORMAT for ‘message’., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo fce1fb0 077/357: [gnugo sgf] Fix bug: Output subtrees correctly., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 5ca7efb 099/357: [gnugo int] Remove redundant game-over condition check., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 7fee3b2 104/357: [gnugo] Move "1 or 2" calculation into ‘gnugo-magic-undo’., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo a86327a 108/357: [gnugo] Add command ‘gnugo-frolic-in-the-leaves’ and keybinding., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo f5fbba3 153/357: [gnugo int] Fix bug: Update local var ‘ends’ when branching., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo a4dcef8 150/357: [gnugo frolic int] Parameterize, centralize awakening.,
Stefan Monnier <=
- [elpa] externals/gnugo 1b69add 160/357: [gnugo int] Decruft: Drop gametree IR element: KIDS, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 891a97a 177/357: [gnugo int] Add abstraction: gnugo--decorate, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 843cd96 163/357: [gnugo frolic int] Add abstraction: gnugo--sideways, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo eb13b8e 180/357: [gnugo] Dropped command: ‘t’ (gnugo-toggle-dead-group), Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 6c7e102 181/357: [gnugo int] Rename :waitingp to :waiting; save color there., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 425731b 196/357: [gnugo int] Add abstraction: gnugo--ERR-wait, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 3f3af4b 208/357: [gnugo int] Remove from ‘gnugo-state’ instead of setting to nil., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo f28d241 223/357: [gnugo int] Decruft: Don't set provisional :last-user-bpos., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 8211cb9 224/357: [gnugo int] Couple :center-position and :SZ jamming., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 536960c 230/357: [gnugo int] Fix bug: On -l/--infile, inhibit first move if game over., Stefan Monnier, 2020/11/29