diff --git a/elpa/gnugo-3.0.0/.dir-locals.el b/elpa/gnugo-3.0.0/.dir-locals.el new file mode 100644 index 0000000..8941f58 --- /dev/null +++ b/elpa/gnugo-3.0.0/.dir-locals.el @@ -0,0 +1,5 @@ +;;; .dir-locals.el + +((emacs-lisp-mode . ((indent-tabs-mode . nil)))) + +;;; .dir-locals.el ends here diff --git a/elpa/gnugo-3.0.0/ChangeLog b/elpa/gnugo-3.0.0/ChangeLog new file mode 100644 index 0000000..ea04cc0 --- /dev/null +++ b/elpa/gnugo-3.0.0/ChangeLog @@ -0,0 +1,2486 @@ +2014-07-22 Thien-Thi Nguyen + + [gnugo] Release: 3.0.0 + + * packages/gnugo/gnugo.el [Version]: Bump to "3.0.0". + (gnugo-version): Bump to "3.0.0". + +2014-07-22 Thien-Thi Nguyen + + [gnugo maint] Add ‘URL’ header; trim Hacking URL; drop Tip Jar URL. + +2014-07-21 Thien-Thi Nguyen + + [gnugo maint] Update HACKING; nfc. + +2014-07-21 Thien-Thi Nguyen + + [gnugo int] Use idiomatic ‘re-search-forward’ BOUND. + + * packages/gnugo/gnugo.el (gnugo-describe-internal-properties) + (:gnugo-gtp-command-spec help): Specify ‘nil’ for for re-search-forward + 2nd arg instead of ‘(point-max)’. + +2014-06-16 Thien-Thi Nguyen + + [gnugo int] Use "%F" and "%T". + + * packages/gnugo/gnugo.el + (gnugo-display-final-score, gnugo) ...here, in ‘format-time-string’ + calls, instead of the more verbose "%Y-%m-%d" and "%H:%M:%S", + respectively. + +2014-06-11 Thien-Thi Nguyen + + [gnugo int] Expose function to byte-compiler. + + * packages/gnugo/gnugo.el (gnugo-toggle-image-display): + ...here, as part of :highlight-last-move-spec toggling. + +2014-05-28 Thien-Thi Nguyen + + [gnugo int] Bump required ‘xpm’ version to "1.0.1". + + Version 1.0.0 works from repo, but not w/ the package system. + + * packages/gnugo/gnugo.el [Package-Requires]: ...here. + +2014-05-27 Thien-Thi Nguyen + + [gnugo] Only set AP for modified gametrees in the collection. + + * packages/gnugo/gnugo.el (gnugo-write-sgf-file): Set root node + property :AP here, but only if buffer-modified. + (gnugo, gnugo/sgf-write-file): Don't set root node property :AP. + +2014-05-27 Thien-Thi Nguyen + + [gnugo int] Whitespace, comment munging; nfc. + +2014-05-26 Stefan Monnier + + * packages/gnugo: Add `cl-lib' as dependency; require it and use its + names. Don't bother with lexical-let since we use lexical-binding. + * packages/gnugo/gnugo.el (gnugo-board-mode-map): + * packages/gnugo/gnugo-frolic.el (gnugo-frolic-mode-map): Move + initialization into declaration. + +2014-05-23 Thien-Thi Nguyen + + [gnugo int] Fix up gnugo-frolic.el ‘require’ forms. + + * packages/gnugo/gnugo.el: Move ‘(require 'ascii-art-to-unicode)’ from + here... + * packages/gnugo/gnugo-frolic.el: ...to here. Also, require ‘gnugo’. + +2014-05-22 Thien-Thi Nguyen + + [gnugo maint] Add some headers to gnugo-frolic.el; nfc. + +2014-05-22 Thien-Thi Nguyen + + [gnugo imgen] Add autoload cookie. + + * packages/gnugo/gnugo-imgen.el (gnugo-imgen-create-xpms): ...for this + func. + +2014-05-21 Thien-Thi Nguyen + + [gnugo] Declare package keywords. + + * packages/gnugo/gnugo.el [Keywords]: New header. + +2014-05-21 Thien-Thi Nguyen + + [gnugo frolic] Promote frolic mode/funcs to feature. + + * packages/gnugo/gnugo.el (gnugo-frolic-mode-map) + (gnugo-frolic-parent-buffer, gnugo-frolic-origin) + (gnugo-frolic-mode, gnugo-frolic-return-to-origin) + (gnugo-frolic-in-the-leaves, gnugo--awake, gnugo--awakened) + (gnugo--move-to-bcol, gnugo--swiz, gnugo-frolic-exchange-left) + (gnugo-frolic-rotate-left, gnugo-frolic-exchange-right) + (gnugo-frolic-rotate-right, gnugo-frolic-set-as-main-line) + (gnugo-frolic-prune-branch, gnugo--sideways) + (gnugo-frolic-backward-branch, gnugo-frolic-forward-branch) + (gnugo--vertical, gnugo-frolic-previous-move, gnugo-frolic-next-move) + (gnugo-frolic-tip-move, gnugo-frolic-mode-map): Move from here... + * packages/gnugo/gnugo-frolic.el: ...to new file; add ‘provide’ form; + add autoload cookie for ‘gnugo-frolic-in-the-leaves’. + +2014-05-21 Thien-Thi Nguyen + + fixup! [gnugo imgen] New feature: gnugo-imgen + +2014-05-21 Thien-Thi Nguyen + + [gnugo imgen] New feature: gnugo-imgen + + * packages/gnugo/gnugo-imgen.el: New file. + * packages/gnugo/gnugo.el [Package-Requires]: Mention ‘xpm’. + +2014-05-18 Thien-Thi Nguyen + + [gnugo int] Accomodate XPM w/ :color-symbols property. + + * packages/gnugo/gnugo.el (gnugo-venerate): + ...here, propagating the foreground :color-symbols and value, if + available, to the new XPM. + +2014-05-12 Thien-Thi Nguyen + + [gnugo maint] Add ‘Maintainer’ header per top-level README; nfc. + +2014-05-09 Thien-Thi Nguyen + + [gnugo int] Add section "Tip Jar" in Commentary; nfc. + +2014-05-09 Thien-Thi Nguyen + + [gnugo int] Replace COND expression w/ IF. + + Incidentally, this reduces the byte code from 19 to 14 insn. + + * packages/gnugo/gnugo.el (gnugo-fancy-undo): + ...here, replacing last two clauses w/ ‘car-safe’ expression. + +2014-05-03 Thien-Thi Nguyen + + [gnugo int] Use private obarray for :all-yy elems, display props. + + * packages/gnugo/gnugo.el (gnugo-put): Update :all-yy blurb. + (gnugo-f): Rewrite. + (gnugo-cleanup): Don't bother w/ symbol cleanup. + (gnugo-board-mode): Init :obarray. + +2014-05-03 Thien-Thi Nguyen + + [gnugo] Fix bug: For GTP "help COMMAND", leave point in right place. + + * packages/gnugo/gnugo.el (:gnugo-gtp-command-spec help): When COMMANd + is specified and found, use a marker to hold its position, and after + moving point there, make it point nowhere. + +2014-05-03 Thien-Thi Nguyen + + [gnugo int] Simplify COND expression. + + * packages/gnugo/gnugo.el (gnugo-yy): Check ‘symbolp’ first; avoid + ‘consp’ and ‘and’ altogether. + +2014-05-03 Thien-Thi Nguyen + + [gnugo int] Use ‘loop ... collect’ more. + + * packages/gnugo/gnugo.el (gnugo-describe-internal-properties): + ...here. + +2014-05-03 Thien-Thi Nguyen + + [gnugo frolic] Add command to navigate to end of branch. + + * packages/gnugo/gnugo.el (gnugo-frolic-tip-move): New command. + (gnugo-frolic-mode-map): Add binding for ‘t’. + +2014-05-02 Thien-Thi Nguyen + + [gnugo] Replace ‘gnugo-toggle-grid’ w/ ‘gnugo-grid-mode’. + + * packages/gnugo/gnugo.el (gnugo-grid-mode): New command. + (gnugo-toggle-grid): Delete command. + (gnugo-board-mode-map): Update binding for ‘g’. + +2014-05-02 Thien-Thi Nguyen + + [gnugo] Replace ‘gnugo-toggle-image-display-command’ w/ + ‘gnugo-image-display-mode’. + + * packages/gnugo/gnugo.el (gnugo-image-display-mode): New command. + (gnugo-toggle-image-display-command): Delete command. + (gnugo-board-mode-map): Update binding for ‘i’. + +2014-05-02 Thien-Thi Nguyen + + [gnugo int] Mention ‘gnugo-frolic-mode-map’ in Commentary; nfc. + +2014-05-02 Thien-Thi Nguyen + + [gnugo int] Commentary munging; nfc. + +2014-05-02 Thien-Thi Nguyen + + [gnugo int] Decruft: Drop :local-xpms support. + + * packages/gnugo/gnugo.el (gnugo-describe-internal-properties): + ...here. + (gnugo-toggle-image-display): Don't consult :local-xpms. + +2014-05-02 Thien-Thi Nguyen + + [gnugo] Handle function for ‘gnugo-xpms’ value. + + * packages/gnugo/gnugo.el (gnugo-xpms): Update docstring. + (gnugo-toggle-image-display): If ‘gnugo-xpms’ is a function, call it + with the board size and take its rv as the set of XPM images to use. + +2014-05-02 Thien-Thi Nguyen + + [gnugo] Make ‘gnugo-xpms’ a normal var; drop it as feature. + + * packages/gnugo/gnugo.el (gnugo-xpms): Move earlier in file, to + "uninquisitive programmer" section; remove ‘eval-when-compile’ wrap; + add docstring. + (gnugo-toggle-image-display): Don't ‘(require 'gnugo-xmps)’; don't gate + ‘gnugo-xpms’ access w/ ‘boundp’. + +2014-05-02 Thien-Thi Nguyen + + [gnugo] Publicize ‘gnugo-undo-reaction’. + + Omission from 2014-05-01, "Make climb-to-root + "GNU Go to play" reaction customizable". + + * packages/gnugo/gnugo.el [Commentary]: ...here. + +2014-05-02 Thien-Thi Nguyen + + [gnugo int] Decruft: Presume ‘display-images-p’. + + * packages/gnugo/gnugo.el (gnugo-toggle-image-display): Don't gate + ‘display-images-p’ call w/ ‘fboundp’. + +2014-05-02 Thien-Thi Nguyen + + [gnugo maint] Update HACKING; nfc. + +2014-05-02 Thien-Thi Nguyen + + [gnugo] Make SGF I/O commands change ‘default-directory’. + + * packages/gnugo/gnugo.el (gnugo--ok-file): New func. + (gnugo-write-sgf-file, gnugo-read-sgf-file): Don't clear + buffer-modified state; instead, call ‘gnugo--ok-file’. + +2014-05-01 Thien-Thi Nguyen + + [gnugo] Make climb-to-root "GNU Go to play" reaction customizable. + + * packages/gnugo/gnugo.el (gnugo-undo-reaction): New defvar. + (gnugo--user-play): Inhibit karmic error for one-shot. + (gnugo--climb-towards-root): Don't take 2nd arg NOALT; instead, take + 2nd arg REACTION; drop "POS not occupied by COLOR" check and error; + rewrite handling for "GNU Go to play" case. + (gnugo-undo-one-move): Call ‘gnugo--climb-towards-root’ w/ + ‘gnugo-undo-reaction’ value clamped to ‘zombie’/‘one-shot’. + +2014-04-30 Thien-Thi Nguyen + + [gnugo int] Move karma state normalization down-chain. + + * packages/gnugo/gnugo.el (gnugo--karma): Always return boolean. + (gnugo--assist-state, gnugo--struggle): Don't normalize here. + +2014-04-30 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--assist-state + + * packages/gnugo/gnugo.el (gnugo--assist-state): New func. + (gnugo--climb-towards-root, gnugo-assist-mode): Use it. + +2014-04-30 Thien-Thi Nguyen + + [gnugo] Refuse to climb towards root when in Assist mode. + + * packages/gnugo/gnugo.el (gnugo--climb-towards-root): Signal + ‘user-error’ if Assist mode is enabled. + +2014-04-30 Thien-Thi Nguyen + + [gnugo] Fix bug: On role switch, flip karma after roles. + + Omission from 2014-04-29, "Replace abdication w/ Assist and Zombie + minor modes". + + * packages/gnugo/gnugo.el (gnugo-undo-one-move): Call + ‘gnugo--who-is-who’ after switching :gnugo-color, :user-color. + +2014-04-30 Thien-Thi Nguyen + + [gnugo int] Move some ‘gnugo-gate’ calls down-chain. + + * packages/gnugo/gnugo.el (gnugo-animate-group) + (gnugo-display-group-data): ...to here... + (gnugo-worm-stones, gnugo-worm-data) + (gnugo-dragon-stones, gnugo-dragon-data): ...from here. + +2014-04-30 Thien-Thi Nguyen + + [gnugo int] Drop redundant ‘gnugo-gate’ calls. + + * packages/gnugo/gnugo.el (gnugo-undo-two-moves, gnugo-oops): ...here. + +2014-04-29 Thien-Thi Nguyen + + [gnugo int] Comment munging; nfc. + +2014-04-29 Thien-Thi Nguyen + + [gnugo] Replace abdication w/ Assist and Zombie minor modes. + + * packages/gnugo/gnugo.el (gnugo--instant-karma): Delete func. + (gnugo--turn-the-wheel): New func. + (gnugo--finish-move): Take optional arg NOW; call + ‘gnugo--turn-the-wheel’ with it at end. + (gnugo-get-move-insertion-filter): Don't do :abd update. + (gnugo--karma): New func. + (gnugo--:karma): New defsubst. + (gnugo--user-play): Signal ‘user-error’ if current player karmic; don't + call ‘gnugo-get-move’; call ‘gnugo--finish-move’ w/ NOW ‘t’. + (gnugo--dance-dance): New func. + (gnugo--who-is-who): On switch, also flip karma. + (gnugo--climb-towards-root): Don't call ‘gnugo-get-move’; instead, + temporarily make :gnugo-color unkarmic around call to + ‘gnugo--turn-the-wheel’. + (gnugo-toggle-abdication): Delete command. + (gnugo--struggle): New func. + (gnugo-assist-mode, gnugo-zombie-mode): New commands. + (gnugo): Init :wheel; don't call ‘gnugo-get-move’; instead, call + ‘gnugo--turn-the-wheel’. + (gnugo-board-mode-map): Bind ‘C-c C-a’ to ‘gnugo-assist-mode’; add + binding for ‘C-c C-z’. + +2014-04-29 Thien-Thi Nguyen + + [gnugo int] Maintain current buffer in ‘gnugo--finish-move’. + + * packages/gnugo/gnugo.el (gnugo--finish-move): Don't take arg BUF; + instead, note and restore the current buffer around the call to + ‘run-hooks’. + (gnugo-get-move-insertion-filter) + (gnugo-user-play): Update accordingly. + +2014-04-29 Thien-Thi Nguyen + + [gnugo int] Avoid superfluous ‘gnugo-other’ call. + + * packages/gnugo/gnugo.el (gnugo-toggle-abdication): ...here. + +2014-04-27 Thien-Thi Nguyen + + [gnugo int] Drop abstractions: gnugo--{ERR-wait,gate-game-over} + + * packages/gnugo/gnugo.el (gnugo--gate-game-over) + (gnugo--ERR-wait): Delete, incorporating them into... + (gnugo-gate): ...here. + +2014-04-27 Thien-Thi Nguyen + + [gnugo int] Fix bug: Use correct color for "Not your turn yet". + + Regression introduced 2014-04-22, "Use ‘destructuring-bind’ more", in + the player-agnostic side-effect. :-/ + + * packages/gnugo/gnugo.el (gnugo-gate): For "Not your turn yet", use + ‘(gnugo-other color)’. + +2014-04-27 Thien-Thi Nguyen + + [gnugo int] Compute "Abd" in mode-line at time of change. + + * packages/gnugo/gnugo.el (gnugo-btw): New var. + (gnugo--instant-karma): New func. + (gnugo-refresh): Don't compute "Abd" here. + (gnugo-toggle-abdication): Use ‘gnugo--instant-karma’. + (gnugo-board-mode): Init ‘gnugo-btw’ as buffer-local var; include it in + ‘minor-mode-alist’. + +2014-04-25 Thien-Thi Nguyen + + [gnugo] Conditionalize xform warping on abdication disable. + + * packages/gnugo/gnugo.el (gnugo-toggle-abdication): For xform, don't + specify ‘nowarp’ unconditionally; instead, if user appears to be + "following along", specify ‘t’; move xform path completely inside + disable path. + +2014-04-25 Thien-Thi Nguyen + + [gnugo] Don't display "Abdication {en,dis}abled". + + That tends to persist in the echo area, which is both annoying and + misleading should the game end. + + * packages/gnugo/gnugo.el (gnugo--display-suggestion): New func. + (gnugo-get-move-insertion-filter): Use it. + (gnugo-toggle-abdication): Use ‘force-mode-line-update’; don't + ‘message’ state; however, retain "suggestion forthcoming" message via + ‘gnugo--display-suggestion’. + +2014-04-25 Thien-Thi Nguyen + + fixup! [gnugo int] Decorate w/ plist instead of alist. + +2014-04-25 Thien-Thi Nguyen + + [gnugo int] Decorate w/ plist instead of alist. + + * packages/gnugo/gnugo.el (gnugo--decorate): Rewrite; convert from + defsubst to defun. + (gnugo-display-final-score, gnugo-comment) + (gnugo r!): Update accordingly. + +2014-04-24 Thien-Thi Nguyen + + [gnugo int] Snoop ‘--handicap N’ for empty new board. + + Regression introduced from 2014-04-19, "Fix bug: Ensure gametree sync + for -l/--infile". + + * packages/gnugo/gnugo.el (gnugo): ...here. + +2014-04-24 Thien-Thi Nguyen + + [gnugo] Make undo commands silently handle overkill. + + It's impolite to reflect impoliteness. :-D + + * packages/gnugo/gnugo.el (gnugo--climb-towards-root): Don't use + ‘gnugo--q/ue’ for GTP "undo"; instead, use ‘gnugo--q’, detect overkill, + and stop looping. + +2014-04-24 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--no-worries + + * packages/gnugo/gnugo.el (gnugo--no-worries): New defsubst. + (gnugo--q/ue): Use ‘gnugo--no-worries’. + +2014-04-24 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--resignp + + * packages/gnugo/gnugo.el (gnugo--resignp): New defsubst. + (gnugo-move-history, gnugo-push-move, gnugo-refresh) + (gnugo-display-final-score): Use ‘gnugo--resignp’. + +2014-04-24 Thien-Thi Nguyen + + [gnugo int] Drop abstraction: pretty + + * packages/gnugo/gnugo.el (gnugo-move-history pretty): Delete internal + func. + (gnugo-move-history next): Revert to pre-‘pretty’ code. + (gnugo-move-history): For ‘bpos’ RSEL, convert search condition from + two negated string comparisons to one + "normal CC" position detection, and delay ‘as-pos’ call to rv + computation. + +2014-04-23 Thien-Thi Nguyen + + [gnugo int] Move ‘gnugo--passp’ earlier in file. + + * packages/gnugo/gnugo.el (gnugo--passp): + ...so that it precedes its first use. + +2014-04-23 Thien-Thi Nguyen + + [gnugo maint] Update HACKING; nfc. + +2014-04-22 Thien-Thi Nguyen + + [gnugo int] Use ‘gnugo-current-player’ more. + + * packages/gnugo/gnugo.el (gnugo-refresh): + ...here, obsoleting two local vars, as well. + +2014-04-22 Thien-Thi Nguyen + + [gnugo] Fix bug: Use ‘gnugo-gate’ for abdication enable. + + Gating only on game-over is not enough. + + * packages/gnugo/gnugo.el (gnugo-toggle-abdication): ...here. + +2014-04-22 Thien-Thi Nguyen + + [gnugo] On disable, transform in-flight user-move into suggestion. + + * packages/gnugo/gnugo.el (gnugo-toggle-abdication): Don't signal "too + soon" error; instead, transform scheduled user-move into a suggestion, + include extra info in the status message and sleep for 2 sec after + message display; update condition for ‘(gnugo-get-move gcolor)’ + accordingly. + +2014-04-22 Thien-Thi Nguyen + + [gnugo] Allow user to request suggestion for GNU Go. + + * packages/gnugo/gnugo.el (gnugo-get-move-insertion-filter): Include + color in suggestion message. + (gnugo-request-suggestion): Use ‘gnugo-current-player’. + +2014-04-22 Thien-Thi Nguyen + + [gnugo] Fix bug: DTRT for suggestion ‘nowarp’ check. + + From inception 2014-04-15, "New command: ‘S’ + (gnugo-request-suggestion)". + + * packages/gnugo/gnugo.el (gnugo-get-move-insertion-filter): Don't feed + ‘cons’ rv to ‘destructuring-bind’; instead, drop var ‘pos-or-pass’, + repurpose var ‘full’ -- surely succumbing to Bad Style :-/, and access + :waiting directly. + +2014-04-22 Thien-Thi Nguyen + + [gnugo int] Use ‘destructuring-bind’ more. + + * packages/gnugo/gnugo.el (gnugo-gate): ...here, for :waiting check, in + the process making it player-agnostic. + +2014-04-22 Thien-Thi Nguyen + + [gnugo] Allow user to move for GNU Go. + + * packages/gnugo/gnugo.el (gnugo--user-play): Don't hardcode WHO to + ‘gnugo-push-move’; instead, compute it from :last-mover. + +2014-04-21 Thien-Thi Nguyen + + [gnugo int] Move ‘gnugo-position’ call down-chain. + + * packages/gnugo/gnugo.el (gnugo--climb-towards-root): + ...into here if SPEC is neither number nor string. + (gnugo-oops, gnugo-fancy-undo): Update accordingly. + +2014-04-21 Thien-Thi Nguyen + + [gnugo int] Centralize some "No stone at POS" errors. + + * packages/gnugo/gnugo.el (gnugo--mem-with-played-stone): Take optional + arg NOERROR; if clear, when no ‘color’ found, signal "No stone at POS" + error. + (gnugo--climb-towards-root): Drop "POS already clear" error handling; + use ‘gnugo--mem-with-played-stone’ rv directly. + (gnugo--node-with-played-stone): Take optional arg NOERROR; pass it to + ‘gnugo--mem-with-played-stone’. + (gnugo-describe-position): Specify NOERROR to + ‘gnugo--node-with-played-stone’. + (gnugo-comment): Drop "No stone at POS" error handling; use + ‘gnugo--node-with-played-stone’ rv directly. + +2014-04-21 Thien-Thi Nguyen + + [gnugo int] Simplify towards-root loop termination check. + + * packages/gnugo/gnugo.el (gnugo--climb-towards-root): Don't construct + local func ‘done’; instead, pre-compute final MEM and loop until it's + reached, as per ‘eq’. + +2014-04-21 Thien-Thi Nguyen + + [gnugo] Internalize ‘gnugo-magic-undo’. + + * packages/gnugo/gnugo.el (gnugo--climb-towards-root): Rename from + ‘gnugo-magic-undo’; delete docstring. + (gnugo-undo-one-move, gnugo-undo-two-moves, gnugo-oops) + (gnugo-fancy-undo): Use ‘gnugo--climb-towards-root’. + (:gnugo-gtp-command-spec undo) + (:gnugo-gtp-command-spec gg-undo): Likewise. + +2014-04-21 Thien-Thi Nguyen + + [gnugo] Validate position arg of GTP commands ‘undo’, ‘gg-undo’. + + * packages/gnugo/gnugo.el + (:gnugo-gtp-command-spec validpos): New internal func. + (:gnugo-gtp-command-spec undo) + (:gnugo-gtp-command-spec gg-undo): Use ‘validpos’. + +2014-04-21 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--mem-with-played-stone + + * packages/gnugo/gnugo.el (gnugo--mem-with-played-stone): New func. + (gnugo--node-with-played-stone): Use it; convert to defsubst. + +2014-04-21 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--q/ue + + * packages/gnugo/gnugo.el (gnugo--q/ue): New func. + (gnugo-push-move, gnugo-read-sgf-file, gnugo-magic-undo): Use it. + +2014-04-21 Thien-Thi Nguyen + + [gnugo] Reduce modifier key bouncing for "quick peek" frolics. + + * packages/gnugo/gnugo.el + (gnugo-frolic-mode-map): Bind ‘C-q’ to ‘gnugo-frolic-quit’. + (gnugo-board-mode-map): Bind ‘C-c C-l’ to ‘gnugo-frolic-in-the-leaves’. + +2014-04-21 Thien-Thi Nguyen + + [gnugo] Fix bug: DTRT for :last-user-bpos in undo-one-move ME-NEXT. + + Omission from 2014-03-11, "Make ‘C-u M-u’ switch roles". + + * packages/gnugo/gnugo.el (gnugo-undo-one-move): Swizzle colors before + calling ‘gnugo-magic-undo’. + +2014-04-20 Thien-Thi Nguyen + + [gnugo int] Fix bug: On -l/--infile, inhibit first move if game over. + + Omission from 2014-04-19, "Fix bug: Ensure gametree sync for + -l/--infile". + + * packages/gnugo/gnugo.el (gnugo): ...here. + +2014-04-20 Thien-Thi Nguyen + + [gnugo int] Fix bug: On -l/--infile, don't set :last-mover. + + Omission from 2014-04-19, "Fix bug: Ensure gametree sync for + -l/--infile". + + * packages/gnugo/gnugo.el (gnugo): ...here. + +2014-04-20 Thien-Thi Nguyen + + [gnugo] On SGF load, leave cursor at last user board position. + + * packages/gnugo/gnugo.el (gnugo-move-history): Take optional second + arg COLOR. + (gnugo-move-history remem): New internal func. + (gnugo-move-history pretty): New internal func. + (gnugo-move-history next): Use ‘remem’, ‘pretty’. + (gnugo-move-history): If RSEL is ‘bpos’, return the position of the + last stone placed by COLOR. + (gnugo-read-sgf-file): Set :last-user-bpos. + (gnugo): After refresh, prefer :last-user-bpos to :center-position for + cursor position. + +2014-04-20 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--prop<-color + + * packages/gnugo/gnugo.el (gnugo--prop<-color): New defsubst. + (gnugo-push-move, gnugo-okay): Use ‘gnugo--prop<-color’. + +2014-04-19 Thien-Thi Nguyen + + [gnugo int] Declare ‘lexical-binding: t’. + + * packages/gnugo/gnugo.el: ...here, in first-line comment. + +2014-04-19 Thien-Thi Nguyen + + [gnugo] Fix bug: Ensure gametree sync for -l/--infile. + + Previously, specifying ‘--infile FILENAME’ (or ‘-l FILENAME’) would + result in a degenerate (root-node only) :sgf-gametree. Incidentally, + the "don't snoop" part of this change removes the last remaining + barrier to clean ‘lexical-binding: t’. + + * packages/gnugo/gnugo.el (gnugo): Rewrite docstring; parse + user-specified command-line arguments; don't snoop "--boardsize", + "--handicap", "--komi"; instead, defer until subprocess available and + then query; rewrite kick args to segregate/prioritize "--infile", "-l"; + save filename; when filename specified, expand it and pass to + ‘gnugo-read-sgf-file’ instead of constructing the degenerate gametree; + combine ‘gnugo--SZ!’ call with aforementioned ‘board-size’, ‘handicap’, + ‘komi’ mining and do only for degenerate gametree construction. + +2014-04-19 Thien-Thi Nguyen + + [gnugo int] Couple :center-position and :SZ jamming. + + * packages/gnugo/gnugo.el (gnugo--SZ!): Convert to ‘defun’; also + compute/assign :center-position. + (gnugo): Don't compute :center-position explicitly, but do move point + to it, after the refresh. + +2014-04-19 Thien-Thi Nguyen + + [gnugo int] Decruft: Don't set provisional :last-user-bpos. + + * packages/gnugo/gnugo.el (gnugo): + ...here, as it does not make sense. + +2014-04-19 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--nquery + + * packages/gnugo/gnugo.el (gnugo--nquery): New func. + (gnugo): Use ‘gnugo--nquery’. + (:gnugo-gtp-command-spec): Likewise. + +2014-04-19 Thien-Thi Nguyen + + [gnugo int] Move some prop jamming to ‘gnugo-board-mode’. + + * packages/gnugo/gnugo.el (gnugo-board-mode): Move to here the setting + of properties + :default-highlight-last-move-spec, + :highlight-last-move-spec, :paren-ov, :mul... + (gnugo): ...from here. + +2014-04-19 Thien-Thi Nguyen + + [gnugo int] Use functional style more. + + * packages/gnugo/gnugo.el (gnugo): Pass ‘gnugo--plant-and-climb’ rv to + ‘gnugo--root-node’. + +2014-04-19 Thien-Thi Nguyen + + [gnugo int] Decruft: Don't stash :proc-args. + + * packages/gnugo/gnugo.el (gnugo): ...here. + +2014-04-17 Thien-Thi Nguyen + + [gnugo] Decruft: Use ‘gnugo-program’ directly as executable. + + * packages/gnugo/gnugo.el (gnugo-program): Rewrite docstring. + (gnugo): Add ‘gnugo-program’ sanity check prior to buffer switch; drop + support for "PROGRAM OPTIONS..." value. + +2014-04-17 Thien-Thi Nguyen + + [gnugo int] Decruft: Drop unused local var. + + From inception 2014-04-15, "New command: + ‘C-c C-a’ (gnugo-toggle-abdication)". + + * packages/gnugo/gnugo.el (gnugo-toggle-abdication): Drop unused local + var ‘ucolor’; also, don't bother destructuring :waiting; instead, just + check its truth value. + +2014-04-17 Thien-Thi Nguyen + + [gnugo] Keep GNUGO Board buffer read-only. + + * packages/gnugo/gnugo.el (gnugo-merge-showboard-results) + (gnugo-refresh): Dynamically set ‘inhibit-read-only’. + (gnugo-board-mode): Don't clear ‘buffer-read-only’. + +2014-04-17 Thien-Thi Nguyen + + [gnugo int] Don't make ‘font-lock-defaults’ buffer-local. + + * packages/gnugo/gnugo.el (gnugo-board-mode): + ...here, as it automatically becomes buffer-local when set. + +2014-04-17 Thien-Thi Nguyen + + [gnugo] Use ‘define-derived-mode’ for GNUGO Board mode. + + This exposes ‘gnugo-board-mode-hook’ to the vagaries of Special mode + (in particular ‘special-mode-hook’). + + * packages/gnugo/gnugo.el (gnugo-board-mode): + ...here, removing now-redundant stuff accordingly, as well as ‘(put + 'gnugo-board-mode 'mode-class 'special)’; also, clear + ‘buffer-read-only’. + +2014-04-17 Thien-Thi Nguyen + + [gnugo int] Decruft: Streamline game-over handling on SGF load. + + * packages/gnugo/gnugo.el (gnugo-read-sgf-file): Don't bother w/ + :game-over here; leave it to ‘gnugo-close-game’. + +2014-04-17 Thien-Thi Nguyen + + [gnugo int] Consolidate display scaling factors access. + + * packages/gnugo/gnugo.el (gnugo-toggle-image-display): Save image + factors in :imul instead of in :w-imul, :h-imul; conditionally assign + them directly to :mul instead of :wmul, + :hmul, or otherwise reset to ‘(1 . 1)’. + (gnugo-refresh): Update accordingly. + (gnugo): Init :mul to ‘(1 . 1)’. + +2014-04-17 Thien-Thi Nguyen + + [gnugo int] Consolidate paren overlays access. + + * packages/gnugo/gnugo.el (gnugo-put): Update docstring. + (gnugo-refresh): Use ‘destructuring-bind’ for paren overlays. + (gnugo): Don't ‘gnugo-put’ overlays in :lparen-ov and + :rparen-ov; instead, cons them and stash the pair in :paren-ov. + +2014-04-17 Thien-Thi Nguyen + + [gnugo int] Shave one ‘gnugo-other’ call. + + * packages/gnugo/gnugo.el (gnugo): ...here, in the root-node init, by + checking for "user plays black" directly, and inverting the resulting + :PB, :PW values. + +2014-04-16 Thien-Thi Nguyen + + [gnugo] Move most of ‘gnugo-board-mode’ to ‘gnugo’. + + Although the buffer-local hash ‘gnugo-state’ is available in + ‘gnugo-board-mode’, it is empty. This impacts mostly funcs on + ‘gnugo-board-mode-hook’ that use gnugo-{get,put}. + + * packages/gnugo/gnugo.el (gnugo-board-mode): Move buffer switching, + options querying, process kicking, a raft of ‘gnugo-put’ calls, and + buffer refreshing from here... + (gnugo): ...to here; also, don't bother to ‘gnugo--forget’. + +2014-04-16 Thien-Thi Nguyen + + [gnugo int] Remove from ‘gnugo-state’ instead of setting to nil. + + * packages/gnugo/gnugo.el (gnugo--forget): New func. + (gnugo-sentinel, gnugo-toggle-image-display, gnugo--unclose-game) + (gnugo-get-move-insertion-filter, gnugo-toggle-abdication) + (gnugo-board-mode): Use it. + (:gnugo-gtp-command-spec boardsize :post-thunk) + (:gnugo-gtp-command-spec clear_board :post-thunk) + (:gnugo-gtp-command-spec fixed_handicap :post-thunk): Likewise. + +2014-04-16 Thien-Thi Nguyen + + [gnugo] Add hook: gnugo-start-game-hook + + * packages/gnugo/gnugo.el (gnugo-start-game-hook): New var. + (gnugo): Run ‘gnugo-start-game-hook’. + +2014-04-16 Thien-Thi Nguyen + + [gnugo] Add abstraction: gnugo-current-player + + * packages/gnugo/gnugo.el (gnugo-current-player): New func. + (gnugo-refresh, gnugo-magic-undo, gnugo): Use it. + +2014-04-16 Thien-Thi Nguyen + + [gnugo] Drop support for ‘(gnugo-move-history 'count)’. + + * packages/gnugo/gnugo.el (gnugo-move-history): ...here. + (gnugo-refresh): For ‘~m’, access :sgf-gametree, :monkey directly. + +2014-04-16 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--plant-and-climb + + * packages/gnugo/gnugo.el (gnugo--plant-and-climb): New func. + (gnugo-read-sgf-file, gnugo-board-mode): Use it. + +2014-04-16 Thien-Thi Nguyen + + [gnugo] Increase S/N for ‘C-u F’ comment. + + * packages/gnugo/gnugo.el (gnugo-display-final-score): Omit "The game + is over. " and lines w/ start/end time. + +2014-04-16 Thien-Thi Nguyen + + [gnugo frolic] Type ‘Q’ to quit. + + * packages/gnugo/gnugo.el (gnugo-frolic-mode-map): Add binding for ‘Q’. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Commentary munging; nfc. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Use ‘following-char’ more. + + * packages/gnugo/gnugo.el (gnugo-mouse-move): + ...here w/ ‘memq’, instead of ‘looking-at’. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--user-play + + * packages/gnugo/gnugo.el (gnugo--user-play): New func. + (gnugo-move, gnugo-pass): Use ‘gnugo--user-play’. + +2014-04-15 Thien-Thi Nguyen + + [gnugo] Mention ‘gnugo-frolic-mode-hook’. + + Omission from 2014-04-08, "Define "GNUGO Frolic" mode". + + * packages/gnugo/gnugo.el [Commentary]: ...here. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--gate-game-over + + * packages/gnugo/gnugo.el (gnugo--gate-game-over): New defsubst. + (gnugo-gate, gnugo-toggle-abdication): Use it. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--ERR-wait + + * packages/gnugo/gnugo.el (gnugo--ERR-wait): New defun. + (gnugo-gate, gnugo-toggle-abdication): Use it. + +2014-04-15 Thien-Thi Nguyen + + [gnugo] New command: ‘C-c C-a’ (gnugo-toggle-abdication) + + * packages/gnugo/gnugo.el (gnugo-refresh): Include "Abd" in mode line + if abdication enabled. + (gnugo-get-move-insertion-filter): If abdication enabled, create and + save a timer object to call ‘gnugo-get-move’ w/ the opposite of the + current ‘color’. + (gnugo-toggle-abdication): New command. + (gnugo-board-mode-map): Add binding for ‘C-c C-a’. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Centralize some constant strings. + + * packages/gnugo/gnugo.el (gnugo--rename-buffer-portion): Rewrite. + (gnugo-get-move-insertion-filter): Update call. + (gnugo-request-suggestion): Likewise. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Accept color for ‘gnugo-push-move’ 1st arg. + + * packages/gnugo/gnugo.el (gnugo-push-move): Rename first arg to WHO; + if it is not a boolean, take it as ‘color’ directly; update "effective + userp" ref likewise. + (gnugo-get-move-insertion-filter): Pass ‘color’ directly to + ‘gnugo-push-move’. + +2014-04-15 Thien-Thi Nguyen + + [gnugo] New command: ‘S’ (gnugo-request-suggestion) + + * packages/gnugo/gnugo.el (gnugo-gate): If waiting for a suggestion, + say "Still thinking" instead of "Not your turn yet" in error message. + (gnugo--q): If waiting for a suggestion, say + "receive a suggestion" instead of "play" in error message. + (gnugo--rename-buffer-portion): New func. + (gnugo-get-move-insertion-filter): On received suggestion, rename + buffer w/ "to play", warp the cursor unless nonsensical or inhibited, + and display the suggestion in the echo area. + (gnugo-get-move): Take optional arg SUGGESTION; save it as well as + color in :waiting. + (gnugo-request-suggestion): New command. + (gnugo-board-mode-map): Add binding for ‘S’. + +2014-04-15 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--finish-move + + * packages/gnugo/gnugo.el (gnugo--finish-move): New func. + (gnugo-get-move-insertion-filter, gnugo-move, gnugo-pass): Use it. + +2014-04-15 Thien-Thi Nguyen + + [gnugo] Drop var: gnugo-inhibit-refresh + + * packages/gnugo/gnugo.el (gnugo-inhibit-refresh): Delete. + (gnugo-post-move-hook): Update docstring. + (gnugo-get-move-insertion-filter) + (gnugo-move, gnugo-pass): Update. + +2014-04-14 Thien-Thi Nguyen + + [gnugo maint] Update HACKING; nfc. + +2014-04-14 Thien-Thi Nguyen + + [gnugo frolic] Display "!" for comment; add as ‘help-echo’. + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves): ...here. + +2014-04-14 Thien-Thi Nguyen + + [gnugo] Make ‘C-u F’ add the blurb as a comment to the last node. + + * packages/gnugo/gnugo.el (gnugo-display-final-score): + ...here, if new prefix arg COMMENT is set, with "territory", + "captures", "komi" squashed to "T", "C", "K", respectively. + +2014-04-14 Thien-Thi Nguyen + + [gnugo] New command: ‘C’ (gnugo-comment) + + * packages/gnugo/gnugo.el (gnugo-comment): New command. + (gnugo-board-mode-map): Add binding for ‘C’. + +2014-04-14 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--node-with-played-stone + + * packages/gnugo/gnugo.el (gnugo--node-with-played-stone): New func. + (gnugo-describe-position): Use ‘gnugo--node-with-played-stone’. + +2014-04-14 Thien-Thi Nguyen + + [gnugo int] Incorporate *-play-stone into ‘gnugo-push-move’. + + U (X) ≡ "Don't call X". + * packages/gnugo/gnugo.el (gnugo--play-stone): Delete func. + (gnugo--user-play-stone): Delete defsubst. + (gnugo-push-move): Do GTP "play COLOR MOVE" here. + (gnugo-get-move-insertion-filter): U (gnugo--play-stone); make USERP + arg to ‘gnugo-push-move’ depend on :waiting color. + (gnugo-move, gnugo-pass): U (gnugo--user-play-stone). + (gnugo-okay): U (gnugo--play-stone); decruft local vars. + (gnugo-display-final-score): U (gnugo--play-stone). + +2014-04-14 Thien-Thi Nguyen + + [gnugo] Fix bug: Keep subproc informed of forced PASS. + + * packages/gnugo/gnugo.el (gnugo-display-final-score): For forced PASS + moves, call ‘gnugo--play-stone’, too. + +2014-04-14 Thien-Thi Nguyen + + [gnugo int] Use GTP ‘reg_genmove’ instead of ‘genmove’. + + * packages/gnugo/gnugo.el (gnugo-get-move): ...here. + (gnugo-get-move-insertion-filter): Extract COLOR from :waiting; call + ‘gnugo--play-stone’ with it. + +2014-04-14 Thien-Thi Nguyen + + [gnugo int] Rename :waitingp to :waiting; save color there. + + * packages/gnugo/gnugo.el (gnugo-board-buffer-p) + (gnugo-get-move-insertion-filter, gnugo-display-final-score) + (gnugo-gate, gnugo--q, gnugo-refresh, gnugo-board-mode): Update. + (gnugo-get-move): Save COLOR in :waiting. + +2014-04-14 Thien-Thi Nguyen + + [gnugo] Dropped command: ‘t’ (gnugo-toggle-dead-group) + + This was incomplete and not very useful. + + * packages/gnugo/gnugo.el (gnugo-toggle-dead-group): Delete command. + (gnugo-board-mode-map): Don't bind ‘t’. + +2014-04-13 Thien-Thi Nguyen + + [gnugo int] Incorporate ‘gnugo-note’ into unique caller. + + * packages/gnugo/gnugo.el + (gnugo-note): Move... + (gnugo-push-move): ...into here. + +2014-04-13 Thien-Thi Nguyen + + [gnugo int] Use ‘gnugo--decorate’ more. + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here. + +2014-04-13 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--decorate + + * packages/gnugo/gnugo.el (gnugo--decorate): New defsubst. + (gnugo-note): Use ‘gnugo--decorate’. + +2014-04-13 Thien-Thi Nguyen + + [gnugo] Include root node in :sgf-gametree description. + + * packages/gnugo/gnugo.el (gnugo--root-node): Move earlier in file. + (gnugo-describe-internal-properties): ...here. + +2014-04-13 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--count-query + + * packages/gnugo/gnugo.el (gnugo--count-query): New defsubst. + (gnugo-estimate-score, gnugo-display-final-score): Use it. + +2014-04-13 Thien-Thi Nguyen + + [gnugo int] Add abstractions: gnugo--{user-}play-stone + + * packages/gnugo/gnugo.el (gnugo--play-stone): New func. + (gnugo--user-play-stone): New defsubst. + (gnugo-move, gnugo-pass): Use ‘gnugo--user-play-stone’. + (gnugo-toggle-dead-group, gnugo-okay): Use ‘gnugo--play-stone’. + +2014-04-13 Thien-Thi Nguyen + + [gnugo int] Make ‘gnugo-gate’ slightly faster. + + * packages/gnugo/gnugo.el (gnugo-gate): Check IN-PROGRESS-P before + :game-over. + +2014-04-12 Thien-Thi Nguyen + + [gnugo] New command: ‘O’ (gnugo-okay) + + * packages/gnugo/gnugo.el (gnugo-okay): New command. + (gnugo-board-mode-map): Add binding for ‘O’. + +2014-04-12 Thien-Thi Nguyen + + fixup! [gnugo frolic] Add previous/next move navigation commands. + +2014-04-12 Thien-Thi Nguyen + + [gnugo frolic] Add previous/next move navigation commands. + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves fsi): Take first + arg PROPERTIES, pushing other args later; use them to ‘propertize’ the + formatted string. + (gnugo-frolic-in-the-leaves): Propertize "move" lines w/ property ‘n’, + column text additionally w/ property ‘bx’. + (gnugo--vertical): New func. + (gnugo-frolic-previous-move): New command. + (gnugo-frolic-next-move): Likewise. + (gnugo-frolic-mode-map): Add bindings for ‘C-p’, ‘C-n’. + +2014-04-12 Thien-Thi Nguyen + + [gnugo int] Move :SZ access into ‘gnugo--as-pos-func’. + + * packages/gnugo/gnugo.el (gnugo--as-pos-func): Don't take arg ‘size’; + instead, do ‘(gnugo-get :SZ)’ internally. + (gnugo-move-history): Update call to ‘gnugo--as-pos-func’. + (gnugo-frolic-in-the-leaves): Likewise. + +2014-04-12 Thien-Thi Nguyen + + [gnugo] Make ‘=’ also display move number. + + * packages/gnugo/gnugo.el (gnugo-describe-position): If there a stone + at that position, also display its move number. + +2014-04-12 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--as-cc-func + + * packages/gnugo/gnugo.el (gnugo--as-cc-func): New func. + (gnugo-note): Use ‘gnugo--as-cc-func’. + +2014-04-12 Thien-Thi Nguyen + + [gnugo maint] Update HACKING; nfc. + + The debugging aids functionality is now part of gnugo.el. + + The various ideas / wishlist items are now realized, except for + "dribble the SGF tree", which is bunk, and "SGF tree traversal", which + awaits a nicer (user-level) node-ref facility. + +2014-04-12 Thien-Thi Nguyen + + [gnugo int] Use ‘ignore’ to avoid byte-compiler warnings. + + * packages/gnugo/gnugo.el (gnugo-frolic-prune-branch) + (:gnugo-gtp-command-spec final_score): ...here. + +2014-04-12 Thien-Thi Nguyen + + [gnugo frolic int] Add var selection to awakening parameterization. + + This eliminates unused local vars for the affected funcs. + + * packages/gnugo/gnugo.el (gnugo--awake): Check HOW for ‘(omit NAME + ...)’ and arrange to omit NAME... from the return value; return a + simple list, w/o ‘values’. + (gnugo--awakened): Use ‘destructuring-bind’ instead of + ‘multiple-value-bind’; construct its ARGS parameter based on ‘(omit + NAME ...)’ in HOW. + (gnugo--swiz): Omit ‘tree’. + (gnugo--sideways): Omit ‘tree’, ‘ends’, ‘monkey’, ‘bidx’, ‘line’. + +2014-04-12 Thien-Thi Nguyen + + [gnugo frolic int] Add abstraction: gnugo--sideways + + * packages/gnugo/gnugo.el (gnugo--sideways): New func. + (gnugo-frolic-backward-branch, gnugo-frolic-forward-branch): Use it. + +2014-04-12 Thien-Thi Nguyen + + [gnugo int] Decruft: Delete unused local vars. + + U (V, ...) ≡ "Delete local var V, ...". + * packages/gnugo/gnugo.el + (gnugo-move-history): U (col). + (gnugo-frolic-in-the-leaves): U (node, count). + +2014-04-12 Thien-Thi Nguyen + + [gnugo int] Fix syntax error in ‘loop’ destructuring. + + The destructuring is similar to but not identical to the facility + provided by ‘defmacro’ (info "(cl) For Clauses"). This was caught, btw, + while trying to byte-compile w/ + ‘-*- lexical-binding: t -*-’ on the first line. + + * packages/gnugo/gnugo.el (gnugo-board-mode): Omit ‘&optional’ from + ‘for’ clause variable destructuring form. + +2014-04-11 Thien-Thi Nguyen + + [gnugo int] Decruft: Drop gametree IR element: KIDS + + * packages/gnugo/gnugo.el (gnugo-describe-internal-properties): Update. + (gnugo/sgf-create TREE): Don't take 3rd arg KIDS; don't do + multiple-kids detection / stashing. + (gnugo/sgf-create): Omit KIDS from rv. + +2014-04-11 Thien-Thi Nguyen + + [gnugo int] Reorder gametree IR: ENDS, MNUM, ROOT, KIDS. + + * packages/gnugo/gnugo.el (gnugo--tree-mnum) + (gnugo--tree-ends, gnugo--set-tree-ends) + (gnugo-describe-internal-properties, gnugo--root-node) + (gnugo/sgf-create): ...here. + +2014-04-11 Thien-Thi Nguyen + + [gnugo sgf int] Internalize ‘gnugo/sgf-hang-from-root’. + + * packages/gnugo/gnugo.el (gnugo/sgf-write-file): + ...into here, and remove ‘gnugo/sgf-hang-from-root’. + +2014-04-11 Thien-Thi Nguyen + + [gnugo sgf int] Consolidate loops. + + * packages/gnugo/gnugo.el (gnugo/sgf-write-file): + ...here, for "taking responsibility" and "write it out". + +2014-04-10 Thien-Thi Nguyen + + [gnugo sgf] Fix bug: Add ‘\’-escapes on write. + + * packages/gnugo/gnugo.el (gnugo/sgf-write-file esc): New internal + func. + (gnugo/sgf-write-file >>one) + (gnugo/sgf-write-file >>two): Use ‘esc’. + +2014-04-10 Thien-Thi Nguyen + + [gnugo sgf] Fix bug: Preserve whitespace for ‘text’ values. + + * packages/gnugo/gnugo.el (gnugo/sgf-create x): Take arg + PRESERVE-WHITESPACE; when set, don't squeeze whitespace. + (gnugo/sgf-create one): Specify PRESERVE-WHITESPACE to ‘x’ when ‘type’ + is ‘text’. + +2014-04-10 Thien-Thi Nguyen + + [gnugo int] Whitespace munging; nfc. + +2014-04-10 Thien-Thi Nguyen + + [gnugo int] Fix bug: Update local var ‘ends’ when branching. + + Omission from 2014-04-05, "Expand gametree IR: MNUM, KIDS, ROOT". Note + the unheeded hint: "hmm, probably unnecessary" -- d'oh! + + * packages/gnugo/gnugo.el (gnugo--set-tree-ends): Return the new ends. + (gnugo-note): Update local var ‘ends’ w/ ‘gnugo--set-tree-ends’ rv. + +2014-04-10 Thien-Thi Nguyen + + [gnugo int] Move vectorization into ‘gnugo--set-tree-ends’. + + * packages/gnugo/gnugo.el (gnugo--set-tree-ends): Rename 2nd arg to LS; + apply ‘vector’ to it to obtain ENDS. + (gnugo-frolic-prune-branch, gnugo-note): Update accordingly. + +2014-04-10 Thien-Thi Nguyen + + [gnugo frolic int] Don't bother to awake w/ ‘col’. + + * packages/gnugo/gnugo.el (gnugo--awake): Don't return ‘col’. + (gnugo--awakened): Don't consume/bind ‘col’. + +2014-04-10 Thien-Thi Nguyen + + [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. + +2014-04-10 Thien-Thi Nguyen + + [gnugo frolic] Doc fix. + + * packages/gnugo/gnugo.el (gnugo-frolic-mode): Don't limit to + "viewing"; don't mention View minor mode. + +2014-04-09 Thien-Thi Nguyen + + [gnugo frolic] Set ‘truncate-lines’. + + * packages/gnugo/gnugo.el (gnugo-frolic-mode): ...here. + +2014-04-09 Thien-Thi Nguyen + + [gnugo frolic] Sync column headers w/ buffer text; handle offsets. + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves): For + ‘header-line-format’, replace constant string with ‘(:eval ...)’ form + that handles left scroll bar, left fringe, and horizontal scrolling + margin, if any. + +2014-04-09 Thien-Thi Nguyen + + [gnugo frolic int] Regularize keymap decl + init. + + * packages/gnugo/gnugo.el (gnugo-frolic-mode-map): New defvar. + : Conditionalize ‘gnugo-frolic-mode-map’ init; use same + idiom as for ‘gnugo-board-mode-map’. + +2014-04-09 Thien-Thi Nguyen + + [gnugo int] Fix syntax error. + + Wishful Scheme thinking, not enough caffeine drinking... + + * packages/gnugo/gnugo.el (gnugo--move-to-bcol): ...here. + +2014-04-09 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--move-to-bcol + + * packages/gnugo/gnugo.el (gnugo--move-to-bcol): New defsubst. + (gnugo--swiz, gnugo-frolic-prune-branch) + (gnugo-frolic-backward-branch) + (gnugo-frolic-forward-branch): Use it. + +2014-04-09 Thien-Thi Nguyen + + [gnugo int] Fix bug: Unbreak SGF file output. + + Omission from / regression introduced 2014-04-05, + "Expand gametree IR: MNUM, KIDS, ROOT", sigh. + + * packages/gnugo/gnugo.el (gnugo/sgf-hang-from-root): Use + ‘gnugo--tree-ends’. + +2014-04-09 Thien-Thi Nguyen + + [gnugo frolic int] Don't go through ‘gnugo-frolic-quit’ for refresh. + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves): If + ‘gnugo-frolic-parent-buffer’ is already set, don't clobber it. + (gnugo--swiz): Don't call ‘gnugo-frolic-quit’. + (gnugo-frolic-prune-branch): Likewise. + +2014-04-09 Thien-Thi Nguyen + + [gnugo frolic int] Use ‘move-to-column’ more. + + * packages/gnugo/gnugo.el (gnugo-frolic-prune-branch): ...here. + +2014-04-09 Thien-Thi Nguyen + + [gnugo frolic int] Assign ‘pop’ rv to avoid byte-compiler warning. + + * packages/gnugo/gnugo.el (gnugo-frolic-prune-branch): + ...here; also, let ‘pop’ handle ‘(zerop a)’ case internally. + +2014-04-09 Thien-Thi Nguyen + + [gnugo frolic] Handle invalid branch more consistently. + + * packages/gnugo/gnugo.el (gnugo--awake): If ‘col’ is too big or too + small, return nil for ‘a’. + (gnugo--swiz, gnugo-frolic-prune-branch): Throw error on invalid + branch. + (gnugo-frolic-backward-branch): Take invalid branch as ‘width’. + (gnugo-frolic-forward-branch): Take invalid branch as -1. + +2014-04-08 Thien-Thi Nguyen + + [gnugo frolic] Add command to prune a branch. + + * packages/gnugo/gnugo.el (gnugo-frolic-prune-branch): New command. + (gnugo-frolic-mode-map): Bind ‘C-M-p’ to it. + +2014-04-08 Thien-Thi Nguyen + + [gnugo frolic] Add command to set the main line. + + * packages/gnugo/gnugo.el (gnugo--swiz): Rename arg SHIFT to BLUNT; if + BLUNT is a number, validate and take it as ‘b’ directly. + (gnugo-frolic-set-as-main-line): New command. + (gnugo-frolic-mode-map): Bind ‘C-m’ to it. + +2014-04-08 Thien-Thi Nguyen + + [gnugo frolic] Add backward/forward branch navigation commands. + + * packages/gnugo/gnugo.el (gnugo-frolic-backward-branch) + (gnugo-frolic-forward-branch): New commands. + (gnugo-frolic-mode-map): Add bindings for ‘C-b’, ‘C-f’. + +2014-04-08 Thien-Thi Nguyen + + [gnugo frolic] Add some branch swizzling commands. + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves): Set + buffer-local ‘gnugo-state’ to that of the parent buffer. + (gnugo--awake): New func. + (gnugo--awakened): New macro. + (gnguo--swiz): New func. + (gnugo-frolic-exchange-left, gnugo-frolic-rotate-left) + (gnugo-frolic-exchange-right, gnugo-frolic-rotate-right): New commands. + (gnugo-frolic-mode-map): Add bindings for ‘j’, ‘J’, ‘k’, ‘K’. + +2014-04-08 Thien-Thi Nguyen + + [gnugo int] Make ‘gnugo-board-buffer-p’ precise. + + * packages/gnugo/gnugo.el (gnugo-board-buffer-p): Check ‘major-mode’ + directly; use ‘buffer-local-value’. + +2014-04-08 Thien-Thi Nguyen + + [gnugo] Add some navigation commands for GNUGO Frolic mode. + + * packages/gnugo/gnugo.el (gnugo-frolic-parent-buffer) + (gnugo-frolic-origin): New defvars. + (gnugo-frolic-mode): Don't invoke ‘view-mode’. + (gnugo-frolic-quit, gnugo-frolic-return-to-origin): New commands. + (gnugo-frolic-in-the-leaves): Set as local vars + ‘gnugo-frolic-in-the-leaves’, ‘gnugo-frolic-origin’; use + ‘gnugo-frolic-return-to-origin’. + (gnugo-frolic-mode-map): Add bindings for ‘q’, ‘C’, ‘o’. + +2014-04-08 Thien-Thi Nguyen + + [gnugo] Define "GNUGO Frolic" mode. + + * packages/gnugo/gnugo.el (gnugo-frolic-mode): New command, via + ‘define-derived-mode’. + (gnugo-frolic-in-the-leaves): Use it. + +2014-04-07 Thien-Thi Nguyen + + [gnugo int] Insert frolic xrep starting w/ the leaves. + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves ...) + (... tip-p): New internal func. + [breathe in]: Don't construct root-forward lists to display; instead, + note fork if on tip of orig and side branches. + [breathe out]: Start displaying from ‘max-move-num’ down; move to + ‘point-min’ at initially, before each line; pop from copy of ‘ends’ + directly; use ‘point-marker’ for ‘finish’. + +2014-04-07 Thien-Thi Nguyen + + [gnugo int] Move precise fanout computation to "breathe in". + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves link): Use + ‘pushnew’; push the node's branch number directly. + (gnugo-frolic-in-the-leaves): Check for continuation node prior to + appending ‘acc’; link it only on non-empty ‘acc’; in "breathe out", + accumulate into ‘forks’ directly. + +2014-04-07 Thien-Thi Nguyen + + [gnugo int] Decruft: Consolidate "breathe in" loops. + + * packages/gnugo/gnugo.el (gnugo-frolic-in-the-leaves): + ...here, as :monkey no longer confers a priori move-number info. + +2014-04-07 Thien-Thi Nguyen + + [gnugo int] Comment munging; nfc. + +2014-04-07 Thien-Thi Nguyen + + [gnugo int] Avoid lower move-num candidates in déjà-vu search. + + * packages/gnugo/gnugo.el (gnugo-note): Truncate branch search on + encoutering node w/ insufficient move number. + +2014-04-06 Thien-Thi Nguyen + + [gnugo int] Drop :monkey COUNT; use node's tree MNUM directly. + + * packages/gnugo/gnugo.el (gnugo-put): Update :monkey description. + (gnugo-describe-internal-properties): Use ‘gnugo--tree-mnum’; don't + bother w/ :monkey COUNT. + (gnugo-move-history): Use first node's tree MNUM directly. + (gnugo-frolic-in-the-leaves): Compute ‘max-move-num’ from ‘ends’ nodes' + tree MNUM directly; drop hash table ‘order’. + (gnugo-note, gnugo-magic-undo): Don't update :monkey COUNT. + (gnugo-read-sgf-file, gnugo-board-mode): Don't init :monkey COUNT. + +2014-04-06 Thien-Thi Nguyen + + [gnugo int] Maintain tree MNUM. + + * packages/gnugo/gnugo.el (gnugo--tree-mnum): New defsubst. + (gnugo-note): Record new node's move number in the tree MNUM. + (gnugo/sgf-create): Change tree MNUM weakness to ‘key’. + +2014-04-06 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--mkht + + * packages/gnugo/gnugo.el (gnugo--mkht): New defsubst. + (gnugo-frolic-in-the-leaves, gnugo-board-mode) + (gnugo/sgf-create, gnugo/sgf-hang-from-root): Use it. + +2014-04-06 Thien-Thi Nguyen + + [gnugo int] Fix bug: Detect case for KIDS addition correctly. + + Introduced 2014-04-05, "Expand gametree IR: MNUM, KIDS, ROOT". + + * packages/gnugo/gnugo.el (gnugo/sgf-create): For multiple-kids + detection, phase 2, invert gate predicate. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Expand gametree IR: MNUM, KIDS, ROOT. + + * packages/gnugo/gnugo.el (gnugo--tree-ends): Rewrite. + (gnugo--set-tree-ends): Likewise, as a defsubst. + (gnugo-describe-internal-properties): Frob :sgf-gametree, too. + (gnugo--root-node): Rewrite. + (gnugo--set-tree-ends-actually): Delete func. + (gnugo/sgf-root-node): Delete func. + (gnugo/sgf-create TREE): Take also MNUM, KIDS; compute and record move + number of ‘node’; record multiple-kids case in two phases; update + recursive call. + (gnugo/sgf-create): Update call to ‘TREE’; return [MNUM KIDS ENDS + ROOT]. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Invert ‘if’ CONDITION and THEN/ELSE clauses. + + * packages/gnugo/gnugo.el (gnugo/sgf-create): + ...here, to place the "multiple" case as the ELSE. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Use ‘gnugo--tree-ends’ more. + + Omission from 2014-04-05, + "Add abstractions: gnugo--{,set-}tree-ends". + + * packages/gnugo/gnugo.el (gnugo-note, gnugo-magic-undo): ...here. + +2014-04-05 Thien-Thi Nguyen + + [gnugo] Declare dependency on ‘ascii-art-to-unicode’. + + Omission from 2014-04-03, "Add command + ‘gnugo-frolic-in-the-leaves’ and keybinding". + + * packages/gnugo/gnugo.el [Package-Requires]: New header. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Make ‘gnugo--no-regrets’ take ENDS directly. + + * packages/gnugo/gnugo.el (gnugo--no-regrets): ...here. + (gnugo-note, gnugo-magic-undo): Update calls. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Add abstractions: gnugo--{,set-}tree-ends + + * packages/gnugo/gnugo.el + (gnugo--tree-ends): New defsubst. + (gnugo--set-tree-ends-actually): New func. + (gnugo--set-tree-ends): New macro. + (gnugo-frolic-in-the-leaves, gnugo--no-regrets) + (gnugo-read-sgf-file, gnugo-board-mode, gnugo/sgf-root-node): Use + ‘gnugo--tree-ends’. + (gnugo-note): Likewise, and also ‘gnugo--set-tree-ends’. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Use ‘gnugo/sgf-create’ more. + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here, for + uninitialized board setup, instead of manual consing. + +2014-04-05 Thien-Thi Nguyen + + [gnugo] Support SGF[4] parsing from string data. + + * packages/gnugo/gnugo.el + (gnugo-read-sgf-file): Use ‘gnugo/sgf-create’. + (gnugo/sgf-create): Rename from ‘gnugo/sgf-read-file’; rename 1st arg + to FILE-OR-DATA; take optional 2nd arg DATA-P; if DATA-P set, arrange + to parse FILE-OR-DATA directly. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Avoid double list-reverse. + + * packages/gnugo/gnugo.el (gnugo-describe-internal-properties): Use ‘do + (push ...)’ instead of ‘collect’ in ‘loop’; don't ‘reverse’ the result + later. + +2014-04-05 Thien-Thi Nguyen + + [gnugo int] Specify STREAM to ‘pp’ directly. + + * packages/gnugo/gnugo.el (gnugo-describe-internal-properties): + ...here, instead of ‘let’-binding ‘standard-output’. + +2014-04-04 Thien-Thi Nguyen + + [gnugo int] Remove abstraction: continue-on + + * packages/gnugo/gnugo.el (gnugo-note): ...here, inlining it. + +2014-04-04 Thien-Thi Nguyen + + [gnugo int] Support growth also off of main line. + + * packages/gnugo/gnugo.el (gnugo-note): For déjà-vu check, don't start + w/ ‘bidx’ if no regrets; also, copy the old branch immediately to its + right, instead of placing it at the end of the ends vector. + +2014-04-03 Thien-Thi Nguyen + + [gnugo int] Use ‘cl-labels’ less. + + * packages/gnugo/gnugo.el (gnugo-move-history): Use ‘cl-flet*’. + (gnugo-note, gnugo-close-game, gnugo-toggle-dead-group) + (gnugo-display-final-score, gnugo/sgf-read-file): Use ‘cl-flet’. + (:gnugo-gtp-command-spec): Use ‘cl-flet*’, ‘cl-flet’. + +2014-04-03 Thien-Thi Nguyen + + [gnugo int] Use ‘gnugo--as-pos-func’ more. + + * packages/gnugo/gnugo.el (gnugo-move-history): ...here. + +2014-04-03 Thien-Thi Nguyen + + [gnugo] Add command ‘gnugo-frolic-in-the-leaves’ and keybinding. + + * packages/gnugo/gnugo.el: Require ‘ascii-art-to-unicode’. + (gnugo--as-pos-func): New func. + (gnugo-frolic-in-the-leaves): New command. + (gnugo-board-mode-map): Bind ‘L’ to ‘gnugo-frolic-in-the-leaves’. + +2014-04-03 Thien-Thi Nguyen + + [gnugo maint] Add some debugging aids to HACKING; nfc. + +2014-03-29 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--move-prop + + * packages/gnugo/gnugo.el (gnugo--move-prop): New defsubst. + (gnugo-move-history, gnugo-read-sgf-file): Use it. + +2014-03-28 Thien-Thi Nguyen + + [gnugo] Add command ‘gnugo-oops’ and keybinding. + + * packages/gnugo/gnugo.el (gnugo--no-regrets): New defsubst. + (gnugo-note): Detect déjà-vu; handle non-tip growth. + (gnugo-magic-undo): Take optional 3rd arg KEEP; inhibit truncation if + non-nil or if already "remorseful". + (gnugo-oops): New command. + (gnugo-board-mode-map): Bind ‘o’ to ‘gnugo-oops’. + +2014-03-28 Thien-Thi Nguyen + + [gnugo] Move "1 or 2" calculation into ‘gnugo-magic-undo’. + + * packages/gnugo/gnugo.el (gnugo-magic-undo): ...here. + (gnugo-undo-two-moves): Update call to ‘gnugo-magic-undo’. + +2014-03-26 Thien-Thi Nguyen + + [gnugo maint] Move hi-lock hint from NEWS to HACKING; nfc. + +2014-03-24 Thien-Thi Nguyen + + [gnugo int] Invert gametree IR to hang by the leaves. + + * packages/gnugo/gnugo.el (gnugo-put): Update :monkey doc. + (gnugo-describe-internal-properties): Update :monkey transform. + (gnugo-move-history): Use :monkey MEM directly. + (gnugo-move-history finish): Don't use ‘next’ rv as continuation + condition; instead, use non-nil ‘mem’. + (gnugo-note): Use :monkey MEM directly; rework link wrangling. + (gnugo-read-sgf-file): Update :monkey init. + (gnugo-magic-undo): Rework link wrangling. + (gnugo-board-mode): Update :sgf-gametree and :monkey init. + (gnugo/sgf-root-node): Rewrite. + (gnugo/sgf-read-file morep): New internal func. + (gnugo/sgf-read-file seek): Use ‘morep’. + (gnugo/sgf-read-file TREE): Rewrite to hang by the leaves. + (gnugo/sgf-read-file): Iterate at collection level. + (gnugo/sgf-hang-from-root): New func. + (gnugo/sgf-write-file): Use ‘gnugo/sgf-hang-from-root’. + +2014-03-24 Thien-Thi Nguyen + + [gnugo int] Embrace (NODE[...] [SUBTREE...]) IR, for now. + + It's not so bad, after all. OTOH, hanging by the leaves is better. + + * packages/gnugo/gnugo.el (gnugo/sgf-read-file TREE): Use ‘nconc’. + (gnugo/sgf-write-file >>tree): Use ‘dolist’. + +2014-03-24 Thien-Thi Nguyen + + [gnugo int] Use ‘pop’ more. + + * packages/gnugo/gnugo.el (gnugo-move-history next): ...here. + +2014-03-23 Thien-Thi Nguyen + + [gnugo int] Remove redundant game-over condition check. + + * packages/gnugo/gnugo.el (gnugo-read-sgf-file): ...here. + +2014-03-21 Thien-Thi Nguyen + + [gnugo sgf] Normalize PASS internal rep on read, as "". + + * packages/gnugo/gnugo.el + (gnugo-move-history as-pos): Expect "" for PASS. + (gnugo-note mog): Produce "" for PASS. + (gnugo-read-sgf-file): Don't normalize PASS to "tt". + (gnugo/sgf-read-file): Keep track of SZ property. + (gnugo/sgf-read-file one): For ‘stone’, ‘point’ and ‘move’ types, + substitute "tt" with "" if we know ‘SZ’ and it's <= 19. + (gnugo/sgf-read-file NODE): Save SZ property value if found. + +2014-03-20 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--nodep + + * packages/gnugo/gnugo.el (gnugo--nodep): New defsubst. + (gnugo-read-sgf-file, gnugo/sgf-write-file): Use it. + +2014-03-20 Thien-Thi Nguyen + + [gnugo] Fix bug: On load, follow mainline through subtrees. + + * packages/gnugo/gnugo.el (gnugo-read-sgf-file): For move count loop, + don't stop at first subtree; instead, recognize its non-nodeness and + recurse into it. + +2014-03-19 Thien-Thi Nguyen + + [gnugo maint] NEWS futzing; nfc. + +2014-03-19 Thien-Thi Nguyen + + [gnugo] Fix bug: Don't misuse SGF prop ‘:EV’ for "resign" state. + + * packages/gnugo/gnugo.el (gnugo-push-move): ...here. + (gnugo-display-final-score): Detect resignation via + ‘gnugo-move-history’; use ‘:last-mover’ directly. + +2014-03-19 Thien-Thi Nguyen + + [gnugo] Fix bug: Don't bother translating move "resign". + + * packages/gnugo/gnugo.el + (gnugo-move-history as-pos-maybe): New internal func. + (gnugo-move-history next): Use ‘as-pos-maybe’. + +2014-03-19 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--passp + + * packages/gnugo/gnugo.el (gnugo--passp): New defsubst. + (gnugo-note, gnugo-push-move, gnugo-magic-undo): Use it. + +2014-03-19 Thien-Thi Nguyen + + [gnugo int] Use ‘loop’ instead of ‘mapc’ + ‘apply’. + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here. + +2014-03-19 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--blackp + + * packages/gnugo/gnugo.el (gnugo--blackp): New defsubst. + (gnugo-other, gnugo-push-move, gnugo-refresh) + (gnugo-magic-undo, gnugo-display-final-score, gnugo): Use it. + +2014-03-19 Thien-Thi Nguyen + + [gnugo int] Decruft: Infer MOVEP from PROPERTY. + + * packages/gnugo/gnugo.el (gnugo-note): Don't take optional arg MOVEP; + instead, infer that the operation is a move if PROPERTY is ‘:B’ or + ‘:W’. + (gnugo-push-move): Update call to ‘gnugo-note’. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Use ‘setq’ less. + + * packages/gnugo/gnugo.el (gnugo-move-history): ...here. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Use ‘incf’ more. + + * packages/gnugo/gnugo.el (gnugo-note, gnugo-refresh): ...here. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Add abstractions: gnugo{--root-node,/sgf-root-node} + + * packages/gnugo/gnugo.el (gnugo--root-node): New func. + (gnugo--root-prop): Rename from ‘gnugo-treeroot’; take optional arg + TREE; default to :sgf-gametree if not specified. + (gnugo--set-root-prop, gnugo--unclose-game): Use ‘gnugo--root-node’. + (gnugo-read-sgf-file): Use ‘gnugo--root-prop’, specifying TREE. + (gnugo-display-final-score, gnugo): Use ‘gnugo--root-prop’. + (gnugo/sgf-root-node): New func. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Use ‘gnugo-treeroot’ more. + + * packages/gnugo/gnugo.el (gnugo-read-sgf-file): ...here. + +2014-03-18 Thien-Thi Nguyen + + [gnugo] Handle ‘(gnugo-move-history 'two)’. + + * packages/gnugo/gnugo.el (gnugo-move-history): If RSEL is ‘two’, + return the last two moves as a list. + (gnugo-read-sgf-file): Use ‘gnugo-move-history’. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Add abstraction: nn + + * packages/gnugo/gnugo.el (gnugo-move-history nn): New internal func. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Use ‘loop’ instead of ‘dolist’ + ‘destructuring-bind’. + + See: + . + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Use ‘setq’ less. + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--set-root-prop + + * packages/gnugo/gnugo.el (gnugo--set-root-prop): New func. + (gnugo-display-final-score, gnugo/sgf-write-file): Use it. + +2014-03-18 Thien-Thi Nguyen + + [gnugo int] Cache gametree prop ‘:SZ’ as gnugo prop ‘:SZ’. + + * packages/gnugo/gnugo.el (gnugo-goto-pos) + (gnugo-propertize-board-buffer, gnugo-move-history) + (gnugo-note, gnugo-refresh, gnugo): Get board size via ‘gnugo-get’ + instead of ‘gnugo-treeroot’. + (gnugo--SZ!): New defsubst. + (gnugo-read-sgf-file, gnugo-board-mode) + (:gnugo-gtp-command-spec boardsize): Use ‘gnugo--SZ!’. + +2014-03-14 Thien-Thi Nguyen + + [gnugo int] Use ‘following-char’ instead of ‘char-after’. + + * packages/gnugo/gnugo.el (gnugo-animate-group + (gnugo-magic-undo, gnugo/sgf-read-file): ...here. + +2014-03-14 Thien-Thi Nguyen + + [gnugo sgf] Fix bug: Output subtrees correctly. + + Long-standing -- from inception -- omission. + + * packages/gnugo/gnugo.el (gnugo/sgf-write-file >>tree): Don't assume + all elements of a tree are nodes; instead, handle nodes as before, and + recurse on trailing subtree elems. + +2014-03-14 Thien-Thi Nguyen + + [gnugo sgf int] Add abstractions: seek, seek-into + + * packages/gnugo/gnugo.el (gnugo/sgf-read-file): + ...here, as internal funcs via ‘cl-labels’. + (gnugo/sgf-read-file NODE): Rewrite. + (gnugo/sgf-read-file TREE): Likewise, w/ arg LEV. + (gnugo/sgf-read-file): Call ‘TREE’ once, w/ LEV 0. + +2014-03-14 Thien-Thi Nguyen + + fixup! [gnugo sgf] Move gratuitous newline from after to before + (sub)trees. + +2014-03-14 Thien-Thi Nguyen + + [gnugo sgf] Move gratuitous newline from after to before (sub)trees. + + * packages/gnugo/gnugo.el (gnugo/sgf-write-file >>tree): At the start, + insert a newline if not at bol; at the end, don't insert a newline. + (gnugo/sgf-write-file): Insert a newline at EOF. + +2014-03-14 Thien-Thi Nguyen + + [gnugo sgf int] Add abstractions: >>prop, >>node, >>tree + + * packages/gnugo/gnugo.el (gnugo/sgf-write-file): + ...here, as internal funcs via ‘cl-labels’. + +2014-03-13 Thien-Thi Nguyen + + [gnugo] Fix bug: Handle property value type ‘none’ normally. + + * packages/gnugo/gnugo.el (gnugo/sgf-read-file one): No longer special + case property value type ‘none’; instead, read the supplied value and + discard it, saving instead a hardcoded empty string, i.e., "". + +2014-03-13 Thien-Thi Nguyen + + [gnugo int] Rename arg from SWITCH to ME-NEXT. + + * packages/gnugo/gnugo.el (gnugo-undo-one-move): ...here. + +2014-03-11 Thien-Thi Nguyen + + [gnugo] Make ‘C-u M-u’ switch roles. + + * packages/gnugo/gnugo.el (gnugo-undo-one-move): Add optional arg + SWITCH; if specified, arrange for user to play the color of the next + move (and GNU Go the opposite). + +2014-03-11 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--who-is-who + + * packages/gnugo/gnugo.el (gnugo--who-is-who): New func. + (gnugo-read-sgf-file): Use it. + +2014-03-10 Thien-Thi Nguyen + + [gnugo] Bind ‘M-u’ to ‘gnugo-undo-one-move’. + + * packages/gnugo/gnugo.el (gnugo-board-mode-map): ...here. + +2014-03-10 Thien-Thi Nguyen + + [gnugo maint] Update NEWS; nfc. + +2014-03-10 Thien-Thi Nguyen + + [gnugo int] Use ‘incf’ more. + + * packages/gnugo/gnugo.el + (gnugo-merge-showboard-results) + (gnugo-display-final-score): ...here. + +2014-03-10 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--compare-strings + + * packages/gnugo/gungo.el (gnugo--compare-strings): New defsubst. + (gnugo--q, gnugo-merge-showboard-results): Use it. + +2014-03-10 Thien-Thi Nguyen + + [gnugo int] Use ‘loop’, functional style more. + + * packages/gnugo/gnugo.el (gnugo-describe-internal-properties): + ...here, for collecting/massaging ‘gnugo-state’, instead of ‘maphash’, + "manual" destructuring, mutation. + +2014-03-09 Thien-Thi Nguyen + + [gnugo int] Associate process w/ buffer immediately. + + * packages/gnugo/gnugo.el (gnugo-board-mode): + ...here, via ‘start-process’ 2nd arg BUFFER. + +2014-03-09 Thien-Thi Nguyen + + [gnugo int] Avoid redundant calls to ‘gnugo-get’. + + * packages/gnugo/gnugo.el (gnugo-move-history): + (gnugo-read-sgf-file, gnugo-magic-undo, gnugo-display-final-score) + (gnugo-board-mode): Add local vars to save ‘gnugo-get’ values. + +2014-03-09 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--begin-exchange + + * gnugo.el (gnugo-send-line): Delete func. + (gnugo--begin-exchange): New func. + (gnugo--q, gnugo-get-move): Use it. + +2014-03-08 Thien-Thi Nguyen + + [gnugo int] Elide single-use local var. + + Omission from 2014-03-06, "Streamline subproc (de-)marshalling". + + * gnugo.el (gnugo--q): ...here, for var ‘so-far’. + +2014-03-08 Thien-Thi Nguyen + + [gnugo int] Use ‘pcase’ more. + + * gnugo.el (gnugo-move-history): + ...here, instead of ‘if’ + ‘case’. + +2014-03-06 Thien-Thi Nguyen + + [gnugo maint] Reindent; nfc. + +2014-03-06 Thien-Thi Nguyen + + [gnugo int] Use ‘eq’ less. + + * gnugo.el (gnugo-sentinel): Use ‘memq’. + (gnugo-move-history finish): New func. + (gnugo-move-history): Use ‘if’, ‘case’, ‘finish’. + (:gnugo-gtp-command-spec help): Use ‘if’, ‘case’. + +2014-03-06 Thien-Thi Nguyen + + [gnugo int] Streamline subproc (de-)marshalling. + + * packages/gnugo/gnugo.el (gnugo--q): Rename from + ‘gnugo-synchronous-send/return’; change args from MESSAGE to FMT and + ARGS; apply ‘format’ if non-null ARGS; use ‘compare-strings’ instead of + ‘string-match’; use separate state to signal finish instead of type + change; don't bother with ‘current-time’; return string. + (gnugo-query): Update call, docstring. + (gnugo-propertize-board-buffer, gnugo-merge-showboard-results) + (gnugo-move, gnugo-pass, gnugo-display-group-data) + (gnugo-read-sgf-file, gnugo-magic-undo, gnugo-command): Update calls. + +2014-03-04 Thien-Thi Nguyen + + [gnugo int] Use ‘dolist’, ‘destructuring-bind’ more. + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here, instead of + ‘mapc’ + ‘apply’, for post-‘-l’ fixup. + +2014-02-27 Thien-Thi Nguyen + + [gnugo] Release: 2.3.1 + + * packages/gnugo/gnugo.el [Version]: Bump to "2.3.1". + (gnugo-version): Bump to "2.3.1". + +2014-02-27 Thien-Thi Nguyen + + [gnugo slog] Fix bug: Avoid ‘cl-lib’ funcs; use only macros. + + This silences byte-compiler warnings under Emacs 24.4. Regression + introduced 2014-01-30, "Use ‘cl-labels’ instead of ‘flet’". Reported by + Juanma Barranquero: + . + + * gnugo.el: Don't require ‘cl-lib’; instead, require ‘cl’, and wrap + with ‘eval-when-compile’. + (gnugo-animate-group): Use ‘loop’, ‘zerop’, ‘logand’. + (gnugo-describe-position): Use ‘loop’. + +2014-02-27 Juanma Barranquero + + [gnugo slog] Specify second arg to ‘unintern’. + + * packages/gnugo/gnugo.el (gnugo-cleanup): ...here. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Release: 2.3.0 + + * packages/gnugo/gnugo.el [Version]: Bump to "2.3.0". + (gnugo-version): Bump to "2.3.0". + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Update NEWS, HACKING; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Rename var to ‘gnugo-inhibit-refresh’. + + * packages/gnugo/gnugo.el (gnugo-inhibit-refresh): New defvar. + (gnugo-post-move-hook): Update docstring. + (gnugo-get-move-insertion-filter, gnugo-move) + (gnugo-pass): Update refs. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Fix bug: Compute grid spacing using offset math. + + OBOE introduced 2006-04-09 (release 2.2.13). + + * packages/gnugo/gnugo.el (gnugo-refresh): Don't use ‘wmul’ directly to + compute ‘gspc’; instead, use one plus the re-derived image pixel-width. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Update NEWS; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] New command: ‘_’ and ‘M-_’ (gnugo-boss-is-near) + + * packages/gnugo/gnugo.el (gnugo-boss-is-near): New command. + (gnugo-board-mode-map): Bind ‘_’ and ‘M-_’ to it. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] New command: ‘A’ (gnugo-switch-to-another) + + * packages/gnugo/gnugo.el + (gnugo-switch-to-another): New command. + (gnugo-board-mode-map): Bind ‘A’ to it. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Bind ‘DEL’ to ‘gnugo-undo-two-moves’. + + * packages/gnugo/gnugo.el (gnugo-board-mode-map): ...here. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Update HACKING; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use internal macros more. + + * packages/gnugo/gnugo.el + (:gnugo-gtp-command-spec deffull): New macro. + (:gnugo-gtp-command-spec): Use it for ‘:full’ specs. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Make proc-status change mode-line elem more informative. + + * packages/gnugo/gnugo.el (gnugo-sentinel): ...here, by including the + passed-in STRING, w/ ‘font-lock-warning-face’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Use special constructs for keybindings in docstrings. + + * packages/gnugo/gnugo.el (gnugo-board-mode, gnugo): Rewrite docstring. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Don't show underscore in group-animation message. + + * packages/gnugo/gnugo.el (gnugo-animate-group): Don't take COMMAND; + instead, take W/D, a symbol; construct command w/ it; rework messages + accordingly. + (gnugo-worm-stones): Update call to ‘gnugo-animate-group’. + (gnugo-dragon-stones): Likewise. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Fix bug: Relax sync regexp. + + * packages/gnugo/gnugo.el (gnugo-merge-showboard-results): ...here, to + handle certain increases in captured stones count. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Update "next" in HACKING; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Revamp gnugo-{put,get} doc / indentation decl. + + * packages/gnugo/gnugo.el (gnugo-put): Move shared docstring here; + specialize it; replace top-level direct symbol-plist assignment w/ an + internal ‘declare’ form for indentation. + (gnugo-get): Add docstring. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use ‘dolist’ and ‘destructuring-bind’. + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here, instead of + ‘mapc’ and ‘apply (lambda () ...)’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use ‘set-process-query-on-exit-flag’. + + * packages/gnugo/gnugo.el (gnugo-board-mode): ...here, instead of + avoiding ‘process-kill-buffer-query-function’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Zonk unused local var. + + * packages/gnugo/gnugo.el (gnugo-command): ...here, named + ‘last-message’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Use ‘user-error’. + + * packages/gnugo/gnugo.el (gnugo-gate) + (gnugo-synchronous-send/return, gnugo-toggle-image-display) + (gnugo-position, gnugo-pass, gnugo-animate-group) + (gnugo-toggle-dead-group, gnugo-write-sgf-file) + (gnugo-read-sgf-file, gnugo-magic-undo) + (gnugo-display-final-score, gnugo-board-mode): ...here. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Add abstraction: gnugo--unclose-game + + * packages/gnugo/gnugo.el (gnugo--unclose-game): New func. + (gnugo-magic-undo): Use it. + (boardsize, clear_board, fixed_handicap): Likewise, in the value of the + ‘:post-thunk’ property. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Update NEWS file; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Indicate buffer not modified after load. + + * packages/gnugo/gnugo.el (gnugo-read-sgf-file): Clear buffer-modified + state at end. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Drop leading "*" in docstrings. + + * packages/gnugo/gnugo.el (gnugo-program, gnugo-board-mode-hook) + (gnugo-post-move-hook, gnugo-animation-string, gnugo-mode-line) + (gnugo-X-face, gnugo-O-face, gnugo-grid-face): ...here. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Hang the sync-return-stash on the process object. + + * packages/gnugo/gnugo.el (gnugo-synchronous-send/return): Don't use + ‘gnugo-put’, ‘gnugo-get’; instead, use + ‘process-put’, ‘process-get’ with property ‘:srs’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Give names and docstrings to ‘lambda’ commands. + + * packages/gnugo/gnugo.el (gnugo-quit, gnugo-leave-me-alone) + (gnugo-fancy-undo, gnugo-toggle-image-display-command) + (gnugo-describe-position): New commands. + (gnugo-board-mode-map): Bind ‘q’, ‘Q’, ‘U’, ‘i’, ‘=’ to them. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use cl-{plus,minus}p more. + + * packages/gnugo/gnugo.el (gnugo-merge-showboard-results) + (gnugo-venerate, gnugo-refresh, gnugo-magic-undo) + (gnugo-board-mode, gnugo, GTP undo, GTP gg-undo): Use ‘cl-plusp’ and + ‘cl-minusp’ instead of comparison against 0. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use ‘number-sequence’ more. + + * packages/gnugo/gnugo.el (gnugo-animate-group): For image display + ‘spec’ handling, don't map over an exploded string, ignoring the + individual characters, and manually toggling the state; instead, map + over an integer, using the number's divisibility by two to select. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Drop unused local var. + + * packages/gnugo/gnugo.el (gnugo-venerate): ...here, named ‘lb’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Add .dir-locals.el file, link in HACKING; nfc. + + * .dir-locals.el: New file. + +2014-02-24 Thien-Thi Nguyen + + [gnugo gtp int] Use :post-thunk instead of :post-hook. + + * packages/gnugo/gnugo.el (gnugo-command): Consult :post-thunk, if set, + ‘funcall’ the value. + (:gnugo-gtp-command-spec add): Delete. + (:gnugo-gtp-command-spec defgtp): Use ‘jam’ unconditionally. + (:gnugo-gtp-command-spec): Do ‘s/:post-hook/:post-thunk/g’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Avoid variable FORMAT for ‘message’. + + We don't want weirdness should the variable value include ‘?%’. + + * packages/gnugo/gnugo.el (gnugo-command): Don't use var as + ‘message’ first arg; instead say ‘(message "%s" ...)’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Revamp "ChangeLog discipline" in HACKING; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Update a musing item in HACKING; nfc. + + Although it would be nice to avoid a "merge commit" through constant + rebase (such that the final merge can be a fast-forward operation), + that makes it painful / difficult for others to follow. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Indicate buffer not modified after save. + + * packages/gnugo/gnugo.el (gnugo-animate-group): Use current value of + ‘buffer-modified-p’ in loop instead of ‘t’. + (gnugo-write-sgf-file): Clear buffer-modified state. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Update "next" in HACKING; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use ‘(split-string STR SEP t)’. + + * packages/gnugo/gnugo.el (gnugo-animate-group): ...here, instead of + manually deleting the empty strings returned from a two-arg call to + ‘split-string’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use ‘display’ property more. + + * packages/gnugo/gnugo.el (gnugo-toggle-image-display): ...here, with + ‘(space :width 0)’, instead of ‘invisible’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use ‘redisplay’ more. + + * packages/gnugo/gnugo.el (gnugo-magic-undo): + ...here, instead of ‘(sit-for 0)’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo doc] Document version-number scheme. + + * packages/gnugo/gnugo.el (gnugo-version): Rewrite docstring. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Add HACKING; prune Commentary; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Don't use ‘process-kill-buffer-query-function’. + + * packages/gnugo/gnugo.el (gnugo-board-mode): Make + ‘kill-buffer-query-functions’ buffer-local and then remove + ‘process-kill-buffer-query-function’ from it. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Wait at most 30sec for subproc output chunk. + + * packages/gnugo/gnugo.el (gnugo-synchronous-send/return): Specify + TIMEOUT of 30 seconds to ‘accept-process-output’. + +2014-02-24 Thien-Thi Nguyen + + [gnugo int] Use ‘zerop’. + + * packages/gnugo/gnugo.el (gnugo-cleanup) + (gnugo-magic-undo, gnugo-board-mode): ...here. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Presume "modern" GNU Emacs. + + * packages/gnugo/gnugo.el (delete-dups, window-edges): Delete these + conditionally-‘defun’ed funcs. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Presume working time-date.el. + + * packages/gnugo/gnugo.el: Require ‘time-date’ w/o ignoring errors. + (time-subtract): Delete conditionally-‘defun’ed func. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Use ‘cl-labels’ instead of ‘flet’. + + * packages/gnugo/gnugo.el: Don't require ‘cl’; instead, require + ‘cl-lib’; do ‘s/flet/cl-labels/g’. + (gnugo-note): Use #'mog instead of 'mog as ‘mapcar’ 1st arg. + (gnugo-toggle-dead-group): Use #'populate. + (:gnugo-gtp-command-spec defgtp): Use #'jam, #'add. + (gnugo/sgf-write-file): Use #'one, #'two. + +2014-02-24 Thien-Thi Nguyen + + [gnugo maint] Add NEWS file; prune Commentary; nfc. + +2014-02-24 Thien-Thi Nguyen + + [gnugo] Adapt copyright notice to FSF, headers to ELPA. + + * packages/gnugo/gnugo.el: ...here. + +2014-02-24 Thien-Thi Nguyen + + Import gnugo.el from ttn-pers-elisp 1.59. + + * packages/gnugo/gnugo.el: New file. + (gnugo-version): Bump to "2.2.14". + +2014-02-24 Thien-Thi Nguyen + + Start building eventual package ‘gnugo’. + + * packages/gnugo/: New directory. + * packages/gnugo/README: New file. + diff --git a/elpa/gnugo-3.0.0/HACKING b/elpa/gnugo-3.0.0/HACKING new file mode 100644 index 0000000..9c0c277 --- /dev/null +++ b/elpa/gnugo-3.0.0/HACKING @@ -0,0 +1,82 @@ +HACKING gnugo -*- org -*- + +This file is both a guide for newcomers and a todo list for oldstayers. + +* next +*** newbie support +***** "don't panic" button :-D +***** on gnugo.el load, check [[file:gnugo.el::defvar.gnugo-program][gnugo-program]], set "ready" state +***** rat concessions :-/ +***** (?) ootb ‘gnugo-image-display-mode’ in ‘gnugo-start-game-hook’ +* fix bugs +*** empty tree from many back/forw +***** intermittent, grr +***** manifests as ‘()’ (empty list) in .sgf (on write) +*** {next,previous}-line weirdness in the presence of images +*** no error-handling in SGF parsing +* performance +*** ‘compare-strings’ approach too clever/slow :-/ +*** cache frolic fruits +* ideas / wishlist +*** wrap GTP ‘loadsgf’ completely +*** revamp image support +***** DONE zonk ‘require’ +***** define simple API +*** talk GTP over the network + (?) pending [[wrap GTP ‘loadsgf’ completely]] +*** make gnugo (the external program) support query (read-only) thread +*** extend GNUGO Board mode to manage another subprocess for analysis only +*** command to label a position +*** SGF tree traversal +***** DONE monkey mind +***** TODO monkey body +*** "undo undo undoing" +***** integrate Emacs undo, GTP undo, subgame branching +***** (?) use [[file:../undo-tree/][../undo-tree/]] +*** make buffer name format configurable (but enforce uniqueness) +*** more tilde escapes for [[file:gnugo.el::defvar.gnugo-mode-line][gnugo-mode-line]] +*** make veneration configurable (see also [[SVG display]]) +*** animation finery +***** make more configurable +***** lift same-color-stones-only restriction +***** allow sequencing rather than lock-step +***** include sound +*** plunder el-go (grok [[info:eieio.info][EIEIO]] first) +***** SVG display + pending [[revamp image support]] +***** (?) SGF support +******* IR compat +******* error handling +***** (?) other "backends" + pending [[talk GTP over the network]] +*** [your hacking ideas here!] +* tested with (newest first) + | Emacs | GNU Go | + |-----------+--------| + | 24.3.50.3 | 3.8 | + | ? | 3.6 | + | ? | 3.4 | + | ? | 3.3.15 | + | 22.0.50 | ? | + | 21.3 | ? | + |-----------+--------| + | | | +* ChangeLog discipline +*** based on [[info:standards#Change%20Logs][GNU Coding Standards]] +*** commit-message format +***** basic: TITLE LF LF [DISCUSSION...] LF LF CLASSIC +***** short: TITLE-FRAGMENT "; nfc." [LF LF DISCUSSION...] +*** don't bother w/ ChangeLog for "short" commit-message format +* other conventions: see [[file:.dir-locals.el][.dir-locals.el]] +* NEWS nostalgia +(with-current-buffer (find-file "NEWS") + (highlight-phrase "[0-9][.][0-9][.][0-9]+\\|[0-9]+[.][.][0-9]+" + 'hi-red-b)) +* etc +#+odd + + +Copyright (C) 2014 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted provided the copyright notice and this notice are preserved. diff --git a/elpa/gnugo-3.0.0/NEWS b/elpa/gnugo-3.0.0/NEWS new file mode 100644 index 0000000..ac2329e --- /dev/null +++ b/elpa/gnugo-3.0.0/NEWS @@ -0,0 +1,205 @@ +NEWS for gnugo.el (et al) +See the end for copying conditions. + +NB: "RCS: X..Y " means that the particular release includes + changes in the RCS repo, revision 1.X through 1.Y (inclusive). + + +- 3.0.0 | 2014-07-22 + - bugfixes + - on write, use ‘\’ to escape certain chars + - preserve whitespace for value type ‘text’ + - don't special-case property value type ‘none’ + - handle subtrees on write + - display "resign" as "resign" in move history (amazing!) + - avoid clobbering SGF property ‘EV’ on resignation + - follow main line in subtrees on read + - for ‘F’ forced PASS moves, keep subproc informed as well + - proper support for ‘-l FILENAME’ / ‘--infile FILENAME’ + - dropped support for ‘gnugo-program’ of form "PROGRAM OPTIONS..." + - dropped command: ‘t’ (gnugo-toggle-dead-group) + - changes to ‘gnugo-xpms’ + - now a normal var, and not a feature + - value can be a function to compute XPMs + - ‘gnugo-image-display-mode’ replaces ‘gnugo-toggle-image-display-command’ + - ‘gnugo-grid-mode’ replaces ‘gnugo-toggle-grid’ + - PASS for SZ <= 19 normalized to "" on read, written as "" + - ‘=’ also displays move number of the stone (if any) at that position + - ‘C-u F’ adds the (abbreviated) blurb as a comment to the last node + - new keybinding for ‘gnugo-undo-one-move’: M-u + - you can play a move for GNU Go, e.g., after ‘M-u’ + - ‘gnugo-undo-one-move’ can optionally arrange for you to play next + - new command: ‘S’ (gnugo-request-suggestion) + - new command: ‘C’ (gnugo-comment) + - new command: ‘o’ (gnugo-oops) + - new command: ‘O’ (gnugo-okay) + - new command: ‘L’ (gnugo-frolic-in-the-leaves) + - new command: ‘C-c C-a’ (gnugo-assist-mode) + - new command: ‘C-c C-z’ (gnugo-zombie-mode) + - new var: gnugo-undo-reaction + - new major mode: GNUGO Frolic (gnugo-frolic-mode) + - separate feature/file: ‘gnugo-frolic’ + - ‘gnugo-frolic-in-the-leaves’ autoloaded + - new support for dynamic XPM generation + - separate feature/file: ‘gnugo-imgen’ + - func ‘gnugo-imgen-create-xpms’ suitable for ‘gnugo-xpms’ (see above) + - GNUGO Board mode now derived from Special mode + - position arg validated for direct GTP commands ‘undo’, ‘gg-undo’ + - undo commands no longer signal error on overkill + - SGF prop ‘AP’ set only for modified gametrees + - SGF I/O commands change ‘default-directory’ + - performance improvements + - of interest to hackers (see source, BI => backward incompatible) + - dropped var: ‘gnugo-inhibit-refresh’ (BI) + - ‘gnugo/sgf-read-file’ renamed to ‘gnugo/sgf-create’ and enhanced + - ‘:sgf-gametree’ internal representation inverted (BI) + - ‘gnugo-magic-undo’ internalized + - new func: ‘gnugo-current-player’ + - new hook: ‘gnugo-start-game-hook’ + - ‘gnugo-board-mode-hook’ now unsuitable for prop munging (BI) + - changes to ‘gnugo-move-history’ + - dropped ‘(gnugo-move-history 'count)’ (BI) + - returns last two moves w/ RSEL ‘two’ + - returns position of last placed stone w/ RSEL ‘bpos’ + 2nd arg COLOR + +- 2.3.1 | 2014-02-27 + - portability fixes + +- 2.3.0 | 2014-02-24 + - now part of ELPA, tweaked for GNU Emacs 24.x + - dropped support for XEmacs and older Emacs + - use ‘user-error’ for user errors + - bugfixes + - handle sudden jump in captured stones correctly + - rename hook-communication var w/ "gnugo-" prefix + - (w/ images) grid top/bottom row spacing + - on SGF save/load indicate buffer not modified + - documentation improvements + - version numbering scheme documented: MAJOR.MINOR.PATCH + - keybinding constructs for ‘gnugo’ and ‘gnugo-board-mode’ + - message for worm/dragon animation avoids underscore + - new commands + - ‘A’ (gnugo-switch-to-another) + - ‘_’ and ‘M-_’ (gnugo-boss-is-near) -- was ‘bury-buffer’ + - new keybinding for ‘gnugo-undo-two-moves’: DEL + +- 2.2.14 | 2008-03-03 + - start error message w/ a capital letter + - use ‘(error "%s" X)’ instead of ‘(error X)’ + - improve ‘gnugo-animation-string’ docstring + +- 2.2.13 | 2006-04-10 + - grid (letters and numbers) visibility can be toggled + - display bug workaround + - performance improvements + +- 2.2.12 | 2006-04-06 + - bugfix: handle "" as "PASS" + +- 2.2.11 | 2005-04-06 + - new mode-line specifier: ‘~m’ + - directory no longer accepted as SGF "file name" + +- 2.2.10 | 2005-02-04 + - bugfix: detect "game over" more precisely + - new command: ‘C-c C-p’ (gnugo-describe-internal-properties) + - don't include comment in sgf write + - set ‘AP’ (application) property in gametree + +- 2.2.9 | 2004-12-29 + - backward-portability fix + +- 2.2.8 | 2004-11-15 + - new command: ‘h’ (gnugo-move-history) + - improve font-lock support + - support "count of moves" SPEC via prefix-arg to ‘U’ + +- 2.2.7 | 2004-11-10 + - bugfix: inform backend of PASS + - new command: ‘u’ (gnugo-undo-two-moves) + +- 2.2.6 | 2004-11-05 + - new commands + - ‘l’ (gnugo-read-sgf-file) + - ‘U’ (lambda that calls ‘gnugo-magic-undo’) + - doc improvements + - make some load-time actions one-shot + +- 2.2.5 | 2004-11-02 + - bugfix: make load-time actions referentially-transparent + - require Emacs w/ ‘gethash’, ‘puthash’, ‘make-hash-table’ + +- 2.2.4 | 2004-11-01 + - backward-portability fixes + +- 2.2.3 | 2004-10-30 + - backward-portability fixes + - new command: ‘R’ (gnugo-resign) + +- 2.2.2 | 2004-10-29 + - backward-portability fixes + +- 2.2.1 | 2004-09-07 + - SGF bugfix: parse float correctly (for komi) + - new command: ‘F’ (gnugo-display-final-score) + - font-locking for "X", "O", "[xo]" + +- 2.2.0 | 2004-08-30 + - uncluttered, letters and numbers hidden, board centered + - buffer name shows last move and current player + - mode-line customization (var ‘gnugo-mode-line’) + - new commands + - ‘=’ -- display current position in echo area + - ‘s’ (gnugo-write-sgf-file) + - program option customization (var ‘gnugo-program’) + - new hooks + - ‘gnugo-post-move-hook’ + - ‘gnugo-board-mode-hook’ + - multiple independent buffers/games + - XPM set can be changed on the fly (global and/or local) + - RCS: 25..26 (1.24-1.26 diff posted 2003-01-28) + +- 2.1.0 | 2003-01-10 + - doc fixes + - add XPM image support + - new keybinding: ‘;’ (gnugo-command) + - new commands: + - ‘i’ -- toggle image display + - ‘mouse-down-1’ (gnugo-mouse-move) + - ‘mouse-down-3’ (gnugo-mouse-pass) + - ‘gnugo-command’ rewrite + - RCS: 19..24 + +- 2.0.1 | 2002-11-16 + - more docstrings + - say "GNU Go" instead of "GNU GO" + - reverse output order of captured stones + - new commands: ‘_’ and ‘M-_’ (bury-buffer) + - simplified buffer management + - RCS: 15..18 + +- 2.0.0 | 2002-11-15 + - rewrite to use Go Text Protocol + - bugfix: don't set process coding system + - handle change in process status + - new user var: ‘gnugo-option-history’ + - use calculated screen columns + - improve error handling in ‘gnugo-cleanup’ + - new command: ‘:’ (gnugo-command) + - resume game if in progress, w/ confirmation + - new command: ‘M-_’ (gnugo-bury) + - autoload gnugo.el on command ‘gnugo’ + - doc improvements + - RCS: 1..14 + + + Local Variables: + mode: outline + outline-regexp: "\\([ ][ ]\\)*- " + End: + +_____________________________________________________________________ +Copyright (C) 2014 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted provided the copyright notice and this notice are preserved. diff --git a/elpa/gnugo-3.0.0/README b/elpa/gnugo-3.0.0/README new file mode 100644 index 0000000..897feab --- /dev/null +++ b/elpa/gnugo-3.0.0/README @@ -0,0 +1,6 @@ +This directory contains gnugo.el and other files. +These work w/ GNU Go: + + http://www.gnu.org/software/gnugo + +and any other program that speaks the Go Text Protocol. diff --git a/elpa/gnugo-3.0.0/gnugo-autoloads.el b/elpa/gnugo-3.0.0/gnugo-autoloads.el new file mode 100644 index 0000000..7bb92b4 --- /dev/null +++ b/elpa/gnugo-3.0.0/gnugo-autoloads.el @@ -0,0 +1,94 @@ +;;; gnugo-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) + +;;;### (autoloads nil "gnugo" "gnugo.el" (22505 22848 889648 864000)) +;;; Generated autoloads from gnugo.el + +(autoload 'gnugo "gnugo" "\ +Run gnugo in a buffer, or resume a game in progress. +If there is already a game in progress you may resume it instead +of starting a new one. Prefix arg means skip the game-in-progress +check and start a new game straight away. + +Before starting, Emacs queries you for additional command-line +options (Emacs supplies \"--mode gtp --quiet\" automatically). + +Note that specifying \"--infile FILENAME\" (or, \"-l FILENAME\") +silently clobbers certain other options, such as \"--color\". +For details, see info node `(gnugo) Invoking GNU Go'. + +\\ +To play, use \\[gnugo-move] to place a stone or \\[gnugo-pass] to pass. +See `gnugo-board-mode' for a full list of commands. + +\(fn &optional NEW-GAME)" t nil) + +;;;*** + +;;;### (autoloads nil "gnugo-frolic" "gnugo-frolic.el" (22505 22848 +;;;;;; 869648 768000)) +;;; Generated autoloads from gnugo-frolic.el + +(autoload 'gnugo-frolic-in-the-leaves "gnugo-frolic" "\ +Display the game tree in a *GNUGO Frolic* buffer. +This looks something like: + + 1 B -- E7 E7 E7 E7 + 2 W -- K10 K10 K10 K10 + 3 B -- E2 E2 E2 E2 + 4 W -- J3 J3 J3 J3 + 5 B -- A6 A6 A6 A6 + 6 W -- C9 C9 C9 C9 + │ + ├─────┬─────┐ + │ │ │ + 7 B -- H7 !B8 C8 C8 + │ + ├─────┐ + │ │ + 8 W -- D9 D9 D9 E9 + 9 B -- H8 H8 + 10 W -- PASS PASS + 11 B -- H5 PASS + 12 W -- PASS + 13 B -- *PASS + +with 0, 1, ... N (in this case N is 3) in the header line +to indicate the branches. Branch 0 is the \"main line\". +Point (* in this example) indicates the current position, +\"!\" indicates comment properties (e.g., B8, branch 1), +and moves not actually on the game tree (e.g., E7, branch 3) +are dimmed. Type \\[describe-mode] in that buffer for details. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "gnugo-imgen" "gnugo-imgen.el" (22505 22848 +;;;;;; 897648 834000)) +;;; Generated autoloads from gnugo-imgen.el + +(autoload 'gnugo-imgen-create-xpms "gnugo-imgen" "\ +Return a list of XPM images suitable for BOARD-SIZE. +The size and style of the images are determined by +`gnugo-imgen-sizing-function' (rounded down to an even number) +and `gnugo-imgen-style', respectively. See `gnugo-xpms'. + +The returned list is cached; see also `gnugo-imgen-clear-cache'. + +\(fn BOARD-SIZE)" nil nil) + +;;;*** + +;;;### (autoloads nil nil ("gnugo-pkg.el") (22505 22848 885648 885000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; gnugo-autoloads.el ends here diff --git a/elpa/gnugo-3.0.0/gnugo-frolic.el b/elpa/gnugo-3.0.0/gnugo-frolic.el new file mode 100644 index 0000000..539dadb --- /dev/null +++ b/elpa/gnugo-3.0.0/gnugo-frolic.el @@ -0,0 +1,509 @@ +;;; gnugo-frolic.el --- gametree in a buffer -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Thien-Thi Nguyen +;; Maintainer: Thien-Thi Nguyen + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'gnugo) +(require 'ascii-art-to-unicode) ; for `aa2u' + +(defvar gnugo-frolic-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (mapc (lambda (pair) + (define-key map (car pair) (cdr pair))) + '(("q" . gnugo-frolic-quit) + ("Q" . gnugo-frolic-quit) + ("\C-q" . gnugo-frolic-quit) + ("C" . gnugo-frolic-quit) ; like ‘View-kill-and-leave’ + ("\C-b" . gnugo-frolic-backward-branch) + ("\C-f" . gnugo-frolic-forward-branch) + ("\C-p" . gnugo-frolic-previous-move) + ("\C-n" . gnugo-frolic-next-move) + ("t" . gnugo-frolic-tip-move) + ("j" . gnugo-frolic-exchange-left) + ("J" . gnugo-frolic-rotate-left) + ("k" . gnugo-frolic-exchange-right) + ("K" . gnugo-frolic-rotate-right) + ("\C-m" . gnugo-frolic-set-as-main-line) + ("\C-\M-p" . gnugo-frolic-prune-branch) + ("o" . gnugo-frolic-return-to-origin))) + map) + "Keymap for GNUGO Frolic mode.") + +(defvar gnugo-frolic-parent-buffer nil) +(defvar gnugo-frolic-origin nil) + +(define-derived-mode gnugo-frolic-mode special-mode "GNUGO Frolic" + "A special mode for manipulating a GNUGO gametree." + (setq truncate-lines t) + (buffer-disable-undo)) + +(defun gnugo-frolic-quit () + "Kill GNUGO Frolic buffer and switch to its parent buffer." + (interactive) + (let ((bye (current-buffer))) + (switch-to-buffer (when (buffer-live-p gnugo-frolic-parent-buffer) + gnugo-frolic-parent-buffer)) + (kill-buffer bye))) + +(defun gnugo-frolic-return-to-origin () + "Move point to the board's current position." + (interactive) + (if (not gnugo-frolic-origin) + (message "No origin") + (goto-char gnugo-frolic-origin) + (recenter (- (count-lines (line-beginning-position) + (point-max)))))) + +;;;###autoload +(defun gnugo-frolic-in-the-leaves () + "Display the game tree in a *GNUGO Frolic* buffer. +This looks something like: + + 1 B -- E7 E7 E7 E7 + 2 W -- K10 K10 K10 K10 + 3 B -- E2 E2 E2 E2 + 4 W -- J3 J3 J3 J3 + 5 B -- A6 A6 A6 A6 + 6 W -- C9 C9 C9 C9 + │ + ├─────┬─────┐ + │ │ │ + 7 B -- H7 !B8 C8 C8 + │ + ├─────┐ + │ │ + 8 W -- D9 D9 D9 E9 + 9 B -- H8 H8 + 10 W -- PASS PASS + 11 B -- H5 PASS + 12 W -- PASS + 13 B -- *PASS + +with 0, 1, ... N (in this case N is 3) in the header line +to indicate the branches. Branch 0 is the \"main line\". +Point (* in this example) indicates the current position, +\"!\" indicates comment properties (e.g., B8, branch 1), +and moves not actually on the game tree (e.g., E7, branch 3) +are dimmed. Type \\[describe-mode] in that buffer for details." + (interactive) + (let* ((buf (get-buffer-create (concat (gnugo-get :diamond) + "*GNUGO Frolic*"))) + (from (or gnugo-frolic-parent-buffer + (current-buffer))) + ;; todo: use defface once we finally succumb to ‘customize’ + (dimmed-node-face (list :inherit 'default + :foreground "gray50")) + (tree (gnugo-get :sgf-gametree)) + (ends (copy-sequence (gnugo--tree-ends tree))) + (mnum (gnugo--tree-mnum tree)) + (seen (gnugo--mkht)) + (soil (gnugo--mkht)) + (width (length ends)) + (lanes (number-sequence 0 (1- width))) + (monkey (gnugo-get :monkey)) + (as-pos (gnugo--as-pos-func)) + (at (car (aref monkey 0))) + (bidx (aref monkey 1)) + (valid (cl-map 'vector (lambda (end) + (gethash (car end) mnum)) + ends)) + (max-move-num (apply 'max (append valid nil))) + (inhibit-read-only t) + finish) + (cl-flet + ((on (node) + (gethash node seen)) + (emph (s face) + (propertize s 'face face)) + (fsi (properties fmt &rest args) + (insert (apply 'propertize + (apply 'format fmt args) + properties)))) + ;; breathe in + (cl-loop + for bx below width + do (cl-loop + with fork + for node in (aref ends bx) + do (if (setq fork (on node)) + (cl-flet + ((tip-p (bix) + ;; todo: ignore non-"move" nodes + (eq node (car (aref ends bix)))) + (link (other) + (cl-pushnew other (gethash node soil)))) + (unless (tip-p bx) + (unless (tip-p fork) + (link fork)) + (link bx))) + (puthash node bx seen)) + until fork)) + ;; breathe out + (switch-to-buffer buf) + (gnugo-frolic-mode) + (erase-buffer) + (setq header-line-format + (let ((full (concat + (make-string 11 ?\s) + (mapconcat (lambda (n) + (format "%-5s" n)) + lanes + " ")))) + `((:eval + (funcall + ,(lambda () + (cl-flet + ((sp (w) (propertize + " " 'display + `(space :width ,w)))) + (concat + (when (eq 'left scroll-bar-mode) + (let ((w (or scroll-bar-width + (frame-parameter + nil 'scroll-bar-width))) + (cw (frame-char-width))) + (sp (if w + (/ w cw) + 2)))) + (let ((fc (fringe-columns 'left t))) + (unless (zerop fc) + (sp fc))) + (condition-case nil + (substring full (window-hscroll)) + (error "")))))))))) + (set (make-local-variable 'gnugo-frolic-parent-buffer) from) + (set (make-local-variable 'gnugo-state) + (buffer-local-value 'gnugo-state from)) + (cl-loop + with props + for n ; move number + from max-move-num downto 1 + do (setq props (list 'n n)) + do + (cl-loop + with (move forks br) + initially (progn + (goto-char (point-min)) + (fsi props + "%3d %s -- " + n (aref ["W" "B"] (logand 1 n)))) + for bx below width + do (let* ((node (unless (< (aref valid bx) n) + ;; todo: ignore non-"move" nodes + (pop (aref ends bx)))) + (zow `(bx ,bx ,@props)) + (ok (when node + (= bx (on node)))) + (comment (when ok + (cdr (assq :C node)))) + (s (cond ((not node) "") + ((not (setq move (gnugo--move-prop node))) "-") + (t (funcall as-pos (cdr move)))))) + (when comment + (push comment zow) + (push 'help-echo zow)) + (when (and ok (setq br (gethash node soil))) + (push (cons bx (sort br '<)) + forks)) + (fsi zow + "%c%-5s" + (if comment ?! ?\s) + (cond ((and (eq at node) + (or ok (= bx bidx))) + (when (= bx bidx) + (setq finish (point-marker))) + (emph s (list :inherit 'default + :foreground (frame-parameter + nil 'cursor-color)))) + ((not ok) + (emph s dimmed-node-face)) + (t s)))) + finally do + (when (progn (fsi props "\n") + (setq forks (nreverse forks))) + (let* ((margin (make-string 11 ?\s)) + (heads (mapcar #'car forks)) + (tails (mapcar #'cdr forks))) + (cl-flet* + ((spaced (lanes func) + (mapconcat func lanes " ")) + ;; live to play ~ ~ () + ;; play to learn (+) (-) . o O + ;; learn to live --ttn .M. _____U + (dashed (lanes func) ;;; _____ ^^^^ + (mapconcat func lanes "-----")) + (cnxn (lanes set) + (spaced lanes (lambda (bx) + (if (memq bx set) + "|" + " ")))) + (pad-unless (condition) + (if condition + "" + " ")) + (edge (set) + (insert margin + (cnxn lanes set) + "\n"))) + (edge heads) + (cl-loop + with bef + for ls on forks + do (let* ((one (car ls)) + (yes (append + ;; "aft" heads + (mapcar 'car (cdr ls)) + ;; ‘bef’ tails + (apply 'append (mapcar 'cdr bef)))) + (ord (sort one '<)) + (beg (car ord)) + (end (car (last ord)))) + (cl-flet + ((also (b e) (cnxn (number-sequence b e) + yes))) + (insert + margin + (also 0 (1- beg)) + (pad-unless (zerop beg)) + (dashed (number-sequence beg end) + (lambda (bx) + (cond ((memq bx ord) "+") + ((memq bx yes) "|") + (t "-")))) + (pad-unless (>= end width)) + (also (1+ end) (1- width)) + "\n")) + (push one bef))) + (edge (apply 'append tails)) + (aa2u (line-beginning-position + (- (1+ (length forks)))) + (point)))))))) + (when finish + (set (make-local-variable 'gnugo-frolic-origin) finish) + (gnugo-frolic-return-to-origin)))) + +(defun gnugo--awake (how) + ;; Valid HOW elements: + ;; require-valid-branch + ;; (line . numeric) + ;; (line . move-string) + ;; (omit . [VAR...]) + ;; Invalid elements blissfully ignored. :-D + (let* ((tree (gnugo-get :sgf-gametree)) + (ends (gnugo--tree-ends tree)) + (width (length ends)) + (monkey (gnugo-get :monkey)) + (line (cl-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)))) + (rv (list a))) + (when (memq 'require-valid-branch how) + (unless a + (user-error "No branch here"))) + (cl-loop + with omit = (cdr (assq 'omit how)) + for (name . value) in `((line . ,line) + (bidx . ,(aref monkey 1)) + (monkey . ,monkey) + (width . ,width) + (ends . ,ends) + (tree . ,tree)) + do (unless (memq name omit) + (push value rv))) + rv)) + +(defmacro gnugo--awakened (how &rest body) + (declare (indent 1)) + `(cl-destructuring-bind + ,(cl-loop + with omit = (cdr (assq 'omit how)) + with ls = (list 'a) + for name in '(line bidx monkey + width ends + tree) + do (unless (memq name omit) + (push name ls)) + finally return ls) + (gnugo--awake ',how) + ,@body)) + +(defsubst gnugo--move-to-bcol (bidx) + (move-to-column (+ 10 (* 6 bidx)))) + +(defun gnugo--swiz (direction &optional blunt) + (gnugo--awakened (require-valid-branch + (omit tree) + (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))) + (cl-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." + (interactive) + (gnugo--swiz -1 t)) + +(defun gnugo-frolic-rotate-left () + "Rotate all branches left." + (interactive) + (gnugo--swiz -1)) + +(defun gnugo-frolic-exchange-right () + "Exchange the current branch with the one to its right." + (interactive) + (gnugo--swiz 1 t)) + +(defun gnugo-frolic-rotate-right () + "Rotate all branches right." + (interactive) + (gnugo--swiz 1)) + +(defun gnugo-frolic-set-as-main-line () + "Make the current branch the main line." + (interactive) + (gnugo--swiz nil 0)) + +(defun gnugo-frolic-prune-branch () + "Remove the current branch from the gametree. +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 (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))) + ;; Explicit ignorance avoids byte-compiler warning. + (ignore (pop (nthcdr a new))) + (gnugo--set-tree-ends tree new)) + (when (< a bidx) + (aset monkey 1 (cl-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--sideways (backwards n) + (gnugo--awakened ((omit tree ends monkey bidx line)) + (gnugo--move-to-bcol (mod (if backwards + (- (or a width) n) + (+ (or a -1) n)) + width)))) + +(defun gnugo-frolic-backward-branch (&optional n) + "Move backward N (default 1) branches." + (interactive "p") + (gnugo--sideways t n)) + +(defun gnugo-frolic-forward-branch (&optional n) + "Move forward N (default 1) branches." + (interactive "p") + (gnugo--sideways nil n)) + +(defun gnugo--vertical (n direction) + (when (> 0 n) + (setq n (- n) + direction (- direction))) + (gnugo--awakened ((line . numeric) + (omit tree ends width monkey bidx)) + (let ((stop (if (> 0 direction) + 0 + (max 0 (1- (count-lines (point-min) + (point-max)))))) + (col (unless a + (current-column)))) + (cl-loop + while (not (= line stop)) + do (cl-loop + do (progn + (forward-line direction) + (cl-incf line direction)) + until (get-text-property (point) 'n)) + until (zerop (cl-decf n))) + (if a + (gnugo--move-to-bcol a) + (move-to-column col))))) + +(defun gnugo-frolic-previous-move (&optional n) + "Move to the Nth (default 1) previous move." + (interactive "p") + (gnugo--vertical n -1)) + +(defun gnugo-frolic-next-move (&optional n) + "Move to the Nth (default 1) next move." + (interactive "p") + (gnugo--vertical n 1)) + +(defun gnugo-frolic-tip-move () + "Move to the tip of the current branch." + (interactive) + (gnugo--awakened ((omit line bidx monkey width) + require-valid-branch) + (goto-char (point-max)) + (let ((mnum (gnugo--tree-mnum tree)) + (node (car (aref ends a)))) + (re-search-backward (format "^%3d" (gethash node mnum))) + (gnugo--move-to-bcol a)))) + +;;;--------------------------------------------------------------------------- +;;; that's it + +(provide 'gnugo-frolic) + +;;; gnugo-frolic.el ends here diff --git a/elpa/gnugo-3.0.0/gnugo-imgen.el b/elpa/gnugo-3.0.0/gnugo-imgen.el new file mode 100644 index 0000000..8e4d8a9 --- /dev/null +++ b/elpa/gnugo-3.0.0/gnugo-imgen.el @@ -0,0 +1,247 @@ +;;; gnugo-imgen.el --- image generation -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Thien-Thi Nguyen +;; Maintainer: Thien-Thi Nguyen + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides func `gnugo-imgen-create-xpms', suitable as +;; value for `gnugo-xpms', and several variables to configure it: +;; +;; `gnugo-imgen-styles' +;; `gnugo-imgen-style' +;; `gnugo-imgen-sizing-function' +;; +;; There is also one command: `gnugo-imgen-clear-cache'. + +;;; Code: + +(require 'xpm) +(require 'xpm-m2z) +(require 'cl-lib) + +(defvar gnugo-imgen-styles + '((d-bump ; thanks + :background "#FFFFC7C75252" + :grid-lines "#000000000000" + :circ-edges "#C6C6C3C3C6C6" + :white-fill "#FFFFFFFFFFFF" + :black-fill "#000000000000") + (ttn ; this guy must live in a cave + :background "#000000000000" + :grid-lines "#AAAA88885555" + :circ-edges "#888888888888" + :white-fill "#CCCCCCCCCCCC" + :black-fill "#444444444444")) + "Alist of styles suitable for `gnugo-imgen-create-xpms'. +The key is a symbol naming the style. The value is a plist. +Here is a list of recognized keywords and their meanings: + + :background -- string that names a color in XPM format, such as + :grid-lines \"#000000000000\" or \"black\"; the special string + :circ-edges \"None\" makes that component transparent + :white-fill + :black-fill + +All keywords are required and color values cannot be nil. +This restriction may be lifted in the future.") + +(defvar gnugo-imgen-style nil + "Which style in `gnugo-imgen-styles' to use. +If nil, `gnugo-imgen-create-xpms' defaults to the first one.") + +(defvar gnugo-imgen-sizing-function 'gnugo-imgen-fit-window-height + "Function to compute XPM image size from board size. +This is called with one arg, integer BOARD-SIZE, and should return +a number (float or integer), the number of pixels for the side of +a square position on the board. A value less than 8 is taken as 8.") + +(defvar gnugo-imgen-cache (make-hash-table :test 'equal)) + +(defun gnugo-imgen-clear-cache () + "Clear the cache." + (interactive) + (clrhash gnugo-imgen-cache)) + +(defun gnugo-imgen-fit-window-height (board-size) + "Return the dimension (in pixels) of a square for BOARD-SIZE. +This uses the TOP and BOTTOM components as returned by +`window-inside-absolute-pixel-edges' and subtracts twice +the `frame-char-height' (to leave space for the grid)." + (cl-destructuring-bind (L top R bot) + (window-inside-absolute-pixel-edges) + (ignore L R) + (/ (float (- bot top (* 2 (frame-char-height)))) + board-size))) + +(defconst gnugo-imgen-palette '((32 . :background) + (?. . :grid-lines) + (?X . :circ-edges) + (?- . :black-fill) + (?+ . :white-fill))) + +(defun gnugo-imgen-create-xpms-1 (square style) + (let* ((kws (mapcar 'cdr gnugo-imgen-palette)) + (roles (mapcar 'symbol-name kws)) + (palette (cl-loop + for px in (mapcar 'car gnugo-imgen-palette) + for role in roles + collect (cons px (format "s %s" role)))) + (resolved (cl-loop + with parms = (copy-sequence style) + for role in roles + for kw in kws + collect (cons role (plist-get parms kw)))) + (sq-m1 (1- square)) + (half (/ sq-m1 2.0)) + (half-m1 (truncate (- half 0.5))) + (half-p1 (truncate (+ half 0.5))) + (background (make-vector 10 nil)) + (foreground (make-vector 4 nil)) + rv) + (cl-flet + ((workbuf (n) + (xpm-generate-buffer (format "%d_%d" n square) + square square 1 palette)) + (replace-from (buffer) + (erase-buffer) + (insert-buffer-substring buffer) + (xpm-grok t)) + (nine-from-four (N E W S) + (list (list E S) + (list E W S) + (list W S) + (list N E S) + (list N E W S) + (list N W S) + (list N E ) + (list N E W ) + (list N W ))) + (mput-points (px ls) + (dolist (coord ls) + (apply 'xpm-put-points px coord)))) + ;; background + (cl-loop + for place from 1 to 9 + for parts + in (cl-flet* + ((vline (x y1 y2) (list (list x (cons y1 y2)))) + (v-expand (y1 y2) (append (vline half-m1 y1 y2) + (vline half-p1 y1 y2))) + (hline (y x1 x2) (list (list (cons x1 x2) y))) + (h-expand (x1 x2) (append (hline half-m1 x1 x2) + (hline half-p1 x1 x2)))) + (nine-from-four (v-expand 0 half-p1) + (h-expand half-m1 sq-m1) + (h-expand 0 half-p1) + (v-expand half-m1 sq-m1))) + do (aset background place + (with-current-buffer (workbuf place) + (dolist (part parts) + (mput-points ?. part)) + (current-buffer)))) + ;; foreground + (cl-flet + ((circ (radius) + (xpm-m2z-circle half half radius))) + (cl-loop + with stone = (circ (truncate half)) + with minim = (circ (/ square 9)) + for n below 4 + do (aset foreground n + (with-current-buffer (workbuf n) + (cl-flet + ((rast (form b w) + (xpm-raster form ?X + (if (> 2 n) + b + w)))) + (if (cl-evenp n) + (rast stone ?- ?+) + (replace-from (aref foreground (1- n))) + (rast minim ?+ ?-)) + (current-buffer)))))) + ;; do it + (cl-flet + ((ok (place type finish) + (goto-char 25) + (delete-char (- (skip-chars-forward "^1-9"))) + (delete-char 1) + (insert (format "%s%d" type place)) + (push (cons (cons type place) + (funcall finish + :ascent 'center + :color-symbols resolved)) + rv))) + (with-current-buffer (workbuf 5) + (replace-from (aref background 5)) + (xpm-raster + ;; yes, using an ellipse is bizarre; no, we don't mind; + ;; maybe, ‘artist-ellipse-generate-quadrant’ is stable. + (xpm-m2z-ellipse half half 4 4.5) + ?. t) + (ok 5 'hoshi 'xpm-finish)) + (cl-loop + for place from 1 to 9 + for decor in (let ((friends (cons half-m1 half-p1))) + (nine-from-four (list friends 0) + (list sq-m1 friends) + (list 0 friends) + (list friends sq-m1))) + do (with-current-buffer (aref background place) + (ok place 'empty 'xpm-finish)) + do (cl-flet + ((decorate (px) + (mput-points px decor))) + (cl-loop + for n below 4 + for type in '(bmoku bpmoku wmoku wpmoku) + do (with-current-buffer (aref foreground n) + (decorate ?.) + (ok place type 'xpm-as-xpm) + (decorate 32))))) + (mapc 'kill-buffer foreground) + (nreverse rv))))) + +;;;###autoload +(defun gnugo-imgen-create-xpms (board-size) + "Return a list of XPM images suitable for BOARD-SIZE. +The size and style of the images are determined by +`gnugo-imgen-sizing-function' (rounded down to an even number) +and `gnugo-imgen-style', respectively. See `gnugo-xpms'. + +The returned list is cached; see also `gnugo-imgen-clear-cache'." + (let* ((square (let ((n (funcall gnugo-imgen-sizing-function + board-size))) + (unless (numberp n) + (error "Invalid BOARD-SIZE: %s" board-size)) + (max 8 (logand (lognot 1) (truncate n))))) + (style (or (unless gnugo-imgen-style (cdar gnugo-imgen-styles)) + (cdr (assq gnugo-imgen-style gnugo-imgen-styles)) + (error "No style selected"))) + (key (cons square style))) + (or (gethash key gnugo-imgen-cache) + (puthash key (gnugo-imgen-create-xpms-1 square style) + gnugo-imgen-cache)))) + +;;;--------------------------------------------------------------------------- +;;; that's it + +(provide 'gnugo-imgen) + +;;; gnugo-imgen.el ends here diff --git a/elpa/gnugo-3.0.0/gnugo-pkg.el b/elpa/gnugo-3.0.0/gnugo-pkg.el new file mode 100644 index 0000000..6d7cec7 --- /dev/null +++ b/elpa/gnugo-3.0.0/gnugo-pkg.el @@ -0,0 +1,2 @@ +;; Generated package description from gnugo.el +(define-package "gnugo" "3.0.0" "play GNU Go in a buffer" '((ascii-art-to-unicode "1.5") (xpm "1.0.1") (cl-lib "0.5")) :url "http://www.gnuvola.org/software/gnugo/" :keywords '("games" "processes")) diff --git a/elpa/gnugo-3.0.0/gnugo.el b/elpa/gnugo-3.0.0/gnugo.el new file mode 100644 index 0000000..c25cee3 --- /dev/null +++ b/elpa/gnugo-3.0.0/gnugo.el @@ -0,0 +1,2753 @@ +;;; gnugo.el --- play GNU Go in a buffer -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Thien-Thi Nguyen +;; Maintainer: Thien-Thi Nguyen +;; Version: 3.0.0 +;; Package-Requires: ((ascii-art-to-unicode "1.5") (xpm "1.0.1") (cl-lib "0.5")) +;; Keywords: games, processes +;; URL: http://www.gnuvola.org/software/gnugo/ + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Playing +;; ------- +;; +;; This file provides the command `gnugo' which allows you to play the game of +;; go against the external program "gnugo" (http://www.gnu.org/software/gnugo) +;; in a dedicated Emacs buffer, or to resume a game in progress. NOTE: In +;; this file, to avoid confusion w/ elisp vars and funcs, we use the term "GNU +;; Go" to refer to the process object created by running the external program. +;; +;; At the start of a new game, you can pass additional command-line arguments +;; to GNU Go to specify level, board size, color, komi, handicap, etc. By +;; default GNU Go plays at level 10, board size 19, color white, and zero for +;; both komi and handicap. +;; +;; To play a stone, move the cursor to the desired vertice and type `SPC' or +;; `RET'; to pass, `P' (note: uppercase); to quit, `q'; to undo one of your +;; moves (as well as a possibly intervening move by GNU Go), `u'. To undo +;; back through an arbitrary stone that you played, place the cursor on a +;; stone and type `U' (note: uppercase). +;; +;; There are a great many other commands. Other keybindings are described in +;; the `gnugo-board-mode' documentation, which you may view with the command +;; `describe-mode' (normally `C-h m') in that buffer. The buffer name shows +;; the last move and who is currently to play. Capture counts and other info +;; are shown on the mode line immediately following the major mode name. +;; +;; While GNU Go is pondering its next move, certain commands that rely on its +;; assistence will result in a "still waiting" error. Do not be alarmed; that +;; is normal. When it is your turn again you may retry the command. In the +;; meantime, you can use Emacs for other tasks, or start an entirely new game +;; with `C-u M-x gnugo'. (NOTE: A new game will slow down all games. :-) +;; +;; If GNU Go should crash during a game the mode line will show "no process". +;; Please report the event to the GNU Go maintainers so that they can improve +;; the program. +;; +;; +;; Meta-Playing (aka Customizing) +;; ------------------------------ +;; +;; Customization is presently limited to +;; vars: `gnugo-program' +;; `gnugo-animation-string' +;; `gnugo-mode-line' +;; `gnugo-X-face' `gnugo-O-face' `gnugo-grid-face' +;; `gnugo-undo-reaction' +;; `gnugo-xpms' (see also gnugo-imgen.el) +;; normal hooks: `gnugo-board-mode-hook' +;; `gnugo-frolic-mode-hook' +;; `gnugo-start-game-hook' +;; `gnugo-post-move-hook' +;; and the keymaps: `gnugo-board-mode-map' +;; `gnugo-frolic-mode-map' +;; +;; +;; Meta-Meta-Playing (aka Hacking) +;; ------------------------------- +;; +;; + +;;; Code: + +(require 'cl-lib) ; use the source luke! +(require 'time-date) ; for `time-subtract' + +;;;--------------------------------------------------------------------------- +;;; Political arts + +(defconst gnugo-version "3.0.0" + "Version of gnugo.el currently loaded. +This follows a MAJOR.MINOR.PATCH scheme.") + +;;;--------------------------------------------------------------------------- +;;; Variables for the uninquisitive programmer + +(defvar gnugo-program "gnugo" + "Name of the GNU Go program (executable file). +\\[gnugo] validates this using `executable-find'. +This program must accept command line args: + --mode gtp --quiet +For more information on GTP and GNU Go, please visit: +") + +(defvar gnugo-board-mode-map + ;; Re , + ;; ideally we could ‘defvar’ here w/o value and also ‘defvar’ below + ;; in "load-time actions" w/ value and docstring, to avoid this ugly + ;; (from the forward references) block early in the file. Unfortunately, + ;; byte-compiling such a split formulation results in the initial ‘defvar’ + ;; being replaced by: + ;; (defvar VAR (make-sparse-keymap)) + ;; and the second ‘defvar’ is ignored on load. At least, this is the case + ;; for Emacs built from repo (trunk) 2014-05-27. --ttn + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (mapc (lambda (pair) + (define-key map (car pair) (cdr pair))) + '(("?" . describe-mode) + ("S" . gnugo-request-suggestion) + ("\C-m" . gnugo-move) + (" " . gnugo-move) + ("P" . gnugo-pass) + ("R" . gnugo-resign) + ("q" . gnugo-quit) + ("Q" . gnugo-leave-me-alone) + ("U" . gnugo-fancy-undo) + ("\M-u" . gnugo-undo-one-move) + ("u" . gnugo-undo-two-moves) + ("\C-?" . gnugo-undo-two-moves) + ("o" . gnugo-oops) + ("O" . gnugo-okay) + ("\C-l" . gnugo-refresh) + ("\M-_" . gnugo-boss-is-near) + ("_" . gnugo-boss-is-near) + ("h" . gnugo-move-history) + ("L" . gnugo-frolic-in-the-leaves) + ("\C-c\C-l" . gnugo-frolic-in-the-leaves) + ("i" . gnugo-image-display-mode) + ("w" . gnugo-worm-stones) + ("W" . gnugo-worm-data) + ("d" . gnugo-dragon-stones) + ("D" . gnugo-dragon-data) + ("g" . gnugo-grid-mode) + ("!" . gnugo-estimate-score) + (":" . gnugo-command) + (";" . gnugo-command) + ("=" . gnugo-describe-position) + ("s" . gnugo-write-sgf-file) + ("\C-x\C-s" . gnugo-write-sgf-file) + ("\C-x\C-w" . gnugo-write-sgf-file) + ("l" . gnugo-read-sgf-file) + ("F" . gnugo-display-final-score) + ("A" . gnugo-switch-to-another) + ("C" . gnugo-comment) + ("\C-c\C-a" . gnugo-assist-mode) + ("\C-c\C-z" . gnugo-zombie-mode) + ;; mouse + ([(down-mouse-1)] . gnugo-mouse-move) + ([(down-mouse-2)] . gnugo-mouse-move) ; mitigate accidents + ([(down-mouse-3)] . gnugo-mouse-pass) + ;; delving into the curiosities + ("\C-c\C-p" . gnugo-describe-internal-properties))) + map) + "Keymap for GNUGO Board mode.") + +(defvar gnugo-board-mode-hook nil + "Hook run when entering GNUGO Board mode.") + +(defvar gnugo-start-game-hook nil + "Normal hook run immediately before the first move of the game. +To find out who is to move first, use `gnugo-current-player'. +See also `gnugo-board-mode'.") + +(defvar gnugo-post-move-hook nil + "Normal hook run after a move and before the board is refreshed. +Initially, when `run-hooks' is called, the current buffer is the GNUGO +Board buffer of the game. Hook functions that switch buffers must take +care not to call (directly or indirectly through some other function) +`gnugo-put' or `gnugo-get' after the switch.") + +(defvar gnugo-animation-string + (let ((jam "*#") (blink " #") (spin "-\\|/") (yada "*-*!")) + (concat jam jam jam jam jam + ;; "SECRET MESSAGE HERE" + blink blink blink blink blink blink blink blink + ;; Playing go is like fighting ignorance: when you think you have + ;; surrounded something by knowing it very well it often turns + ;; out that in the time you spent deepening this understanding, + ;; other areas of ignorance have surrounded you. + spin spin spin spin spin spin spin spin spin + ;; Playing go is not like fighting ignorance: what one person + ;; knows many people may come to know; knowledge does not build + ;; solely move by move. Wisdom, on the other hand... + yada yada yada)) + "String whose individual characters are used for animation. +Specifically, the commands `gnugo-worm-stones' and `gnugo-dragon-stones' +render the stones in their respective result groups as the first character +in the string, then the next, and so on.") + +(defvar gnugo-mode-line "~b ~w :~m :~u" + "A `mode-line-format'-compliant value for GNUGO Board mode. +If a single string, the following special escape sequences are +replaced with their associated information: + ~b,~w black,white captures (a number) + ~p current player (black or white) + ~m move number + ~t time waiting for the current move + ~u time taken for the Ultimate (most recent) move +The times are in seconds, or \"-\" if that information is not available. +For ~t, the value is a snapshot, use `gnugo-refresh' to update it.") + +(defvar gnugo-X-face 'font-lock-string-face + "Name of face to use for X (black) stones.") + +(defvar gnugo-O-face 'font-lock-builtin-face + "Name of face to use for O (white) stones.") + +(defvar gnugo-grid-face 'default + "Name of face to use for the grid (A B C ... 1 2 3 ...).") + +(defvar gnugo-undo-reaction 'play! + "What to do if undo (or oops) leaves GNU Go to play. +After `gnugo-undo-one-move', `gnugo-undo-two-moves' or `gnugo-oops', +when GNU Go is to play, this can be a symbol: + play -- make GNU Go play (unless in Zombie mode) + play! -- make GNU Go play unconditionally (traditional behavior) + zombie -- enable Zombie mode (`gnugo-zombie-mode') + one-shot -- like `zombie' but valid only for the next move +Any other value, or (as a special case) for `gnugo-undo-one-move', +any value other than `zombie', is taken as `one-shot'. Note that +making GNU Go play will probably result in the recently-liberated +board position becoming re-occupied.") + +(defvar gnugo-xpms nil + "List of 46 ((TYPE . LOCATION) . XPM-IMAGE) forms. +XPM-IMAGE is an image as returned by `create-image' with +inline data (i.e., property :data with string value). + +TYPE is a symbol, one of: + hoshi -- unoccupied position with dot + empty -- unoccupied position sans dot + bpmoku, bmoku -- black stone with and sans highlight point + wpmoku, wmoku -- white stone with and sans highlight point + +LOCATION is an integer encoding edge, corner, or center: + 1 2 3 + 4 5 6 + 7 8 9 +For instance, 4 means \"left edge\", 9 means \"bottom right\". + +There is only one location for hoshi: center. The other five +types each have all possible locations. So (+ 1 (* 9 5)) => 46. + +The value can also be a function (satisfying `functionp') that +takes one arg, the size of the board, and returns the appropriate +list of forms.") + +;;;--------------------------------------------------------------------------- +;;; Variables for the inquisitive programmer + +(defconst gnugo-font-lock-keywords + '(("X" . gnugo-X-face) + ("O" . gnugo-O-face)) + "Font lock keywords for `gnugo-board-mode'.") + +(defvar gnugo-option-history nil) + +(defvar gnugo-state nil) ; hint: C-c C-p + +(defvar gnugo-btw nil) + +;;;--------------------------------------------------------------------------- +;;; Support functions + +(defsubst gnugo--mkht (&rest etc) + (apply 'make-hash-table :test 'eq etc)) + +(defsubst gnugo--compare-strings (s1 beg1 s2 beg2) + (compare-strings s1 beg1 nil s2 beg2 nil)) + +(defun gnugo-put (key value) + "Associate move/game/board-specific property KEY with VALUE. + +There are many properties, each named by a keyword, that record and control +how gnugo.el manages each game. Each GNUGO Board buffer has its own set +of properties, stored in the hash table `gnugo-state'. Here we document +some of the more stable properties. You may wish to use them as part of +a `gnugo-post-move-hook' function, for example. Be careful to preserve +the current buffer as `gnugo-state' is made into a buffer-local variable. +NOTE: In the following, \"see foo\" actually means \"see foo source or +you may never really understand to any degree of personal satisfaction\". + + :proc -- subprocess named \"gnugo\", \"gnugo<1>\" and so forth + + :diamond -- the part of the subprocess name after \"gnugo\", may be \"\" + + :game-over -- nil until game over at which time its value is set to + the alist `((live GROUP ...) (dead GROUP ...))' + + :sgf-collection -- after a `loadsgf' command, entire parse tree of file, + a simple list of one or more gametrees, updated in + conjunction w/ :sgf-gametree and :monkey + + :sgf-gametree -- one of the gametrees in :sgf-collection + + :monkey -- vector of two elements: + MEM, a pointer to one of the branches in the gametree; + BIDX, the index of the \"current branch\" + + :gnugo-color -- either \"black\" or \"white\" + :user-color + :last-mover + + :last-waiting -- seconds and time value, respectively; see `gnugo-push-move' + :waiting-start + + :black-captures -- these are strings since gnugo.el doesn't do anything + :white-captures w/ the information besides display it in the mode line; + gory details in functions `gnugo-propertize-board-buffer' + and `gnugo-merge-showboard-results' (almost more effort + than they are worth!) + + :display-using-images -- XPMs, to be precise; see functions `gnugo-yy', + `gnugo-toggle-image-display' and `gnugo-refresh', + as well as gnugo-xpms.el (available elsewhere) + + :all-yy -- list of 46 symbols used as the `category' text property + (so that their plists, typically w/ property `display' or + `do-not-display') are consulted by the Emacs display engine; + 46 = 9 places * (4 moku + 1 empty) + 1 hoshi; see functions + `gnugo-toggle-image-display', `gnugo-yy' and `gnugo-yang' + + :paren-ov -- a pair (left and right) of overlays shuffled about to indicate + the last move; only one is used when displaying using images + + :last-user-bpos -- board position; keep the hapless human happy + +As things stabilize probably more info will be added to this docstring." + (declare (indent 1)) + (puthash key value gnugo-state)) + +(defun gnugo-get (key) + "Return the move/game/board-specific value for KEY. +See `gnugo-put'." + (gethash key gnugo-state)) + +(defun gnugo--forget (&rest keys) + (dolist (key keys) + (remhash key gnugo-state))) + +(defsubst gnugo--tree-mnum (tree) + (aref tree 1)) + +(defsubst gnugo--tree-ends (tree) + (aref tree 0)) + +(defsubst gnugo--set-tree-ends (tree ls) + (aset tree 0 (apply 'vector ls)) + (gnugo--tree-ends tree)) + +(defun gnugo--root-node (&optional tree) + (aref (or tree (gnugo-get :sgf-gametree)) + 2)) + +(defun gnugo-describe-internal-properties () + "Pretty-print `gnugo-state' properties in another buffer. +Handle the big, slow-to-render, and/or uninteresting ones specially." + (interactive) + (let ((buf (current-buffer)) + (d (gnugo-get :diamond)) + (acc (cl-loop + for key being the hash-keys of gnugo-state + using (hash-values val) + collect (cons key + (cl-case key + ((:xpms) + (format "hash: %X (%d images)" + (sxhash val) + (length val))) + (:sgf-collection + (length val)) + (:sgf-gametree + (list (hash-table-count + (gnugo--tree-mnum val)) + (gnugo--root-node val) + (gnugo--tree-ends val))) + (:monkey + (let ((mem (aref val 0))) + (list (aref val 1) + (car mem)))) + (t val)))))) + (switch-to-buffer (get-buffer-create + (format "%s*GNUGO Board Properties*" + d))) + (erase-buffer) + (emacs-lisp-mode) + (setq truncate-lines t) + (save-excursion + (pp acc + (current-buffer)) + (goto-char (point-min)) + (let ((rx (format "overlay from \\([0-9]+\\).+\n%s\\s-+" + (if (string= "" d) + ".+\n" + "")))) + (while (re-search-forward rx nil t) + (let ((pos (get-text-property (string-to-number (match-string 1)) + 'gnugo-position buf))) + (delete-region (+ 2 (match-beginning 0)) (point)) + (insert (format " %S" pos)))))) + (message "%d properties" (length acc)))) + +(defun gnugo-board-buffer-p (&optional buffer) + "Return non-nil if BUFFER is a GNUGO Board buffer." + (eq 'gnugo-board-mode + (buffer-local-value + 'major-mode + (or buffer (current-buffer))))) + +(defun gnugo-board-user-play-ok-p (&optional buffer) + "Return non-nil if BUFFER is a GNUGO Board buffer ready for a user move." + (with-current-buffer (or buffer (current-buffer)) + (and gnugo-state (not (gnugo-get :waiting))))) + +(defsubst gnugo--blackp (string) + (string= "black" string)) + +(defun gnugo-other (color) + (if (gnugo--blackp color) "white" "black")) + +(defun gnugo-current-player () + "Return the current player, either \"black\" or \"white\"." + (gnugo-other (gnugo-get :last-mover))) + +(defsubst gnugo--prop<-color (color) + (if (gnugo--blackp color) :B :W)) + +(defun gnugo-gate (&optional in-progress-p) + (unless (gnugo-board-buffer-p) + (user-error "Wrong buffer -- try M-x gnugo")) + (unless (gnugo-get :proc) + (user-error "No \"gnugo\" process!")) + (cl-destructuring-bind (&optional color . suggestion) + (gnugo-get :waiting) + (when color + (apply 'user-error + "%s -- please wait for \"(%s to play)\"" + (if suggestion + (list "Still thinking" + color) + (list "Not your turn yet" + (gnugo-other color)))))) + (when (and in-progress-p (gnugo-get :game-over)) + (user-error "Sorry, game over"))) + +(defun gnugo-sentinel (proc string) + (let ((status (process-status proc))) + (when (memq status '(exit signal)) + (let ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (with-current-buffer buf + (setq mode-line-process + (list " [%s (" + (propertize (car (split-string string)) + 'face 'font-lock-warning-face) + ")]")) + (when (eq proc (gnugo-get :proc)) + (gnugo--forget :proc)))))))) + +(defun gnugo--begin-exchange (proc filter line) + (declare (indent 2)) ; good time, for a rime + ; nice style, for a wile... + (set-process-filter proc filter) + (process-send-string proc line) + (process-send-string proc "\n")) + +(defun gnugo--q (fmt &rest args) + "Send formatted command \"FMT ARGS...\"; wait for / return response. +The response is a string whose first two characters indicate the +status of the command. See also `gnugo-query'." + (let ((slow (gnugo-get :waiting)) + (proc (gnugo-get :proc))) + (when slow + (user-error "Sorry, still waiting for %s to %s" + (car slow) (if (cdr slow) + "receive a suggestion" + "play"))) + (process-put proc :incomplete t) + (process-put proc :srs "") ; synchronous return stash + (gnugo--begin-exchange + proc (lambda (proc string) + (let ((full (concat (process-get proc :srs) + string))) + (process-put proc :srs full) + (unless (numberp (gnugo--compare-strings + full (max 0 (- (length full) + 2)) + "\n\n" nil)) + (process-put proc :incomplete nil)))) + (if (null args) + fmt + (apply #'format fmt args))) + (while (process-get proc :incomplete) + (accept-process-output proc 30)) + (prog1 (substring (process-get proc :srs) 0 -2) + (process-put proc :srs "")))) + +(defsubst gnugo--no-worries (string) + (= ?= (aref string 0))) + +(defun gnugo--q/ue (fmt &rest args) + (let ((ans (apply 'gnugo--q fmt args))) + (unless (gnugo--no-worries ans) + (user-error "%s" ans)) + (substring ans 2))) + +(defun gnugo-query (message-format &rest args) + "Send GNU Go a command formatted with MESSAGE-FORMAT and ARGS. +Return a string that omits the first two characters (corresponding +to the status indicator in the Go Text Protocol). Use this function +when you are sure the command cannot fail." + (substring (apply 'gnugo--q message-format args) + 2)) + +(defun gnugo--nquery (cmd) + (string-to-number (gnugo-query cmd))) + +(defun gnugo-lsquery (message-format &rest args) + (split-string (apply 'gnugo-query message-format args))) + +(defsubst gnugo--count-query (fmt &rest args) + (length (apply 'gnugo-lsquery fmt args))) + +(defsubst gnugo--root-prop (prop &optional tree) + (cdr (assq prop (gnugo--root-node tree)))) + +(defun gnugo--set-root-prop (prop value &optional tree) + (let* ((root (gnugo--root-node tree)) + (cur (assq prop root))) + (if cur + (setcdr cur value) + (push (cons prop value) + (cdr (last root)))))) + +(defun gnugo-goto-pos (pos) + "Move point to board position POS, a letter-number string." + (goto-char (point-min)) + (forward-line (- (1+ (gnugo-get :SZ)) + (string-to-number (substring pos 1)))) + (forward-char 1) + (forward-char (+ (if (= 32 (following-char)) 1 2) + (* 2 (- (let ((letter (aref pos 0))) + (if (> ?I letter) + letter + (1- letter))) + ?A))))) + +(defun gnugo-f (id) + (intern (if (symbolp id) + (symbol-name id) + id) + (gnugo-get :obarray))) + +(defun gnugo-yang (c) + (cdr (assq c '((?+ . hoshi) + (?. . empty) + (?X . (bmoku . bpmoku)) + (?O . (wmoku . wpmoku)))))) + +(defun gnugo-yy (yin yang &optional momentaryp) + (gnugo-f (format "%d-%s" + yin (cond ((symbolp yang) yang) + (momentaryp (cdr yang)) + (t (car yang)))))) + +(defun gnugo-toggle-image-display () + (unless (display-images-p) + (user-error "Display does not support images, sorry")) + (let ((fresh (if (functionp gnugo-xpms) + (funcall gnugo-xpms (gnugo-get :SZ)) + gnugo-xpms))) + (unless fresh + (user-error "Sorry, `gnugo-xpms' unset")) + (unless (eq fresh (gnugo-get :xpms)) + (gnugo-put :xpms fresh) + (gnugo--forget :all-yy))) + (let* ((new (not (gnugo-get :display-using-images))) + (act (if new 'display 'do-not-display))) + (mapc (lambda (yy) + (setcar (symbol-plist yy) act)) + (or (gnugo-get :all-yy) + (gnugo-put :all-yy + (prog1 (mapcar (lambda (ent) + (let* ((k (car ent)) + (yy (gnugo-yy (cdr k) (car k)))) + (setplist yy `(not-yet ,(cdr ent))) + yy)) + (gnugo-get :xpms)) + (gnugo-put :imul + (image-size (get (gnugo-yy 5 (gnugo-yang ?+)) + 'not-yet))))))) + (setplist (gnugo-f 'ispc) (and new '(display (space :width 0)))) + (gnugo-put :highlight-last-move-spec + (if new + `(,(lambda (p) + (get (gnugo-yy (get-text-property p 'gnugo-yin) + (get-text-property p 'gnugo-yang) + t) + 'display)) + 0 delete-overlay) + (gnugo-get :default-highlight-last-move-spec))) + ;; a kludge to be reworked another time perhaps by another gnugo.el lover + (dolist (group (cdr (assq 'dead (gnugo-get :game-over)))) + (mapc 'delete-overlay (cdar group)) + (setcdr (car group) nil)) + (gnugo-put :mul (if new + (gnugo-get :imul) + '(1 . 1))) + (gnugo-put :display-using-images new))) + +(define-minor-mode gnugo-grid-mode + "If enabled, display grid around the board." + :variable + ((not (memq :nogrid buffer-invisibility-spec)) + . + (lambda (bool) + (funcall (if bool + 'remove-from-invisibility-spec + 'add-to-invisibility-spec) + :nogrid) + (save-excursion (gnugo-refresh))))) + +(defun gnugo-propertize-board-buffer () + (erase-buffer) + (insert (substring (gnugo--q "showboard") 3)) + (let* ((grid-props (list 'invisible :nogrid + 'font-lock-face gnugo-grid-face)) + (%gpad (gnugo-f 'gpad)) + (%gspc (gnugo-f 'gspc)) + (%lpad (gnugo-f 'lpad)) + (%rpad (gnugo-f 'rpad)) + (ispc-props (list 'category (gnugo-f 'ispc) 'rear-nonsticky t)) + (size (gnugo-get :SZ)) + (size-string (number-to-string size))) + (goto-char (point-min)) + (put-text-property (point) (1+ (point)) 'category (gnugo-f 'tpad)) + (skip-chars-forward " ") + (put-text-property (1- (point)) (point) 'category %gpad) + (put-text-property (point) (progn (end-of-line) (point)) 'category %gspc) + (forward-char 1) + (add-text-properties (1+ (point-min)) (1- (point)) grid-props) + (while (looking-at "\\s-*\\([0-9]+\\)[ ]") + (let* ((row (match-string-no-properties 1)) + (edge (match-end 0)) + (other-edge (+ edge (* 2 size) -1)) + (right-empty (+ other-edge (length row) 1)) + (top-p (string= size-string row)) + (bot-p (string= "1" row))) + (let* ((nL (- edge 1 (length size-string))) + (nR (- edge 1)) + (ov (make-overlay nL nR (current-buffer) t))) + (add-text-properties nL nR grid-props) + ;; We redundantly set `invisible' in the overlay to workaround + ;; a display bug whereby text *following* the overlaid text is + ;; displayed with the face of the overlaid text, but only when + ;; that text is invisible (i.e., `:nogrid' in invisibility spec). + ;; This has something to do w/ the bletcherous `before-string'. + (overlay-put ov 'invisible :nogrid) + (overlay-put ov 'category %lpad)) + (cl-do ((p edge (+ 2 p)) (ival 'even (if (eq 'even ival) 'odd 'even))) + ((< other-edge p)) + (let* ((position (format "%c%s" (aref "ABCDEFGHJKLMNOPQRST" + (truncate (- p edge) 2)) + row)) + (yin (let ((A-p (= edge p)) + (Z-p (= (1- other-edge) p))) + (cond ((and top-p A-p) 1) + ((and top-p Z-p) 3) + ((and bot-p A-p) 7) + ((and bot-p Z-p) 9) + (top-p 2) + (bot-p 8) + (A-p 4) + (Z-p 6) + (t 5)))) + (yang (gnugo-yang (char-after p)))) + (add-text-properties p (1+ p) + `(gnugo-position + ,position + gnugo-yin + ,yin + gnugo-yang + ,yang + category + ,(gnugo-yy yin yang) + front-sticky + (gnugo-position gnugo-yin)))) + (unless (= (1- other-edge) p) + (add-text-properties (1+ p) (+ 2 p) ispc-props) + (put-text-property p (+ 2 p) 'intangible ival))) + (add-text-properties (1+ other-edge) right-empty grid-props) + (goto-char right-empty) + (when (looking-at "\\s-+\\(WH\\|BL\\).*capt.* \\([0-9]+\\).*$") + (let ((prop (if (string= "WH" (match-string 1)) + :white-captures + :black-captures)) + (beg (match-beginning 2)) + (end (match-end 2))) + (put-text-property beg end :gnugo-cf (cons (- end beg) prop)) + (gnugo-put prop (match-string-no-properties 2)))) + (end-of-line) + (put-text-property right-empty (point) 'category %rpad) + (forward-char 1))) + (add-text-properties (1- (point)) (point-max) grid-props) + (skip-chars-forward " ") + (put-text-property (1- (point)) (point) 'category %gpad) + (put-text-property (point) (progn (end-of-line) (point)) + 'category %gspc))) + +(defun gnugo-merge-showboard-results () + (let ((aft (substring (gnugo--q "showboard") 3)) + (adj 1) ; string to buffer position adjustment + + (sync "[0-9]* stones$") + ;; Note: `sync' used to start w/ "[0-9]+", but that is too + ;; restrictive a condition that fails in the case of: + ;; + ;; (before) + ;; ... WHITE has captured 1 stones + ;; ^ + ;; (after) + ;; ... WHITE has captured 14 stones + ;; ^ + ;; + ;; where the after count has more digits than the before count, + ;; but shares the same leading digits. In this case, the result + ;; of `compare-strings' points to the SPC following the before + ;; count (indicated by caret in this example). + + (bef (buffer-substring-no-properties (point-min) (point-max))) + (bef-start 0) (bef-idx 0) + (aft-start 0) (aft-idx 0) + aft-sync-backtrack mis inc cut new very-strange + + (inhibit-read-only t)) + (while (numberp (setq mis (gnugo--compare-strings + bef bef-start + aft aft-start))) + (setq aft-sync-backtrack nil + inc (if (cl-minusp mis) + (- (+ 1 mis)) + (- mis 1)) + bef-idx (+ bef-start inc) + aft-idx (+ aft-start inc) + bef-start (if (eq bef-idx (string-match sync bef bef-idx)) + (match-end 0) + (1+ bef-idx)) + aft-start (if (and (eq aft-idx (string-match sync aft aft-idx)) + (let ((peek (1- aft-idx))) + (while (not (= 32 (aref aft peek))) + (setq peek (1- peek))) + (setq aft-sync-backtrack (1+ peek)))) + (match-end 0) + (1+ aft-idx)) + cut (+ bef-idx adj + (if aft-sync-backtrack + (- aft-sync-backtrack aft-idx) + 0))) + (goto-char cut) + (if aft-sync-backtrack + (let* ((asb aft-sync-backtrack) + (l-p (get-text-property cut :gnugo-cf)) + (old-len (car l-p)) + (capprop (cdr l-p)) + (keep (text-properties-at cut))) + (setq new (substring aft asb (string-match " " aft asb))) + (plist-put keep :gnugo-cf (cons (length new) capprop)) + (gnugo-put capprop new) + (delete-char old-len) + (insert (apply 'propertize new keep)) + (cl-incf adj (- (length new) old-len))) + (setq new (aref aft aft-idx)) + (insert-and-inherit (char-to-string new)) + (let ((yin (get-text-property cut 'gnugo-yin)) + (yang (gnugo-yang new))) + (add-text-properties cut (1+ cut) + `(gnugo-yang + ,yang + category + ,(gnugo-yy yin yang)))) + (delete-char 1) + ;; do this last to avoid complications w/ font lock + ;; (this also means we cannot include `intangible' in `front-sticky') + (when (setq very-strange (get-text-property (1+ cut) 'intangible)) + (put-text-property cut (1+ cut) 'intangible very-strange)))))) + +(defsubst gnugo--move-prop (node) + (or (assq :B node) + (assq :W node))) + +(defun gnugo--as-pos-func () + (let ((size (gnugo-get :SZ))) + ;; rv + (lambda (cc) + (if (string= "" cc) + "PASS" + (let ((col (aref cc 0))) + (format "%c%d" + (+ ?A (- (if (> ?i col) col (1+ col)) ?a)) + (- size (- (aref cc 1) ?a)))))))) + +(defsubst gnugo--resignp (string) + (string= "resign" string)) + +(defsubst gnugo--passp (string) + (string= "PASS" string)) + +(defun gnugo-move-history (&optional rsel color) + "Determine and return the game's move history. +Optional arg RSEL controls side effects and return value. +If nil, display the history in the echo area as \"(N moves)\" +followed by the space-separated list of moves. When called +interactively with a prefix arg (i.e., RSEL is `(4)'), display +similarly, but suffix with the mover (either \":B\" or \":W\"). +RSEL may also be a symbol that selects what to return: + car -- the most-recent move + cadr -- the next-to-most-recent move + two -- the last two moves as a list, oldest last + bpos -- the last stone on the board placed by COLOR +For all other values of RSEL, do nothing and return nil." + (interactive "P") + (let* ((monkey (gnugo-get :monkey)) + (mem (aref monkey 0)) + (as-pos (gnugo--as-pos-func)) + acc node mprop move) + (cl-flet* + ((as-pos-maybe (x) (if (gnugo--resignp x) + x + (funcall as-pos x))) + (remem () (setq node (pop mem) + mprop (gnugo--move-prop node))) + (next (byp) (when (remem) + (setq move (as-pos-maybe (cdr mprop))) + (push (if byp + (format "%s%s" move (car mprop)) + move) + acc))) + (nn () (next nil)) + (tell () (message "(%d moves) %s" + (length acc) + (mapconcat 'identity (nreverse acc) " "))) + (finish (byp) (while mem (next byp)) (tell))) + (pcase rsel + (`(4) (finish t)) + (`nil (finish nil)) + (`car (car (nn))) + (`cadr (nn) (car (nn))) + (`two (nn) (nn) acc) + (`bpos (cl-loop + with prop = (gnugo--prop<-color color) + while mem + when (and (remem) + (eq prop (car mprop)) + (setq move (cdr mprop)) + ;; i.e., "normal CC" position + (= 2 (length move))) + return (funcall as-pos move))) + (_ nil))))) + +(defun gnugo-boss-is-near () + "Do `bury-buffer' until the current one is not a GNU Board." + (interactive) + (while (gnugo-board-buffer-p) + (bury-buffer))) + +(defsubst gnugo--no-regrets (monkey ends) + (eq (aref ends (aref monkey 1)) + (aref monkey 0))) + +(defun gnugo--as-cc-func () + (let ((size (gnugo-get :SZ))) + (lambda (pos) + (let* ((col (aref pos 0)) + (one (+ ?a (- col (if (< ?H col) 1 0) ?A))) + (two (+ ?a (- size (string-to-number + (substring pos 1)))))) + (format "%c%c" one two))))) + +(defun gnugo--decorate (node &rest plist) + (cl-loop + with tp = (last node) + with fruit + while plist + do (setf + fruit (list (cons ; DWR: LtR OoE assumed. + (pop plist) + (pop plist))) + (cdr tp) fruit + tp fruit))) + +(defun gnugo-close-game (end-time resign) + (gnugo-put :game-end-time end-time) + (let ((now (or end-time (current-time)))) + (gnugo-put :scoring-seed (logior (ash (logand (car now) 255) 16) + (cadr now)))) + (gnugo-put :game-over + (if (or (eq t resign) + (and (stringp resign) + (string-match "[BW][+][Rr]esign" resign))) + (cl-flet + ((ls (color) (mapcar + (lambda (x) + (cons (list color) + (split-string x))) + (split-string + (gnugo-query "worm_stones %s" color) + "\n")))) + (let ((live (append (ls "black") (ls "white")))) + `((live ,@live) + (dead)))) + (let ((dd (gnugo-query "dragon_data")) + (start 0) mem color ent live dead) + (while (string-match "\\(.+\\):\n[^ ]+[ ]+\\(black\\|white\\)\n" + dd start) + (setq mem (match-string 1 dd) + color (match-string 2 dd) + start (match-end 0) + ent (cons (list color) + (sort (gnugo-lsquery "dragon_stones %s" mem) + 'string<))) + (string-match "\nstatus[ ]+\\(\\(ALIVE\\)\\|[A-Z]+\\)\n" + dd start) + (if (match-string 2 dd) + (push ent live) + (push ent dead)) + (setq start (match-end 0))) + `((live ,@live) + (dead ,@dead)))))) + +(defun gnugo--unclose-game () + (gnugo--forget :game-over ; all those in -close-game + :scoring-seed + :game-end-time) + (let* ((root (gnugo--root-node)) + (cur (assq :RE root))) + (when cur + (cl-assert (not (eq cur (car root))) nil + ":RE at head of root node: %S" + root) + (delq cur root)))) + +(defun gnugo-push-move (who move) + (let* ((simple (booleanp who)) + (ucolor (gnugo-get :user-color)) + (color (if simple + (if who + ucolor + (gnugo-get :gnugo-color)) + who)) + (start (gnugo-get :waiting-start)) + (now (current-time)) + (resignp (gnugo--resignp move)) + (passp (gnugo--passp move)) + (head (gnugo-move-history 'car)) + (onep (and head (gnugo--passp head))) + (donep (or resignp (and onep passp)))) + (unless resignp + (gnugo--q/ue "play %s %s" color move)) + (unless passp + (gnugo-merge-showboard-results)) + (gnugo-put :last-mover color) + (when (if simple + who + (string= ucolor color)) + (gnugo-put :last-user-bpos (and (not passp) (not resignp) move))) + ;; update :sgf-gametree and :monkey + (let* ((property (gnugo--prop<-color color)) + (pair (cons property (cond (resignp move) + (passp "") + (t (funcall (gnugo--as-cc-func) + move))))) + (fruit (list pair)) + (monkey (gnugo-get :monkey)) + (mem (aref monkey 0)) + (tip (car mem)) + (tree (gnugo-get :sgf-gametree)) + (ends (gnugo--tree-ends tree)) + (mnum (gnugo--tree-mnum tree)) + (count (length ends)) + (tip-move-num (gethash tip mnum)) + (bidx (aref monkey 1))) + ;; Detect déjà-vu. That is, when placing "A", avoid: + ;; + ;; X---Y---A new + ;; \ + ;; --A---B old + ;; + ;; (such "variations" do not actually vary!) in favor of: + ;; + ;; X---Y---A new + ;; \ + ;; --B old + ;; + ;; This linear search loses for multiple ‘old’ w/ "A", + ;; a very unusual (but not invalid, sigh) situation. + (cl-loop + with (bx previous) + for i + ;; Start with latest / highest likelihood for hit. + ;; (See "to the right" comment, below.) + from (if (gnugo--no-regrets monkey ends) + 1 + 0) + below count + if (setq bx (mod (+ bidx i) count) + previous + (cl-loop + with node + for m on (aref ends bx) + while (< tip-move-num + (gethash (setq node (car m)) + mnum)) + if (eq mem (cdr m)) + return (when (equal pair (assq property node)) + m) + finally return nil)) + ;; yes => follow + return + (progn + (unless (= bidx bx) + (cl-rotatef (aref ends bidx) + (aref ends bx))) + (setq mem previous)) + ;; no => construct + finally do + (progn + (unless (gnugo--no-regrets monkey ends) + (setq ends (gnugo--set-tree-ends + tree (let ((ls (append ends nil))) + ;; copy old to the right of new + (push mem (nthcdr bidx ls)) + ls)))) + (puthash fruit (1+ (gethash tip mnum)) mnum) + (push fruit mem) + (aset ends bidx mem))) + (setf (aref monkey 0) mem)) + (when start + (gnugo-put :last-waiting (cadr (time-subtract now start)))) + (when donep + (gnugo-close-game now resignp)) + (gnugo-put :waiting-start (and (not donep) now)) + donep)) + +(defun gnugo-venerate (yin yang) + (let* ((fg-yy (gnugo-yy yin yang)) + (fg-disp (or (get fg-yy 'display) + (get fg-yy 'do-not-display))) + (fg-props (cdr fg-disp)) + (fg-data (plist-get fg-props :data)) + (c-symbs (plist-get fg-props :color-symbols)) + (bg-yy (gnugo-yy yin (gnugo-yang ?.))) + (bg-disp (or (get bg-yy 'display) + (get bg-yy 'do-not-display))) + (bg-data (plist-get (cdr bg-disp) :data)) + (bop (lambda (s) + (let* ((start 0) + (ncolors + (when (string-match "\\([0-9]+\\)\\s-+[0-9]+\"," s) + (setq start (match-end 0)) + (string-to-number (match-string 1 s))))) + (while (and (not (cl-minusp ncolors)) + (string-match ",\n" s start)) + (setq start (match-end 0) + ncolors (1- ncolors))) + (string-match "\"" s start) + (match-end 0)))) + (new (copy-sequence fg-data)) + (lx (length fg-data)) + (sx (funcall bop fg-data)) + (sb (funcall bop bg-data)) + (color-key (aref new sx))) ; blech, heuristic + (while (< sx lx) + (when (and (not (= color-key (aref new sx))) + (cl-plusp (random 4))) + (aset new sx (aref bg-data sb))) + (cl-incf sx) + (cl-incf sb)) + (apply 'create-image new 'xpm t + :ascent 'center (when c-symbs + (list :color-symbols + c-symbs))))) + +(defun gnugo-refresh (&optional nocache) + "Update GNUGO Board buffer display. +While a game is in progress, parenthesize the last-played stone (no parens +for pass). If the buffer is currently displayed in the selected window, +recenter the board (presuming there is extra space in the window). Update +the mode line. Lastly, move point to the last position played by the user, +if that move was not a pass. + +Prefix arg NOCACHE requests complete reconstruction of the display, which may +be slow. (This should normally be unnecessary; specify it only if the display +seems corrupted.) NOCACHE is silently ignored when GNU Go is thinking about +its move." + (interactive "P") + (let* ((move (gnugo-move-history 'car)) + (game-over (gnugo-get :game-over)) + (inhibit-read-only t) + window last) + (when (and nocache (not (gnugo-get :waiting))) + (gnugo-propertize-board-buffer)) + ;; last move + (when move + (cl-destructuring-bind (l-ov . r-ov) (gnugo-get :paren-ov) + (if (member move '("PASS" "resign")) + (mapc 'delete-overlay (list l-ov r-ov)) + (gnugo-goto-pos move) + (let* ((p (point)) + (hspec (gnugo-get :highlight-last-move-spec)) + (display-value (nth 0 hspec)) + (l-offset (nth 1 hspec)) + (l-new-pos (+ p l-offset)) + (r-action (nth 2 hspec))) + (overlay-put l-ov 'display + (if (functionp display-value) + (funcall display-value p) + display-value)) + (move-overlay l-ov l-new-pos (1+ l-new-pos)) + (if r-action + (funcall r-action r-ov) + (move-overlay r-ov (+ l-new-pos 2) (+ l-new-pos 3))))))) + ;; buffer name + (rename-buffer (concat (gnugo-get :diamond) + (if game-over + (format "%s(game over)" + (if (gnugo--resignp move) + (concat move "ation ") + "")) + (format "%s(%s to play)" + (if move (concat move " ") "") + (gnugo-current-player))))) + ;; pall of death + (when game-over + (let ((live (cdr (assq 'live game-over))) + (dead (cdr (assq 'dead game-over))) + p pall) + (unless (eq game-over (get-text-property 1 'game-over)) + (dolist (group (append live dead)) + (dolist (pos (cdr group)) + (gnugo-goto-pos pos) + (setq p (point)) + (put-text-property p (1+ p) 'group group))) + (put-text-property 1 2 'game-over game-over)) + (dolist (group live) + (when (setq pall (cdar group)) + (mapc 'delete-overlay pall) + (setcdr (car group) nil))) + (dolist (group dead) + (unless (cdar group) + (let (ov pall c (color (caar group))) + (setq c (if (gnugo--blackp color) "x" "o")) + (dolist (pos (cdr group)) + (gnugo-goto-pos pos) + (setq p (point) ov (make-overlay p (1+ p))) + (overlay-put + ov 'display + (if (gnugo-get :display-using-images) + ;; respect the dead individually; it takes more time + ;; but that's not a problem (for them) + (gnugo-venerate (get-text-property p 'gnugo-yin) + (gnugo-yang (aref (upcase c) 0))) + (propertize c 'face 'font-lock-warning-face))) + (push ov pall)) + (setcdr (car group) pall)))))) + ;; window update + (when (setq window (get-buffer-window (current-buffer))) + (let* ((gridp (not (memq :nogrid buffer-invisibility-spec))) + (size (gnugo-get :SZ)) + (under10p (< size 10)) + (mul (gnugo-get :mul)) + (h (- (truncate (- (window-height window) + (* size (cdr mul)) + (if gridp 2 0)) + 2) + (if gridp 0 1))) + (edges (window-edges window)) + (right-w-edge (nth 2 edges)) + (avail-width (- right-w-edge (nth 0 edges))) + (wmul (car mul)) + (imagesp (symbol-plist (gnugo-f 'ispc))) + (w (/ (- avail-width + (* size wmul) + (if imagesp + 0 + (1- size)) + 2 ; between board and grid + (if gridp + (if under10p 2 4) + 0)) + 2.0))) + (dolist (pair `((tpad . ,(if (and h (cl-plusp h)) + `(display ,(make-string h 10)) + '(invisible :nogrid))) + (gpad . (display + (space :align-to + ,(+ w + 2.0 + (cond (imagesp (+ (* 0.5 wmul) + (if under10p + -0.5 + 0.5))) + (under10p 0) + (t 1)))))) + (gspc . ,(when imagesp + `(display + (space-width + ,(- + ;; DWR: image width alone => OBOE! + ;;- wmul + ;; NB: ‘(* wmul cw)’ is the same + ;; as ‘(car (image-size ... t))’. + (let ((cw (frame-char-width))) + (/ (+ 1.0 (* wmul cw)) + cw)) + 1.0))))) + (lpad . ,(let ((d `(display (space :align-to ,w)))) + ;; We distinguish between these cases to + ;; workaround a display bug whereby the + ;; `before-string' is omitted entirely (not + ;; rendered) when interacting w/ the text + ;; mode last-move left-paren for moves in + ;; column A. + (if gridp + `(before-string + ,(apply 'propertize " " d)) + d))) + (rpad . (display + (space :align-to ,(1- avail-width)))))) + (setplist (gnugo-f (car pair)) (cdr pair))))) + ;; mode line update + (let ((cur (gnugo-get :mode-line))) + (unless (equal cur gnugo-mode-line) + (setq cur gnugo-mode-line) + (gnugo-put :mode-line cur) + (gnugo-put :mode-line-form + (cond ((stringp cur) + (setq cur (copy-sequence cur)) + (let (acc cut c) + (while (setq cut (string-match "~[bwpmtu]" cur)) + (aset cur cut ?%) + (setq c (aref cur (cl-incf cut))) + (aset cur cut ?s) + (push + `(,(intern (format "squig-%c" c)) + ,(cl-case c + (?b '(or (gnugo-get :black-captures) 0)) + (?w '(or (gnugo-get :white-captures) 0)) + (?p '(gnugo-current-player)) + (?t '(let ((ws (gnugo-get :waiting-start))) + (if ws + (cadr (time-since ws)) + "-"))) + (?u '(or (gnugo-get :last-waiting) "-")) + (?m '(let ((tree (gnugo-get :sgf-gametree)) + (monkey (gnugo-get :monkey))) + (gethash (car (aref monkey 0)) + (gnugo--tree-mnum tree) + ;; should be unnecessary + "?"))))) + acc)) + `(let ,(delete-dups (copy-sequence acc)) + (format ,cur ,@(reverse (mapcar 'car acc)))))) + (t cur)))) + (let ((form (gnugo-get :mode-line-form))) + (setq mode-line-process + (and form + ;; this dynamicism is nice but excessive in its wantonness + ;;- `(" [" (:eval ,form) "]") + ;; this dynamicism is ok because the user triggers it + (format " [%s]" (eval form))))) + (force-mode-line-update)) + ;; last user move + (when (setq last (gnugo-get :last-user-bpos)) + (gnugo-goto-pos last)))) + +(defun gnugo--turn-the-wheel (&optional now) + (unless (gnugo-get :waiting) + (let ((color (gnugo-current-player)) + (wheel (gnugo-get :wheel))) + (setcar wheel + (when (and (not (gnugo-get :game-over)) + (member color (cdr wheel))) + (run-at-time + (if now + nil + 2) ;;; sec (frettoloso? dubioso!) + nil + (lambda (buf color wheel) + (setcar wheel nil) + (with-current-buffer buf + (gnugo-get-move color))) + (current-buffer) + color wheel)))))) + +(defun gnugo--finish-move (&optional now) + (let ((buf (current-buffer))) + (run-hooks 'gnugo-post-move-hook) + (set-buffer buf)) + (gnugo-refresh) + (gnugo--turn-the-wheel now)) + +;;;--------------------------------------------------------------------------- +;;; Game play actions + +(defun gnugo--rename-buffer-portion (&optional back) + (let ((old "to play") + (new "waiting for suggestion")) + (when back + (cl-rotatef old new)) + (let ((name (buffer-name))) + (when (string-match old name) + (rename-buffer (replace-match new t t name)))))) + +(defun gnugo--display-suggestion (color suggestion) + (message "%sSuggestion for %s: %s" + (gnugo-get :diamond) + color suggestion)) + +(defun gnugo-get-move-insertion-filter (proc string) + (with-current-buffer (process-buffer proc) + (let* ((so-far (gnugo-get :get-move-string)) + (full (gnugo-put :get-move-string (concat so-far string)))) + (when (string-match "^= \\(.+\\)\n\n" full) + (setq full (match-string 1 full)) ; POS or "PASS" + (cl-destructuring-bind (color . suggestion) + (gnugo-get :waiting) + (gnugo--forget :get-move-string + :waiting) + (if suggestion + (progn + (gnugo--rename-buffer-portion t) + (unless (or (gnugo--passp full) + (eq 'nowarp suggestion)) + (gnugo-goto-pos full)) + (gnugo--display-suggestion color full)) + (gnugo-push-move color full) + (gnugo--finish-move))))))) + +(defun gnugo-get-move (color &optional suggestion) + (gnugo-put :waiting (cons color suggestion)) + (gnugo--begin-exchange + (gnugo-get :proc) 'gnugo-get-move-insertion-filter + ;; We used to use ‘genmove’ here, but that forced asymmetry in + ;; downstream handling, an impediment to GNU Go vs GNU Go fun. + (concat "reg_genmove " color)) + (accept-process-output)) + +(defun gnugo-cleanup () + (when (gnugo-board-buffer-p) + (unless (zerop (buffer-size)) + (message "Thank you for playing GNU Go.")) + (setq gnugo-state nil))) + +(defun gnugo-position () + (or (get-text-property (point) 'gnugo-position) + (user-error "Not a proper position point"))) + +(defun gnugo-request-suggestion (&optional nowarp) + "Request a move suggestion from GNU Go. +After some time (during which you can do other stuff), +Emacs displays the suggestion in the echo area and warps the +cursor to the suggested position. Prefix arg inhibits warp." + (interactive "P") + (gnugo-gate t) + (gnugo--rename-buffer-portion) + (gnugo-get-move (gnugo-current-player) + (if nowarp + 'nowarp + t))) + +(defun gnugo--karma (color) ; => BOOL + (when (member color (cdr (gnugo-get :wheel))) + t)) + +(defsubst gnugo--:karma (role) + (gnugo--karma (gnugo-get role))) + +(defun gnugo--assist-state (&optional gate) + (let ((bool (gnugo--:karma :user-color))) + (if (and bool gate) + (user-error "Sorry, Assist mode enabled") + bool))) + +(defun gnugo--user-play (pos-or-pass) + (gnugo-gate t) + ;; The "user" in this func's name used to signify both + ;; who does the action and for whom the action is done. + ;; Now, it signifies only the former. + (let ((color (gnugo-current-player))) + ;; Don't get confused by mixed signals. + (when (gnugo--karma color) + (if (equal color (gnugo-get :one-shot)) + (gnugo--forget :one-shot) + (user-error "Sorry, you cannot play for %s at this time" + color))) + (gnugo-push-move color pos-or-pass)) + (gnugo--finish-move t)) + +(defun gnugo-move () + "Make a move on the GNUGO Board buffer. +The position is computed from current point. +Signal error if done out-of-turn or if game-over. +To start a game try M-x gnugo." + (interactive) + (gnugo--user-play (gnugo-position))) + +(defun gnugo-mouse-move (e) + "Do `gnugo-move' at mouse location." + (interactive "@e") + (mouse-set-point e) + (when (memq (following-char) '(?. ?+)) + (gnugo-move))) + +(defun gnugo-pass () + "Make a pass on the GNUGO Board buffer. +Signal error if done out-of-turn or if game-over. +To start a game try M-x gnugo." + (interactive) + (gnugo--user-play "PASS")) + +(defun gnugo-mouse-pass (e) + "Do `gnugo-pass' at mouse location." + (interactive "@e") + (mouse-set-point e) + (gnugo-pass)) + +(defun gnugo-resign () + (interactive) + (gnugo-gate t) + (if (not (y-or-n-p "Resign? ")) + (message "(not resigning)") + (gnugo-push-move t "resign") + (gnugo-refresh))) + +(defun gnugo-animate-group (w/d) + ;; W/D is a symbol, either ‘worm’ or ‘dragon’. + (gnugo-gate) + (let* ((pos (gnugo-position)) + (orig-b-m-p (buffer-modified-p)) + blurb stones) + (unless (memq (following-char) '(?X ?O)) + (user-error "No stone at %s" pos)) + (setq blurb (message "Computing %s stones ..." w/d) + stones (gnugo-lsquery "%s_stones %s" w/d pos)) + (message "%s %s in group." blurb (length stones)) + (setplist (gnugo-f 'anim) nil) + (let* ((spec (if (gnugo-get :display-using-images) + (cl-loop + with yin = (get-text-property (point) 'gnugo-yin) + with yang = (gnugo-yang (following-char)) + with up = (get (gnugo-yy yin yang t) 'display) + with dn = (get (gnugo-yy yin yang) 'display) + for n below (length gnugo-animation-string) + collect (if (zerop (logand 1 n)) + dn up)) + (split-string gnugo-animation-string "" t))) + (cell (list spec)) + (ovs (save-excursion + (mapcar (lambda (pos) + (gnugo-goto-pos pos) + (let* ((p (point)) + (ov (make-overlay p (1+ p)))) + (overlay-put ov 'category (gnugo-f 'anim)) + (overlay-put ov 'priority most-positive-fixnum) + ov)) + stones)))) + (setplist (gnugo-f 'anim) (cons 'display cell)) + (while (and (cdr spec) ; let last linger lest levity lost + (sit-for 0.08675309)) ; jenny jenny i got your number... + (setcar cell (setq spec (cdr spec))) + ;; Force redisplay of overlays. + (set-buffer-modified-p orig-b-m-p)) + (sit-for 5) + (mapc 'delete-overlay ovs) + t))) + +(defun gnugo-display-group-data (command buffer-name) + (gnugo-gate) + (message "Computing %s ..." command) + (let ((data (gnugo--q "%s %s" command (gnugo-position)))) + (switch-to-buffer buffer-name) + (erase-buffer) + (insert data)) + (message "Computing %s ... done." command)) + +(defun gnugo-worm-stones () + "In the GNUGO Board buffer, animate \"worm\" at current position. +Signal error if done out-of-turn or if game-over. +See variable `gnugo-animation-string' for customization." + (interactive) + (gnugo-animate-group 'worm)) + +(defun gnugo-worm-data () + "Display in another buffer data from \"worm\" at current position. +Signal error if done out-of-turn or if game-over." + (interactive) + (gnugo-display-group-data "worm_data" "*gnugo worm data*")) + +(defun gnugo-dragon-stones () + "In the GNUGO Board buffer, animate \"dragon\" at current position. +Signal error if done out-of-turn or if game-over. +See variable `gnugo-animation-string' for customization." + (interactive) + (gnugo-animate-group 'dragon)) + +(defun gnugo-dragon-data () + "Display in another buffer data from \"dragon\" at current position. +Signal error if done out-of-turn or if game-over." + (interactive) + (gnugo-display-group-data "dragon_data" "*gnugo dragon data*")) + +(defun gnugo-estimate-score () + "Display estimated score of a game of GNU Go. +Output includes number of stones on the board and number of stones +captured by each player, and the estimate of who has the advantage (and +by how many stones)." + (interactive) + (message "Est.score ...") + (let ((black (gnugo--count-query "list_stones black")) + (white (gnugo--count-query "list_stones white")) + (black-captures (gnugo-query "captures black")) + (white-captures (gnugo-query "captures white")) + (est (gnugo-query "estimate_score"))) + ;; might as well update this + (gnugo-put :black-captures black-captures) + (gnugo-put :white-captures white-captures) + (message "Est.score ... B %s %s | W %s %s | %s" + black black-captures white white-captures est))) + +(defun gnugo--ok-file (filename) + (setq default-directory + (file-name-directory + (expand-file-name filename))) + (set-buffer-modified-p nil)) + +(defun gnugo-write-sgf-file (filename) + "Save the game history to FILENAME (even if unfinished). +If FILENAME already exists, Emacs confirms that you wish to overwrite it." + (interactive "FWrite game as SGF file: ") + (when (and (file-exists-p filename) + (not (y-or-n-p "File exists. Continue? "))) + (user-error "Not writing %s" filename)) + (when (buffer-modified-p) + ;; take responsibility for our actions + (gnugo--set-root-prop :AP (cons "gnugo.el" gnugo-version))) + (gnugo/sgf-write-file (gnugo-get :sgf-collection) filename) + (gnugo--ok-file filename)) + +(defun gnugo--dance-dance (karma) + (cl-destructuring-bind (dance btw) + (aref [(moshpit " Zombie") + (classic nil) + (reverse " Zombie Assist") ; "Assist Zombie"? no thanks! :-D + (stilted " Assist")] + (cl-flet + ((try (n prop) + (if (member (gnugo-get prop) + karma) + n + 0))) + (+ (try 2 :user-color) + (try 1 :gnugo-color)))) + (gnugo-put :dance dance) ; pure cruft (for now) + (setq gnugo-btw btw))) + +(defun gnugo--who-is-who (wait play samep) + (unless samep + (let ((wheel (gnugo-get :wheel))) + (when wheel + (gnugo--dance-dance + (setcdr wheel (mapcar 'gnugo-other + (cdr wheel))))))) + (message "GNU Go %splays as %s, you as %s (%s)" + (if samep "" "now ") + wait play (if samep + "as before" + "NOTE: this is a switch!"))) + +(defsubst gnugo--nodep (x) + (keywordp (caar x))) + +(defun gnugo--SZ! (size) + (gnugo-put :SZ size) + (gnugo-put :center-position + (funcall (gnugo--as-pos-func) + (let ((c (+ -1 ?a (truncate (1+ size) 2)))) + (string c c))))) + +(defun gnugo--plant-and-climb (collection &optional sel) + (gnugo-put :sgf-collection collection) + (let ((tree (nth (or sel 0) collection))) + (gnugo-put :sgf-gametree tree) + (gnugo-put :monkey (vector + ;; mem + (aref (gnugo--tree-ends tree) 0) + ;; bidx + 0)) + tree)) + +(defun gnugo-read-sgf-file (filename) + "Load the first game tree from FILENAME, a file in SGF format." + (interactive "fSGF file to load: ") + (when (file-directory-p filename) + (user-error "Cannot load a directory (try a filename with extension .sgf)")) + (let (play wait samep coll tree game-over) + ;; problem: requiring GTP `loadsgf' complicates network subproc support; + ;; todo: skip it altogether when confident about `gnugo/sgf-create' + (setq play (gnugo--q/ue "loadsgf %s" (expand-file-name filename)) + wait (gnugo-other play) + samep (string= (gnugo-get :user-color) play)) + (gnugo-put :last-mover wait) + (unless samep + (gnugo-put :gnugo-color wait) + (gnugo-put :user-color play)) + (setq coll (gnugo/sgf-create filename) + tree (gnugo--plant-and-climb + coll (let ((n (length coll))) + ;; This is better: + ;; (if (= 1 n) + ;; 0 + ;; (let* ((q (format "Which game? (1-%d)" n)) + ;; (choice (1- (read-number q 1)))) + ;; (if (and (< -1 choice) (< choice n)) + ;; choice + ;; (message "(Selecting the first game)") + ;; 0))) + ;; but this is what we use (for now) to accomodate + ;; (aka faithfully mimic) GTP `loadsgf' limitations: + (unless (= 1 n) + (message "(Selecting the first game)")) + 0))) + ;; This is deliberately undocumented for now. + (gnugo--SZ! (gnugo--root-prop :SZ tree)) + (when (setq game-over (or (gnugo--root-prop :RE tree) + (when (equal '("PASS" "PASS") + (gnugo-move-history 'two)) + 'two-passes))) + (gnugo-close-game nil game-over)) + (gnugo-put :last-user-bpos + (gnugo-move-history 'bpos (gnugo-get :user-color))) + (gnugo-refresh t) + (gnugo--ok-file filename) + (gnugo--who-is-who wait play samep))) + +(defun gnugo--mem-with-played-stone (pos &optional noerror) + (let ((color (cl-case (following-char) + (?X :B) + (?O :W)))) + (if (not color) + (unless noerror + (user-error "No stone at %s" pos)) + (cl-loop + with fruit = (cons color (funcall (gnugo--as-cc-func) pos)) + for mem on (aref (gnugo-get :monkey) 0) + when (equal fruit (caar mem)) + return mem + finally return nil)))) + +(defun gnugo--climb-towards-root (spec &optional reaction keep) + (gnugo-gate) + (gnugo--assist-state t) + (let* ((user-color (gnugo-get :user-color)) + (monkey (gnugo-get :monkey)) + (tree (gnugo-get :sgf-gametree)) + (ends (gnugo--tree-ends tree)) + (remorseful (not (gnugo--no-regrets monkey ends))) + (stop (if (numberp spec) + (nthcdr (if (zerop spec) + (if (string= (gnugo-get :last-mover) + user-color) + 1 + 2) + spec) + (aref monkey 0)) + (cdr (gnugo--mem-with-played-stone + (if (stringp spec) + spec + (gnugo-position))))))) + (when (gnugo-get :game-over) + (gnugo--unclose-game)) + (while (and (not (eq stop (aref monkey 0))) + (gnugo--no-worries (gnugo--q "undo"))) + (pop (aref monkey 0)) + (gnugo-put :last-mover (gnugo-current-player)) + (gnugo-merge-showboard-results) ; all + (gnugo-refresh) ; this + (redisplay)) ; eye candy + (let* ((ulastp (string= (gnugo-get :last-mover) user-color)) + (ubpos (gnugo-move-history (if ulastp 'car 'cadr)))) + (gnugo-put :last-user-bpos (if (and ubpos (not (gnugo--passp ubpos))) + ubpos + (gnugo-get :center-position))) + (gnugo-refresh t) + (unless (or keep remorseful) + (aset ends (aref monkey 1) (aref monkey 0))) + (when ulastp + (let ((g (gnugo-get :gnugo-color))) + (cl-flet ((turn () (gnugo--turn-the-wheel t))) + (cl-case (or reaction gnugo-undo-reaction) + (play (turn)) + (play! (let ((wheel (gnugo-get :wheel))) + (cl-letf (((cdr wheel) (cons g (cdr wheel)))) + (turn)))) + (zombie (gnugo-zombie-mode 1)) + (t (gnugo-put :one-shot g))))))))) + +(defun gnugo-undo-one-move (&optional me-next) + "Undo exactly one move (perhaps GNU Go's, perhaps yours). +Do not schedule a move by GNU Go even if it is GNU Go's turn to play. +Prefix arg ME-NEXT means to arrange for you to play +the color of the next move (and GNU Go the opposite). +This is useful after loading an SGF file whose last +move was done by the color you prefer to play: + \\[gnugo-read-sgf-file] FILENAME RET + C-u \\[gnugo-undo-one-move] + +See also `gnugo-undo-two-moves'." + (interactive "P") + (gnugo-gate) + (when me-next + (let* ((play (gnugo-get :last-mover)) + (wait (gnugo-other play)) + (samep (string= play (gnugo-get :user-color)))) + (gnugo-put :user-color play) + (gnugo-put :gnugo-color wait) + (gnugo--who-is-who wait play samep))) + (gnugo--climb-towards-root 1 (cl-case gnugo-undo-reaction + (zombie gnugo-undo-reaction) + (t 'one-shot)))) + +(defun gnugo-undo-two-moves () + "Undo a pair of moves (GNU Go's and yours). +However, if you are the last mover, undo only one move. +Regardless, after undoing, it is your turn to play again." + (interactive) + (gnugo--climb-towards-root 0)) + +(defun gnugo-oops (&optional position) + "Like `gnugo-undo-two-moves', but keep the undone moves. +The kept moves become a sub-gametree (variation) when play resumes. +Prefix arg means, instead, undo repeatedly up to and including +the move which placed the stone at point, like `\\[gnugo-fancy-undo]'." + (interactive "P") + (gnugo--climb-towards-root (unless position + 0) + nil t)) + +(defun gnugo-okay (&optional full) + "Redo a pair of undone moves. +Prefix arg means to redo all the undone moves." + (interactive "P") + (gnugo-gate) + (let* ((tree (gnugo-get :sgf-gametree)) + (ends (gnugo--tree-ends tree)) + (monkey (gnugo-get :monkey))) + (if (gnugo--no-regrets monkey ends) + (message "Oop ack!") + (let* ((as-pos (gnugo--as-pos-func)) + (mnum (gnugo--tree-mnum tree)) + (mem (aref monkey 0)) + (bidx (aref monkey 1)) + (end (aref ends bidx)) + (ucolor (gnugo-get :user-color)) + (uprop (gnugo--prop<-color ucolor))) + (cl-flet ((mvno (node) (gethash node mnum))) + (cl-loop + with ok = (if full + (mvno (car end)) + (+ 2 (mvno (car mem)))) + with (node move todo) + for ls on end + do (progn + (setq node (car ls) + move (gnugo--move-prop node)) + (when (and move (>= ok (mvno node))) + (let ((userp (eq uprop (car move)))) + (push (list userp + (funcall as-pos (cdr move))) + todo)))) + until (eq mem (cdr ls)) + finally do + (cl-loop + for (userp pos) in todo + do (progn + (gnugo-push-move userp pos) + (gnugo-refresh) + (redisplay))))))))) + +(defun gnugo-display-final-score (&optional comment) + "Display final score and other info in another buffer (when game over). +If the game is still ongoing, Emacs asks if you wish to stop play (by +making sure two \"pass\" moves are played consecutively, if necessary). +Also, add the `:RE' SGF property to the root node of the game tree. +Prefix arg COMMENT means to also attach the text (slightly compacted) +to the last move, as a comment." + (interactive "P") + (let ((game-over (gnugo-get :game-over))) + (unless (or game-over + (and (not (gnugo-get :waiting)) + (y-or-n-p "Game still in play. Stop play now? "))) + (user-error "Sorry, game still in play")) + (unless game-over + (cl-flet + ((pass (userp) + (message "Playing PASS for %s ..." + (gnugo-get (if userp :user-color :gnugo-color))) + (sit-for 1) + (gnugo-push-move userp "PASS"))) + (unless (pass t) + (pass nil))) + (gnugo-refresh) + (sit-for 3))) + (let ((b= " Black = ") + (w= " White = ") + (res (when (gnugo--resignp (gnugo-move-history 'car)) + (gnugo-get :last-mover))) + blurb result) + (if res + (setq blurb (list + (format "%s wins.\n" + (substring (if (= ?b (aref res 0)) w= b=) + 3 8)) + "The game is over.\n" + (format "Resignation by %s.\n" res)) + result (concat (upcase (substring (gnugo-other res) 0 1)) + "+Resign")) + (message "Computing final score ...") + (let* ((g-over (gnugo-get :game-over)) + (live (cdr (assq 'live g-over))) + (dead (cdr (assq 'dead g-over))) + (seed (gnugo-get :scoring-seed)) + (terr-q (format "final_status_list %%s_territory %d" seed)) + (terr "territory") + (capt "captures") + (b-terr (gnugo--count-query terr-q "black")) + (w-terr (gnugo--count-query terr-q "white")) + (b-capt (string-to-number (gnugo-get :black-captures))) + (w-capt (string-to-number (gnugo-get :white-captures))) + (komi (gnugo--root-prop :KM))) + (setq blurb (list "The game is over. Final score:\n") + result (gnugo-query "final_score %d" seed)) + (cond ((string= "Chinese" (gnugo--root-prop :RU)) + (dolist (group live) + (cl-incf (if (gnugo--blackp (caar group)) + b-terr + w-terr) + (length (cdr group)))) + (dolist (group dead) + (cl-incf (if (gnugo--blackp (caar group)) + w-terr + b-terr) + (length (cdr group)))) + (push (format "%s%d %s = %3.1f\n" b= b-terr terr b-terr) blurb) + (push (format "%s%d %s + %3.1f %s = %3.1f\n" w= + w-terr terr komi 'komi (+ w-terr komi)) + blurb)) + (t + (dolist (group dead) + (cl-incf (if (gnugo--blackp (caar group)) + w-terr + b-terr) + (* 2 (length (cdr group))))) + (push (format "%s%d %s + %s %s = %3.1f\n" b= + b-terr terr + b-capt capt + (+ b-terr b-capt)) + blurb) + (push (format "%s%d %s + %s %s + %3.1f %s = %3.1f\n" w= + w-terr terr + w-capt capt + komi 'komi + (+ w-terr w-capt komi)) + blurb))) + (push (if (string= "0" result) + "The game is a draw.\n" + (format "%s wins by %s.\n" + (substring (if (= ?B (aref result 0)) b= w=) 3 8) + (substring result 2))) + blurb) + (message "Computing final score ... done"))) + ;; extra info + (let ((beg (gnugo-get :game-start-time)) + (end (gnugo-get :game-end-time))) + (when end + (push "\n" blurb) + (cl-flet + ((yep (pretty moment) + (push (format-time-string + (concat pretty ": %F %T %z\n") + moment) + blurb))) + (yep "Game start" beg) + (yep " end" end)))) + (setq blurb (apply 'concat (nreverse blurb))) + (gnugo--set-root-prop :RE result) + (when comment + (let ((node (car (aref (gnugo-get :monkey) 0)))) + (gnugo--decorate + (delq (assq :C node) node) + :C + (with-temp-buffer ; lame + (insert blurb) + (when (search-backward "\n\nGame start:" nil t) + (delete-region (point) (point-max))) + (cl-flet ((rep (old new) + (goto-char (point-min)) + (while (search-forward old nil t) + (replace-match new)))) + (rep "The game is over. " "") + (rep "territory" "T") + (rep "captures" "C") + (rep "komi" "K")) + (buffer-string))))) + (switch-to-buffer (format "%s*GNUGO Final Score*" (gnugo-get :diamond))) + (erase-buffer) + (insert blurb))) + +(defun gnugo-quit () + "Kill the current buffer, assumed to be in GNUGO Board mode, maybe. +If the game is not over, ask for confirmation first." + (interactive) + (if (or (gnugo-get :game-over) + (y-or-n-p "Quit? ")) + (kill-buffer nil) + (message "(not quitting)"))) + +(defun gnugo-leave-me-alone () + "Kill the current buffer unconditionally." + (interactive) + (kill-buffer nil)) + +(defun gnugo-fancy-undo (count) + "Rewind the game tree in various ways. +Prefix arg COUNT means to undo that many moves. +Otherwise, undo repeatedly up to and including the move +which placed the stone at point." + (interactive "P") + (gnugo--climb-towards-root + (if (numberp count) + count + (car-safe count)))) + +(define-minor-mode gnugo-image-display-mode + "If enabled, display the board using images. +See function `display-images-p' and variable `gnugo-xpms'." + :variable + ((gnugo-get :display-using-images) + . + (lambda (bool) + (unless (eq bool (gnugo-get :display-using-images)) + (gnugo-toggle-image-display) + (save-excursion (gnugo-refresh)))))) + +(defsubst gnugo--node-with-played-stone (pos &optional noerror) + (car (gnugo--mem-with-played-stone pos noerror))) + +(defun gnugo-describe-position () + "Display the board position under cursor in the echo area. +If there a stone at that position, also display its move number." + (interactive) + (let* ((pos (gnugo-position)) ; do first (can throw) + (node (gnugo--node-with-played-stone pos t))) + (message + "%s%s" pos + (or (when node + (let* ((tree (gnugo-get :sgf-gametree)) + (mnum (gnugo--tree-mnum tree)) + (move-num (gethash node mnum))) + (format " (move %d)" move-num))) + "")))) + +(defun gnugo-switch-to-another () + "Switch to another GNU Go game buffer (if any)." + (interactive) + (cl-loop + for buf in (cdr (buffer-list)) + if (gnugo-board-buffer-p buf) + return (progn + (bury-buffer) + (switch-to-buffer buf)) + finally do (message "(only one)"))) + +(defun gnugo-comment (node comment) + "Add to NODE a COMMENT (string) property. +Called interactively, NODE is the one corresponding to the +stone at point, and any previous comment is inserted as the +initial-input (see `read-string'). + +If COMMENT is nil or the empty string, remove the property entirely." + (interactive + (let* ((pos (gnugo-position)) + (node (gnugo--node-with-played-stone pos))) + (list node + (read-string (format "Comment for %s: " + (gnugo-describe-position)) + (cdr (assq :C node)))))) + (setq node (delq (assq :C node) node)) + (unless (zerop (length comment)) + (gnugo--decorate node :C comment))) + +(defun gnugo--struggle (prop updn) + (unless (eq updn (gnugo--:karma prop)) ; drudgery avoidance + (let ((color (gnugo-get prop))) + (if updn + ;; enable + (gnugo-gate) + ;; disable + (let ((waiting (gnugo-get :waiting))) + (when (and waiting (string= color (car waiting))) + (gnugo--rename-buffer-portion) + (setcdr waiting + ;; heuristic: Warp only if it appears + ;; that the user is "following along". + (or (ignore-errors + (string= (gnugo-position) + (gnugo-move-history 'bpos color))) + 'nowarp)) + (gnugo--display-suggestion color "forthcoming") + (sit-for 2)))) + (let* ((wheel (gnugo-get :wheel)) + (timer (car wheel)) + (karma (cdr wheel))) + (when (timerp timer) + (cancel-timer timer)) + (setcar wheel nil) + (setcdr wheel (setq karma + ;; walk to the west, fly to the east, + ;; talk and then rest, cry and then feast. + ;; 99 beers down thirsty throats sloshed? + ;; 500 years under pink mountains squashed? + ;; balk with the best, child now re-creased! + (if updn + (push color karma) + (delete color karma)))) + (gnugo--dance-dance karma)) + (gnugo--turn-the-wheel t)))) + +(define-minor-mode gnugo-assist-mode + "If enabled (\"Assist\" in mode line), GNU Go plays for you. +When disabling, if GNU Go has already started thinking of +a move to play for you, the thinking is not cancelled but instead +transformed into a move suggestion (see `gnugo-request-suggestion')." + :variable + ((gnugo--assist-state) + . + (lambda (bool) + (gnugo--struggle :user-color bool)))) + +(define-minor-mode gnugo-zombie-mode + "If enabled (\"Zombie\" in mode line), GNU Go lets you play for it. +When disabling, if GNU Go has already started thinking of +a move to play, the thinking is not cancelled but instead +transformed into a move suggestion (see `gnugo-request-suggestion')." + :variable + ((not (gnugo--:karma :gnugo-color)) + . + (lambda (bool) + (gnugo--struggle :gnugo-color (not bool))))) + +;;;--------------------------------------------------------------------------- +;;; Command properties and gnugo-command + +;; GTP commands entered by the user are never issued directly to GNU Go; +;; instead, their behavior and output are controlled by the property +;; `:gnugo-gtp-command-spec' hung off of each (interned/symbolic) command. +;; The value of this property is a sub-plist, w/ sub-properties as follows: +;; +;; :full -- completely interpret the command string; the value is a +;; func that takes the list of words derived from splitting the +;; command string (minus the command) and handles everything. +;; +;; :output -- either a keyword specifying the preferred output method: +;; :message -- show output in minibuffer +;; :discard -- sometimes you just don't care; +;; or a function that takes one arg, the output string, and +;; handles it completely. default is to switch to buffer +;; "*gnugo command output*" if the output has a newline, +;; otherwise use `message'. +;; +;; :post-thunk -- run after output processing (at the very end). + +(defun gnugo-command (command) + "Send the Go Text Protocol COMMAND (a string) to GNU Go. +Output and Emacs behavior depend on which command is given (some +commands are handled completely by Emacs w/o using the subprocess; +some commands have their output displayed in specially prepared +buffers or in the echo area; some commands are instrumented to do +gnugo.el-specific housekeeping). + +For example, for the command \"help\", Emacs visits the +GTP command reference info page. + +NOTE: At this time, GTP command handling specification is still + incomplete. Thus, some commands WILL confuse gnugo.el." + (interactive "sCommand: ") + (if (string= "" command) + (message "(no command given)") + (let* ((split (split-string command)) + (cmd (intern (car split))) + (spec (get cmd :gnugo-gtp-command-spec)) + (full (plist-get spec :full))) + (if full + (funcall full (cdr split)) + (message "Doing %s ..." command) + (let* ((ans (gnugo--q command)) + (where (plist-get spec :output))) + (if (string-match "unknown.command" ans) + (message "%s" ans) + (cond ((functionp where) (funcall where ans)) + ((eq :discard where) (message "")) + ((or (eq :message where) + (not (string-match "\n" ans))) + (message "%s" ans)) + (t (switch-to-buffer "*gnugo command output*") + (erase-buffer) + (insert ans) + (message "Doing %s ... done." command))) + (let ((thunk (plist-get spec :post-thunk))) + (when thunk (funcall thunk))))))))) + +;;;--------------------------------------------------------------------------- +;;; Major mode for interacting with a GNUGO subprocess + +(define-derived-mode gnugo-board-mode special-mode "GNUGO Board" + "Major mode for playing GNU Go. +Entering this mode runs the normal hook `gnugo-board-mode-hook'. +In this mode, keys do not self insert." + (buffer-disable-undo) ; todo: undo undo undoing + (setq font-lock-defaults '(gnugo-font-lock-keywords t) + truncate-lines t) + (add-hook 'kill-buffer-hook 'gnugo-cleanup nil t) + (set (make-local-variable 'gnugo-state) + (gnugo--mkht :size (1- 42))) + (set (make-local-variable 'gnugo-btw) nil) + (add-to-list 'minor-mode-alist '(gnugo-btw gnugo-btw)) + (gnugo-put :highlight-last-move-spec + (gnugo-put :default-highlight-last-move-spec '("(" -1 nil))) + (gnugo-put :paren-ov (cons (make-overlay 1 1) + (let ((ov (make-overlay 1 1))) + (overlay-put ov 'display ")") + ov))) + (gnugo-put :mul '(1 . 1)) + (gnugo-put :obarray (make-vector 31 nil)) + (add-to-invisibility-spec :nogrid)) + +;;;--------------------------------------------------------------------------- +;;; Entry point + +;;;###autoload +(defun gnugo (&optional new-game) + "Run gnugo in a buffer, or resume a game in progress. +If there is already a game in progress you may resume it instead +of starting a new one. Prefix arg means skip the game-in-progress +check and start a new game straight away. + +Before starting, Emacs queries you for additional command-line +options (Emacs supplies \"--mode gtp --quiet\" automatically). + +Note that specifying \"--infile FILENAME\" (or, \"-l FILENAME\") +silently clobbers certain other options, such as \"--color\". +For details, see info node `(gnugo) Invoking GNU Go'. + +\\ +To play, use \\[gnugo-move] to place a stone or \\[gnugo-pass] to pass. +See `gnugo-board-mode' for a full list of commands." + (interactive "P") + (let* ((all (let (acc) + (dolist (buf (buffer-list)) + (when (gnugo-board-buffer-p buf) + (push (cons (buffer-name buf) buf) acc))) + acc)) + (n (length all))) + (if (and (not new-game) + (cl-plusp n) + (y-or-n-p (format "GNU Go game%s in progress, resume play? " + (if (= 1 n) "" "s")))) + ;; resume + (switch-to-buffer + (cdr (if (= 1 n) + (car all) + (let ((sel (completing-read "Which one? " all nil t))) + (if (string= "" sel) + (car all) + (assoc sel all)))))) + ;; sanity check + (unless (executable-find gnugo-program) + (user-error "Invalid `gnugo-program': %S" gnugo-program)) + ;; set up a new board + (switch-to-buffer (generate-new-buffer "(Uninitialized GNUGO Board)")) + (gnugo-board-mode) + (let* ((filename nil) + (user-color "black") + (args (cl-loop + with ls = (split-string + ;; todo: grok ‘gnugo --help’; completion + (read-string + "GNU Go options: " + (car gnugo-option-history) + 'gnugo-option-history)) + with ok + while ls do + (let ((arg (pop ls))) + (cl-flet + ((ex (opt fn) + (if filename + (warn "%s %s ignored" opt fn) + (setq filename fn)))) + (cond + ((string= "--color" arg) + (push arg ok) + (push + ;; Unfortunately, GTP does not provide + ;; a way to query the user color, so + ;; we must resort to this weirdness. + (setq user-color + (pop ls)) + ok)) + ((string= "--infile" arg) + (ex "--infile" (pop ls))) + ((string-match "^-l" arg) + (ex "-l" (if (< 2 (length arg)) + (substring arg 2) + (pop ls)))) + (t (push arg ok))))) + finally return (nreverse ok))) + (proc (apply 'start-process "gnugo" + (current-buffer) + gnugo-program + "--mode" "gtp" "--quiet" + args)) + root board-size handicap komi) + (gnugo-put :user-color user-color) + (gnugo-put :proc proc) + (set-process-sentinel proc 'gnugo-sentinel) + ;; Emacs is too protective sometimes, blech. + (set-process-query-on-exit-flag proc nil) + (gnugo-put :diamond (substring (process-name proc) 5)) + (gnugo-put :gnugo-color (gnugo-other user-color)) + (if filename + (gnugo-read-sgf-file (expand-file-name filename)) + (cl-flet + ((r! (&rest plist) (apply 'gnugo--decorate root plist))) + (gnugo--SZ! + (setq root (gnugo--root-node + (gnugo--plant-and-climb + (gnugo/sgf-create "(;FF[4]GM[1])" t))) + komi (gnugo--nquery "get_komi") + handicap (gnugo--nquery "get_handicap") + board-size (gnugo--nquery "query_boardsize"))) + ;; Work around a GNU Go 3.8 (and possibly earlier/later) + ;; bug whereby GTP command ‘get_handicap’ fails to return + ;; the N set by ‘--handicap N’ on the command line. + (let ((actually (member "--handicap" args))) + ;; Checking ‘(zerop handicap)’ first is not strictly + ;; necessary; it represents a hope that some day GNU Go + ;; will DTRT (or provide rationale for this weird behavior) + ;; and become worthy of our trust. + (when (and (zerop handicap) actually) + (setq handicap (string-to-number (cadr actually))))) + (r! :SZ board-size + :DT (format-time-string "%F") + :RU (if (member "--chinese-rules" args) + "Chinese" + "Japanese") + :KM komi) + (let ((ub (gnugo--blackp user-color))) + (r! (if ub :PW :PB) (concat "GNU Go " (gnugo-query "version")) + (if ub :PB :PW) (user-full-name))) + (unless (zerop handicap) + (r! :HA handicap + :AB (mapcar (gnugo--as-cc-func) + (gnugo-lsquery "fixed_handicap %d" + handicap))))))) + (gnugo-put :waiting-start (current-time)) + (gnugo-refresh t) + (gnugo-goto-pos (or (gnugo-get :last-user-bpos) + (gnugo-get :center-position))) + ;; first move + (gnugo-put :game-start-time (current-time)) + (let ((g (gnugo-get :gnugo-color)) + (n (or (gnugo--root-prop :HA) 0)) + (u (gnugo-get :user-color))) + (unless (gnugo-get :last-mover) + (gnugo-put :last-mover + (if (or (and (gnugo--blackp u) (< 1 n)) + (and (gnugo--blackp g) (< n 2))) + u + g))) + (let ((karma (list g))) + (gnugo-put :wheel (cons nil karma)) + (gnugo--dance-dance karma)) + (run-hooks 'gnugo-start-game-hook) + (gnugo--turn-the-wheel))))) + +;;;--------------------------------------------------------------------------- +;;; Load-time actions + +(unless (get 'help :gnugo-gtp-command-spec) + (cl-flet* + ((sget (x) (get x :gnugo-gtp-command-spec)) + (jam (cmd prop val) (put cmd :gnugo-gtp-command-spec + (plist-put (sget cmd) prop val))) + (validpos (s &optional go) + (let ((pos (upcase s))) + (cl-loop + with size = (gnugo-get :SZ) + for c across (funcall (gnugo--as-cc-func) + pos) + do (let ((norm (- c ?a))) + (unless (and (< -1 norm) + (> size norm)) + (user-error "Invalid position: %s" + pos)))) + (when go + (gnugo-goto-pos pos)) + pos)) + (defgtp (x &rest props) (dolist (cmd (if (symbolp x) (list x) x)) + (let ((ls props)) + (while ls + (jam cmd (car ls) (cadr ls)) + (setq ls (cddr ls))))))) + (cl-macrolet ((deffull (who &body body) + (declare (indent 1)) + `(defgtp ',who :full (lambda (sel) + ,@body)))) + + (deffull help + (info "(gnugo)GTP command reference") + (when sel (setq sel (intern (car sel)))) + (let (buffer-read-only pad cur spec output found) + (cl-flet + ((note (s) (insert pad "[NOTE: gnugo.el " s ".]\n"))) + (goto-char (point-min)) + (save-excursion + (while (re-search-forward "^ *[*] \\([a-zA-Z_]+\\)\\(:.*\\)*\n" + nil t) + (unless pad + (setq pad (make-string (- (match-beginning 1) + (match-beginning 0)) + 32))) + (when (plist-get + (setq spec + (get (setq cur (intern (match-string 1))) + :gnugo-gtp-command-spec)) + :full) + (note "handles this command completely")) + (when (setq output (plist-get spec :output)) + (if (functionp output) + (note "handles the output specially") + (cl-case output + (:discard (note "discards the output")) + (:message (note "displays the output in the echo area"))))) + (when (eq sel cur) + (setq found (make-marker)) + (set-marker found (match-beginning 0)))))) + (cond (found (goto-char found) (set-marker found nil)) + ((not sel)) + (t (message "(no such command: %s)" sel))))) + + (deffull final_score + ;; Explicit ignorance avoids byte-compiler warning. + (ignore sel) + (gnugo-display-final-score)) + + (defgtp '(boardsize + clear_board + fixed_handicap) + :output :discard + :post-thunk (lambda () + (gnugo--unclose-game) + (gnugo--forget :last-mover) + ;; ugh + (gnugo--SZ! (gnugo--nquery "query_boardsize")) + (gnugo-refresh t))) + + (deffull loadsgf + (gnugo-read-sgf-file (car sel))) + + (deffull (undo gg-undo) + (gnugo--climb-towards-root + (let (n) + (cond ((not sel) 1) + ((cl-plusp (setq n (string-to-number (car sel)))) n) + (t (validpos (car sel) t))))))))) + +(provide 'gnugo) + + +;;;--------------------------------------------------------------------------- +;;; The remainder of this file defines a simplified SGF-handling library. +;;; When/if it should start to attain generality, it should be split off into +;;; a separate file (probably named sgf.el) w/ funcs and vars renamed sans the +;;; "gnugo/" prefix. + +(defconst gnugo/sgf-*r4-properties* + '((AB "Add Black" setup list stone) + (AE "Add Empty" game list point) + (AN "Annotation" game simpletext) + (AP "Application" root (simpletext . simpletext)) + (AR "Arrow" - list (point . point)) + (AS "Who adds stones" - simpletext) ; (LOA) + (AW "Add White" setup list stone) + (B "Black" move move) + (BL "Black time left" move real) + (BM "Bad move" move double) + (BR "Black rank" game simpletext) + (BT "Black team" game simpletext) + (C "Comment" - text) + (CA "Charset" root simpletext) + (CP "Copyright" game simpletext) + (CR "Circle" - list point) + (DD "Dim points" - elist point) ; (inherit) + (DM "Even position" - double) + (DO "Doubtful" move none) + (DT "Date" game simpletext) + (EV "Event" game simpletext) + (FF "Fileformat" root [number (1 . 4)]) + (FG "Figure" - (or none (number . simpletext))) + (GB "Good for Black" - double) + (GC "Game comment" game text) + (GM "Game" root [number (1 . 20)]) + (GN "Game name" game simpletext) + (GW "Good for White" - double) + (HA "Handicap" game number) ; (Go) + (HO "Hotspot" - double) + (IP "Initial pos." game simpletext) ; (LOA) + (IT "Interesting" move none) + (IY "Invert Y-axis" game simpletext) ; (LOA) + (KM "Komi" game real) ; (Go) + (KO "Ko" move none) + (LB "Label" - list (point . simpletext)) + (LN "Line" - list (point . point)) + (MA "Mark" - list point) + (MN "set move number" move number) + (N "Nodename" - simpletext) + (OB "OtStones Black" move number) + (ON "Opening" game text) + (OT "Overtime" game simpletext) + (OW "OtStones White" move number) + (PB "Player Black" game simpletext) + (PC "Place" game simpletext) + (PL "Player to play" setup color) + (PM "Print move mode" - number) ; (inherit) + (PW "Player White" game simpletext) + (RE "Result" game simpletext) + (RO "Round" game simpletext) + (RU "Rules" game simpletext) + (SE "Markup" - point) ; (LOA) + (SL "Selected" - list point) + (SO "Source" game simpletext) + (SQ "Square" - list point) + (ST "Style" root [number (0 . 3)]) + (SU "Setup type" game simpletext) ; (LOA) + (SZ "Size" root (or number (number . number))) + (TB "Territory Black" - elist point) ; (Go) + (TE "Tesuji" move double) + (TM "Timelimit" game real) + (TR "Triangle" - list point) + (TW "Territory White" - elist point) ; (Go) + (UC "Unclear pos" - double) + (US "User" game simpletext) + (V "Value" - real) + (VW "View" - elist point) ; (inherit) + (W "White" move move) + (WL "White time left" move real) + (WR "White rank" game simpletext) + (WT "White team" game simpletext) + (LT "Lose on time" setup simpletext)) + ;; r4-specific notes + ;; - changed: DT FG LB RE RU SZ + ;; - added: AP AR AS DD IP IY LN OT PM SE SQ ST SU VW + "List of SGF[4] properties, each of the form (PROP NAME CONTEXT SPEC...).") + +(defun gnugo/sgf-create (file-or-data &optional data-p) + "Return the SGF[4] collection parsed from FILE-OR-DATA. +FILE-OR-DATA is a file name or SGF[4] data. +Optional arg DATA-P non-nil means FILE-OR-DATA is +a string containing SGF[4] data. +A collection is a list of gametrees, each a vector of four elements: + + ENDS -- a vector of node lists, with shared tails + (last element of all the lists is the root node) + + MNUM -- `eq' hash: node to move numbers; non-\"move\" nodes + have a move number of the previous \"move\" node (or zero) + + ROOT -- the root node" + ;; Arg names inspired by `create-image', despite -P being frowned upon. + (let ((keywords (or (get 'gnugo/sgf-*r4-properties* :keywords) + (put 'gnugo/sgf-*r4-properties* :keywords + (mapcar (lambda (full) + (cons (car full) + (intern (format ":%s" (car full))))) + gnugo/sgf-*r4-properties*)))) + (specs (or (get 'gnugo/sgf-*r4-properties* :specs) + (put 'gnugo/sgf-*r4-properties* :specs + (mapcar (lambda (full) + (cons (car full) (cl-cdddr full))) + gnugo/sgf-*r4-properties*)))) + SZ) + (cl-labels + ((sw () (skip-chars-forward " \t\n")) + (x (end preserve-whitespace) + (let ((beg (point)) + (endp (cl-case end + (:end (lambda (char) (= ?\] char))) + (:mid (lambda (char) (= ?\: char))) + (t (lambda (char) (or (= ?\: char) + (= ?\] char)))))) + c) + (while (not (funcall endp (setq c (following-char)))) + (cond ((= ?\\ c) + (delete-char 1) + (if (eolp) + (kill-line 1) + (forward-char 1))) + ((unless preserve-whitespace + (looking-at "\\s-+")) + (delete-region (point) (match-end 0)) + (insert " ")) + (t (forward-char 1)))) + (buffer-substring-no-properties beg (point)))) + (one (type end) (let ((s (progn + (forward-char 1) + (x end (eq 'text type))))) + (cl-case type + ((stone point move) + ;; blech, begone bu"tt"-ugly blatherings + ;; (but bide brobdingnagian boards)... + (if (and (string= "tt" s) + SZ + (>= 19 SZ)) + "" + s)) + ((simpletext color) s) + ((number real double) (string-to-number s)) + ((text) s) + ((none) "") + (t (error "Unhandled type: %S" type))))) + (val (spec) (cond ((symbolp spec) + (one spec :end)) + ((vectorp spec) + ;; todo: check range here. + (one (aref spec 0) :end)) + ((eq 'or (car spec)) + (let ((v (one (cadr spec) t))) + (if (= ?\] (following-char)) + v + (forward-char 1) + ;; todo: this assumes `spec' has the form + ;; (or foo (foo . bar)) + ;; i.e., foo is not rescanned. e.g., `SZ'. + ;; probably this assumption is consistent + ;; w/ the SGF authors' desire to make the + ;; parsing easy, but you never know... + (cons v (one (cl-cdaddr spec) :end))))) + (t (cons (one (car spec) :mid) + (one (cdr spec) :end))))) + (short (who) (when (eobp) + (error "Unexpected EOF while reading %s" who))) + (atvalp () (= ?\[ (following-char))) + (PROP () (let (name spec ltype) + (sw) (short 'property) + (when (looking-at "[A-Z]") + (setq name (read (current-buffer)) + spec (cdr (assq name specs))) + (sw) + (cons + (cdr (assq name keywords)) + (prog1 (if (= 1 (length spec)) + (val (car spec)) + (unless (memq (setq ltype (car spec)) + '(elist list)) + (error "Bad spec: %S" spec)) + (if (and (eq 'elist ltype) (sw) + (not (atvalp))) + nil + (let ((type (cadr spec)) + mo ls) + (while (and (sw) (atvalp) + (setq mo (val type))) + (push mo ls) + (forward-char 1)) + (forward-char -1) + (nreverse ls)))) + (forward-char 1)))))) + (morep () (and (sw) (not (eobp)))) + (seek (c) (and (morep) (= c (following-char)))) + (seek-into (c) (when (seek c) + (forward-char 1) + t)) + (NODE () (when (seek-into ?\;) + (cl-loop + with prop + while (setq prop (PROP)) + collect (progn + (when (eq :SZ (car prop)) + (setq SZ (cdr prop))) + prop)))) + (TREE (parent mnum) + (let ((ls parent) + prev node) + (seek-into ?\() + (while (seek ?\;) + (setq prev (car ls) + node (NODE)) + (puthash node (+ (if (gnugo--move-prop node) + 1 + 0) + (gethash prev mnum 0)) + mnum) + (push node + ls)) + (prog1 + (if (not (seek ?\()) + ;; singular + (list ls) + ;; multiple + (cl-loop + while (seek ?\() + append (TREE ls mnum))) + (seek-into ?\)))))) + (with-temp-buffer + (if (not data-p) + (insert-file-contents file-or-data) + (insert file-or-data) + (goto-char (point-min))) + (cl-loop + while (morep) + collect (let* ((mnum (gnugo--mkht :weakness 'key)) + (ends (TREE nil mnum)) + (root (car (last (car ends))))) + (vector (apply 'vector ends) + mnum + root))))))) + +(defun gnugo/sgf-write-file (collection filename) + (let ((aft-newline-appreciated '(:AP :GN :PB :PW :HA :KM :RU :RE)) + (specs (mapcar (lambda (full) + (cons (intern (format ":%s" (car full))) + (cl-cdddr full))) + gnugo/sgf-*r4-properties*)) + p name v spec) + (cl-labels + ((esc (composed fmt arg) + (mapconcat (lambda (c) + (cl-case c + ;; ‘?\[’ is not strictly required + ;; but neither is it forbidden. + ((?\[ ?\] ?\\) (format "\\%c" c)) + (?: (concat (if composed "\\" "") ":")) + (t (string c)))) + (string-to-list (format fmt arg)) + "")) + (>>one (v) (insert "[" (esc nil "%s" v) "]")) + (>>two (v) (insert "[" + (esc t "%s" (car v)) + ":" + (esc t "%s" (cdr v)) + "]")) + (>>nl () (cond ((memq name aft-newline-appreciated) + (insert "\n")) + ((< 60 (current-column)) + (save-excursion + (goto-char p) + (insert "\n"))))) + (>>prop (prop) + (setq p (point) + name (car prop) + v (cdr prop)) + (insert (substring (symbol-name name) 1)) + (cond ((not v)) + ((and (consp v) + (setq spec (cdr (assq name specs))) + (memq (car spec) + '(list elist))) + (>>nl) + (let ((>> (if (consp (cadr spec)) + #'>>two + #'>>one))) + (dolist (little-v v) + (setq p (point)) + (funcall >> little-v) + (>>nl)))) + ((consp v) + (>>two v) (>>nl)) + (t + (>>one v) (>>nl)))) + (>>node (node) + (cl-loop + initially (insert ";") + for prop in node + do (>>prop prop))) + (>>tree (tree) + (unless (zerop (current-column)) + (newline)) + (insert "(") + (dolist (x tree) + (funcall (if (gnugo--nodep x) + #'>>node + #'>>tree) + x)) + (insert ")"))) + (with-temp-buffer + (dolist (tree collection) + ;; write it out + (let ((ht (gnugo--mkht)) + (leaves (append (gnugo--tree-ends tree) nil))) + (cl-flet + ((hang (stack) + (cl-loop + with rh ; rectified history + with bp ; branch point + for node in stack + until (setq bp (gethash node ht)) + do (puthash node + (push node rh) ; good for now: ½τ + ht) + finally return + (if (not bp) + ;; first run: main line + rh + ;; subsequent runs: grafts (value discarded) + (setcdr bp (nconc + ;; Maintain order of ‘leaves’. + (let ((was (cdr bp))) + (if (gnugo--nodep (car was)) + (list was) + was)) + (list rh))))))) + (setq tree (hang (pop leaves))) + (mapc #'hang leaves) + (>>tree tree)))) + (newline) + (write-file filename))))) + +;;; gnugo.el ends here diff --git a/elpa/go-20160430.1739/back-ends/gtp-pipe.el b/elpa/go-20160430.1739/back-ends/gtp-pipe.el deleted file mode 100644 index dfcb055..0000000 --- a/elpa/go-20160430.1739/back-ends/gtp-pipe.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; gtp-pipe.el --- GTP backend through a pipe - -;; Copyright (C) 2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Code: -(require 'go-api) -(require 'gtp) -(require 'comint) - -(defvar *gtp-pipe-board* nil - "Board associated with the current gtp pipe process.") - -(defvar *gtp-pipe-last* nil - "Last move of the current game.") - -(defvar *gtp-pipe-inhibit* nil - "Prevent infinite loops of commands.") - -(defun gtp-pipe-start (command) - "Connect a `gtp-pipe' instance to the process created by COMMAND. -Pass \"netcat -lp 6666\" as COMMAND to listen on a local port, or -pass \"netcat localhost 6666\" to connect to a listening local -port." - (interactive "sgtp-pipe command: ") - (pop-to-buffer (go-connect (make-instance 'gtp-pipe :command command)))) - -(defun gtp-pipe-process-filter (proc string) - (go-re-cond string - ("^\\(black\\|white\\) \\(.*\\)$" - (let ((color (go-re-cond (match-string 1 string) - ("black" :B) - ("white" :W))) - (action (match-string 2 string))) - (go-re-cond action - ("^pass" (let ((*gtp-pipe-inhibit* t)) (go-pass *gtp-pipe-board*))) - ("^resign" (let ((*gtp-pipe-inhibit* t)) (go-resign *gtp-pipe-board*))) - (t (let ((move (gtp-to-pos color action))) - (setf *gtp-pipe-last* move) - (setf (go-move *gtp-pipe-board*) move)))))) - ("^genmove_\\(black\\|white\\)" - (message "gtp-pipe: %s's turn" (match-string 1 string))) - ("^last_move" (go-to-gtp-command *gtp-pipe-last*)) - ("^quit" (let ((*gtp-pipe-inhibit* t)) (go-quit *gtp-pipe-board*))) - ("^undo" (let ((*gtp-pipe-inhibit* t)) (go-undo *gtp-pipe-board*))) - ("^string \\(.*\\)$" (message "gtp-pipe: %S" (match-string 1 string))) - (t (message "gtp-pipe unknown command: %S" string)))) - - -;;; Class and interface -(defclass gtp-pipe (gtp) - ((buffer :initarg :buffer :accessor buffer) - (command :initarg :command :accessor command))) - -(defmethod go-connect ((gtp-pipe gtp-pipe)) - (setf (buffer gtp-pipe) - (let* ((cmd-&-args (split-string (command gtp-pipe) " " 'omit-nulls)) - (buf (apply #'make-comint "gtp-pipe" - (car cmd-&-args) nil (cdr cmd-&-args)))) - (with-current-buffer buf - (comint-mode) - (set (make-local-variable '*gtp-pipe-last*) nil) - (set (make-local-variable '*gtp-pipe-inhibit*) nil) - (set (make-local-variable '*gtp-pipe-board*) - (save-excursion - (make-instance 'board - :buffer (go-board gtp-pipe (make-instance 'sgf))))) - (set-process-filter (get-buffer-process (current-buffer)) - (make-go-insertion-filter - #'gtp-pipe-process-filter))) - buf))) - -(defmethod gtp-command ((gtp-pipe gtp-pipe) command) - (with-current-buffer (buffer gtp-pipe) - (unless *gtp-pipe-inhibit* - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert command) - (comint-send-input)))) - -(defmethod go-comment ((gtp-pipe gtp-pipe)) - (signal 'unsupported-back-end-command (list gtp-pipe :comment))) - -(defmethod set-go-comment ((gtp-pipe gtp-pipe) comment) - (gtp-command gtp-pipe (format "string %s" comment))) - -(defmethod go-color ((gtp-pipe gtp-pipe)) - (with-current-buffer (buffer gtp-pipe) - (go-color *gtp-pipe-board*))) - -(defmethod go-name ((gtp-pipe gtp-pipe)) "GTP pipe") -(defmethod go-size ((gtp-pipe gtp-pipe)) - (read-from-minibuffer "GTP board size: " nil nil 'read)) - -(defmethod go-quit ((gtp-pipe gtp-pipe)) - (gtp-command gtp-pipe "quit") - (with-current-buffer (buffer gtp-pipe) - (signal-process (get-buffer-process) 'KILL))) - -(defmethod go-player-name ((gtp-pipe gtp-pipe) color) "GTP pipe") - -(defmethod set-player-name ((gtp-pipe gtp-pipe) color name) - (signal 'unsupported-back-end-command (list gtp-pipe :set-player-name name))) - -(provide 'gtp-pipe) -;;; gtp-pipe.el ends here diff --git a/elpa/go-20160430.1739/back-ends/gtp.el b/elpa/go-20160430.1739/back-ends/gtp.el deleted file mode 100644 index a4070c5..0000000 --- a/elpa/go-20160430.1739/back-ends/gtp.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; gtp.el --- GTP GO back-end - -;; Copyright (C) 2008 2012 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf gtp gnugo - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;; Commentary: - -;; This file should be useful for translating between sgf and the GO -;; text protocol (GTP) see http://www.lysator.liu.se/~gunnar/gtp/. -;; The GMP command set may be implemented as an extension. -;; -;; see http://www.lysator.liu.se/~gunnar/gtp/gtp2-spec-draft2/gtp2-spec.html -;; -;; The following commands are required by GTP -;; - protocol_version -;; - name -;; - version -;; - known_command -;; - list_commands -;; - quit -;; - boardsize -;; - clear_board -;; - komi -;; - play -;; - genmove - -;; Code: -(require 'go-api) - -(defun gtp-expand-color (turn) - (case turn - (:B "black") - (:W "white") - (t (error "gtp: unknown turn %S" turn)))) - -(defun go-pos-to-gtp (pos) - (format "%c%d" (num-to-char (1+ (car pos))) (1+ (cdr pos)))) - -(defun gtp-to-pos (color gtp) - (cons color (cons :pos (cons (char-to-num (aref gtp 0)) - (1- (read (substring gtp 1))))))) - -(defun go-to-gtp-command (element) - "Convert an go ELEMENT to a gtp command." - (let ((key (car element)) - (val (cdr element))) - (case key - (:B (format "black %s" (go-pos-to-gtp (aget (list val) :pos)))) - (:W (format "white %s" (go-pos-to-gtp (aget (list val) :pos)))) - ((:SZ :S) (format "boardsize %s" val)) - (:KM (format "komi %s" val)) - (t nil)))) - -(defun gtp-territory (gtp color) - (let ((output (ecase color - (:B (gtp-command gtp "final_status_list black_territory")) - (:W (gtp-command gtp "final_status_list white_territory"))))) - (mapcar (lambda (gtp-point) (gtp-to-pos color gtp-point)) - (mapcar #'symbol-name - (read (format "(%s)" output)))))) - - -;;; Class and interface -(defclass gtp nil nil "Class for the GTP GO GO back end.") - -(defgeneric gtp-command (back-end command) - "Send gtp COMMAND to OBJECT and return any output.") - -(defmethod go-size ((gtp gtp)) - (read (gtp-command gtp "query_boardsize"))) - -(defmethod set-go-size ((gtp gtp) size) - (gtp-command gtp (format "boardsize %d" size))) - -(defmethod go-level ((gtp gtp)) - (signal 'unsupported-back-end-command (list gtp :go-level))) - -(defmethod set-go-level ((gtp gtp) level) - (gtp-command gtp (format "level %d" level))) - -(defmethod go-name ((gtp gtp)) - (gtp-command gtp "name")) - -(defmethod set-go-name ((gtp gtp) name) - (signal 'unsupported-back-end-command (list gtp :set-name name))) - -(defmethod go-move ((gtp gtp)) - (let* ((color (go-color gtp)) - (move (case color - (:B (gtp-command gtp "genmove_black")) - (:W (gtp-command gtp "genmove_white"))))) - (if (string= move "PASS") - :pass - (gtp-to-pos color move)))) - -(defmethod set-go-move ((gtp gtp) move) - (gtp-command gtp (go-to-gtp-command move))) - -(defmethod go-labels ((gtp gtp)) - (signal 'unsupported-back-end-command (list gtp :labels))) - -(defmethod set-go-labels ((gtp gtp) labels) - (signal 'unsupported-back-end-command (list gtp :set-labels labels))) - -(defmethod go-comment ((gtp gtp)) - (signal 'unsupported-back-end-command (list gtp :comment))) - -(defmethod set-go-comment ((gtp gtp) comment) - (signal 'unsupported-back-end-command (list gtp :set-comment comment))) - -(defmethod go-alt ((gtp gtp)) - (signal 'unsupported-back-end-command (list gtp :alt))) - -(defmethod set-go-alt ((gtp gtp) alt) - (signal 'unsupported-back-end-command (list gtp :set-alt alt))) - -(defmethod go-color ((gtp gtp)) - (case (condition-case err - (intern (car (split-string (gtp-command gtp "last_move")))) - (error 'white)) ('white :B) ('black :W))) - -(defmethod set-go-color ((gtp gtp) color) - (signal 'unsupported-back-end-command (list gtp :set-color color))) - -;; non setf'able generic functions -(defmethod go-undo ((gtp gtp)) (gtp-command gtp "undo")) - -(defmethod go-pass ((gtp gtp)) - (gtp-command gtp (format "%s pass" (gtp-expand-color (go-color gtp))))) - -(defmethod go-resign ((gtp gtp)) - (gtp-command gtp (format "%s resign" (gtp-expand-color (go-color gtp))))) - -(defmethod go-reset ((gtp gtp)) (gtp-command gtp "clear_board")) - -(defmethod go-quit ((gtp gtp)) (gtp-command gtp "quit")) - -(defmethod go-score ((gtp gtp)) (gtp-command gtp "final_score")) - -(defmethod go-territory ((gtp gtp)) - (append (gtp-territory gtp :B) (gtp-territory gtp :W))) - -(defmethod go-dead ((gtp gtp)) - (signal 'unsupported-back-end-command (list gtp :dead))) - -(provide 'gtp) -;;; gtp.el ends here diff --git a/elpa/go-20160430.1739/back-ends/igs.el b/elpa/go-20160430.1739/back-ends/igs.el deleted file mode 100644 index 9230214..0000000 --- a/elpa/go-20160430.1739/back-ends/igs.el +++ /dev/null @@ -1,501 +0,0 @@ -;;; igs.el --- IGS GO back-end - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf igs - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;; Commentary: - -;; http://www.pandanet.co.jp/English/commands/term/Summary.html - -;; Code: -(require 'go-api) -(require 'list-buffer) - -(defvar igs-ignore-shouts t - "Ignore shouts on the IGS server.") - -(defvar igs-telnet-command "telnet" - "Telnet command used by igs.") - -(defvar igs-server "igs.joyjoy.net" - "Address of the IGS server.") - -(defvar igs-port 6969 - "Port to use when connecting to an IGS server.") - -(defvar igs-username "guest" - "User name to use when connecting to an IGS server.") - -(defvar igs-process-name "igs" - "Name for the igs process.") - -(defvar igs-server-ping-delay 300 - "Minimum time between pings to remind the IGS server we're still listening.") - -(defvar igs-message-types - '((:unknown . 0) - (:automat . 35) ;; Automatch announcement - (:autoask . 36) ;; Automatch accept - (:choices . 38) ;; game choices - (:clivrfy . 41) ;; Client verify message - (:beep . 2) ;; \7 telnet - (:board . 3) ;; Board being drawn - (:down . 4) ;; The server is going down - (:error . 5) ;; An error reported - (:fil . 6) ;; File being sent - (:games . 7) ;; Games listing - (:help . 8) ;; Help file - (:info . 9) ;; Generic info - (:last . 10) ;; Last command - (:kibitz . 11) ;; Kibitz strings - (:load . 12) ;; Loading a game - (:look_m . 13) ;; Look - (:message . 14) ;; Message listing - (:move . 15) ;; Move #:(B) A1 - (:observe . 16) ;; Observe report - (:prompt . 1) ;; A Prompt (never) - (:refresh . 17) ;; Refresh of a board - (:saved . 18) ;; Stored command - (:say . 19) ;; Say string - (:score_m . 20) ;; Score report - (:sgf_m . 34) ;; SGF variation - (:shout . 21) ;; Shout string - (:show . 29) ;; Shout string - (:status . 22) ;; Current Game status - (:stored . 23) ;; Stored games - (:teach . 33) ;; teaching game - (:tell . 24) ;; Tell string - (:dot . 40) ;; your . string - (:thist . 25) ;; Thist report - (:tim . 26) ;; times command - (:trans . 30) ;; Translation info - (:ttt_board . 37) ;; tic tac toe - (:who . 27) ;; who command - (:undo . 28) ;; Undo report - (:user . 42) ;; Long user report - (:version . 39) ;; IGS Version - (:yell . 32))) ;; Channel yelling - -(defvar *igs-instance* nil - "IGS instance associated with the current buffer.") - -(defvar *igs-time-last-sent* nil - "Time stamp of the last command sent. -This is used to re-send messages to keep the IGS server from timing out.") - -(defvar *igs-last-command* nil - "Last command sent to the IGS process.") - -(defvar *igs-games* nil - "List holding the current games on the IGS server.") - -(defvar *igs-current-game* nil - "Number of the current IGS game (may change frequently).") - - -;;; Class and interface -(defclass igs () - ((buffer :initarg :buffer :accessor buffer :initform nil) - ;; number of an observed IGS game - (number :initarg :number :accessor number :initform nil) - (active :initarg :active :accessor active :initform t))) - -(defmethod go-connect ((igs igs)) (igs-connect igs)) - -(defmacro with-igs (igs &rest body) - (declare (indent 1)) - `(with-current-buffer (buffer ,igs) ,@body)) - -(defmethod go-level ((igs igs)) - (signal 'unsupported-back-end-command (list igs :level))) - -(defmethod set-go-level ((igs igs) level) - (signal 'unsupported-back-end-command (list igs :set-level level))) - -(defmethod go-size ((igs igs)) - (with-igs igs (aget (igs-current-game) :size))) - -(defmethod set-go-size ((igs igs) size) - (signal 'unsupported-back-end-command (list igs :set-size size))) - -(defmethod go-name ((igs igs)) - (with-igs igs (let ((game (igs-current-game))) - (format "%s(%s) vs %s(%s)" - (aget game :white-name) - (aget game :white-rank) - (aget game :black-name) - (aget game :black-rank))))) - -(defmethod set-go-name ((igs igs) name) - (signal 'unsupported-back-end-command (list igs :set-name name))) - -(defmethod go-move ((igs igs)) - (signal 'unsupported-back-end-command (list igs :move))) - -(defmethod set-go-move ((igs igs) move) - (signal 'unsupported-back-end-command (list igs :set-move move))) - -(defmethod go-labels ((igs igs)) - (signal 'unsupported-back-end-command (list igs :labels))) - -(defmethod set-go-labels ((igs igs) labels) - (signal 'unsupported-back-end-command (list igs :set-labels labels))) - -(defmethod go-comment ((igs igs)) - (signal 'unsupported-back-end-command (list igs :comment))) - -(defmethod set-go-comment ((igs igs) comment) - (signal 'unsupported-back-end-command (list igs :set-comment comment))) - -(defmethod go-alt ((igs igs)) - (signal 'unsupported-back-end-command (list igs :alt))) - -(defmethod set-go-alt ((igs igs) alt) - (signal 'unsupported-back-end-command (list igs :set-alt alt))) - -(defmethod go-color ((igs igs)) - (signal 'unsupported-back-end-command (list igs :color))) - -(defmethod set-go-color ((igs igs) color) - (signal 'unsupported-back-end-command (list igs :set-color color))) - -(defmethod go-player-name ((igs igs) color) - (with-igs igs (aget (igs-current-game) - (case color - (:W :white-name) - (:B :black-name))))) - -(defmethod set-go-player-name ((igs igs) color name) - (signal 'unsupported-back-end-command (list igs :set-player-name color name))) - -(defmethod go-player-time ((igs igs) color) - (signal 'unsupported-back-end-command (list igs :player-time color))) - -(defmethod set-go-player-time ((igs igs) color time) - (signal 'unsupported-back-end-command (list igs :set-player-time color time))) - -;; non setf'able generic functions -(defmethod go-undo ((igs igs)) - (signal 'unsupported-back-end-command (list igs :undo))) - -(defmethod go-pass ((igs igs)) - (signal 'unsupported-back-end-command (list igs :pass))) - -(defmethod go-resign ((igs igs)) - (signal 'unsupported-back-end-command (list igs :resign))) - -(defmethod go-reset ((igs igs)) - (signal 'unsupported-back-end-command (list igs :reset))) - -(defmethod go-quit ((igs igs)) - (with-igs igs - (if (number igs) - (progn - ;; TOOD: ensure still on our server-side observation list - ;; (e.g., hasn't been removed after a resignation) - (when (active igs) - (igs-send (format "observe %d" (number igs)))) - (setf (number igs) nil)) - (igs-send "quit")))) - -(defmethod go-score ((igs igs)) - (signal 'unsupported-back-end-command (list igs :score))) - -(defmethod go-territory ((igs igs)) - (signal 'unsupported-back-end-command (list igs :territory))) - -(defmethod go-dead ((igs igs)) - (signal 'unsupported-back-end-command (list igs :dead))) - -(defmacro igs-w-proc (proc &rest body) - (declare (indent 1)) - `(with-current-buffer (process-buffer proc) ,@body)) -(def-edebug-spec igs-w-proc (form body)) - -(defun igs-send (command) - "Send string COMMAND to the IGS process in the current buffer." - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert command) - (setq *igs-time-last-sent* (current-time)) - (setq *igs-last-command* (and (string-match "^\\([^ ]*\\)" command) - (match-string 1 command))) - (comint-send-input)) - -(defun igs-process-filter (proc string) - (when (string-match "^\\([[:digit:]]+\\) \\(.+\\)$" string) - (let* ((number (read (match-string 1 string))) - (type (car (rassoc number igs-message-types))) - (content (match-string 2 string))) - (case type - (:prompt - (go-re-cond (or *igs-last-command* "") - ("^games" (igs-list-games *igs-instance* *igs-games*)) - (t nil)) - (setq *igs-last-command* nil)) - (:info - (go-re-cond content - ;; Game NN: name1 vs name2 has adjourned. - ("^Game \\([0-9]*\\): .*adjourned.$" - (igs-handle-adjournment (match-string 1 content))) - ;; {Game NN: name1 vs name2 : color resigns.} - ("^{Game \\([0-9]*\\): \\(Black\\|White\\) resigns.}$" - (igs-handle-resignation (go-re-cond (match-string 2 content) - ("black" :black) - ("white" :white)))) - (t (unless (string= content "yes") - (message "igs-info: %s" content))))) - (:games (igs-w-proc proc (igs-handle-game content))) - (:move (igs-w-proc proc (igs-handle-move content))) - (:kibitz (message "igs-kibitz: %s" content)) - (:tell (igs-handle-tell content)) - (:beep nil) - (:shout (unless igs-ignore-shouts (igs-handle-shout content))) - (t (message "igs-unknown: [%s]%s" type content))) - (when (and *igs-time-last-sent* - (> (time-to-seconds (time-since *igs-time-last-sent*)) - igs-server-ping-delay)) - (igs-send "ayt"))))) - -(defun igs-connect (igs) - "Open a connection to `igs-server'." - (cl-flet ((wait (prompt) - (message "IGS waiting for %S..." prompt) - (while (and (goto-char (or comint-last-input-end (point-min))) - (not (re-search-forward prompt nil t))) - (accept-process-output proc)))) - (let ((buffer (apply 'make-comint - igs-process-name - igs-telnet-command nil - (list igs-server (number-to-string igs-port))))) - (setf (buffer igs) buffer) - (with-current-buffer buffer - (comint-mode) - (set (make-local-variable '*igs-instance*) igs) - (set (make-local-variable '*igs-last-command*) "") - (set (make-local-variable '*igs-games*) nil) - (set (make-local-variable '*igs-current-game*) nil) - (set (make-local-variable '*go-partial-line*) nil) - (set (make-local-variable '*igs-time-last-sent*) (current-time)) - (let ((proc (get-buffer-process (current-buffer)))) - (wait "^Login:") - (goto-char (process-mark proc)) - (igs-send igs-username) - (wait "^\#> ") - (igs-toggle "client" t) - (set-process-filter - proc (make-go-insertion-filter #'igs-process-filter)))) - buffer))) - -(defun igs-toggle (setting value) - (igs-send (format "toggle %s %s" setting (if value "true" "false")))) - -(defun igs-observe (game) (igs-send (format "observe %s" game))) - -(defun igs-list-games (instance games) - (lexical-let ((instance instance)) - (list-buffer-create - "*igs-game-list*" - (cl-mapcar #'cons - (mapcar #'car games) - (mapcar (curry #'mapcar #'cdr) (mapcar #'cdr games))) - '("#" "white" "rk" "black" "rk" "move" "size" "H" "Komi" "by" "fr" "#") - (lambda (row col) - (let ((id (car (nth row *buffer-list*)))) - (with-igs instance (igs-observe id)))) - (lambda (row col) - (message "refreshing games list...") - (igs-get-games instance))))) - - -;;; Specific handlers -(defvar igs-player-name-re - "[[:alpha:][:digit:]]+" - "Regular expression used to match igs player name.") - -(defvar igs-player-rating-re - "[[:digit:]]+[kd]\\*?" - "Regular expression used to match igs player rating.") - -(defvar igs-player-game-info-re "([-[:digit:]]+ [-[:digit:]]+ [-[:digit:]]+)" - "Regular expression used to match igs player game info.") - -(defvar igs-player-re - (format "\\(%s\\) +\\[ *\\(%s\\)\\]" igs-player-name-re igs-player-rating-re) - "Regular expression used to parse igs player name and rating.") - -(defvar igs-game-re - (format - "\\[\\([[:digit:]]+\\)\\] +%s +vs. +%s +\\((.+)\\) \\((.+)\\)[[:space:]]*$" - igs-player-re igs-player-re) - "Regular expression used to parse igs game listings.") - -(defvar igs-move-piece-re - "[[:digit:]]+(\\([WB]\\)): \\([[:alpha:]][[:digit:]]+\\)" - "Regular expression used to match an IGS move.") - -(defvar igs-move-time-re "TIME") - -(defvar igs-move-props-re "GAMEPROPS") - -(defvar igs-move-game-re - (format "Game \\([[:digit:]]+\\) I: \\(%s\\) \\(%s\\) vs \\(%s\\) \\(%s\\)" - igs-player-name-re igs-player-game-info-re - igs-player-name-re igs-player-game-info-re) - "Regular expression used to match Game updates.") - -(defun igs-handle-game (game-string) - ;; [##] white name [ rk ] black name [ rk ] (Move size H Komi BY FR) (###) - (when (string-match igs-game-re game-string) - (let* ((num (match-string 1 game-string)) - (white-name (match-string 2 game-string)) - (white-rank (match-string 3 game-string)) - (black-name (match-string 4 game-string)) - (black-rank (match-string 5 game-string)) - (other1 (read (match-string 6 game-string))) - (other2 (read (match-string 7 game-string)))) - (push `(,(read num) - (:white-name . ,white-name) - (:white-rank . ,white-rank) - (:black-name . ,black-name) - (:black-rank . ,black-rank) - (:move . ,(nth 0 other1)) - (:size . ,(nth 1 other1)) - (:h . ,(nth 2 other1)) - (:komi . ,(nth 3 other1)) - (:by . ,(nth 4 other1)) - (:fr . ,(nth 5 other1)) - (:other . ,(car other2))) - *igs-games*) - ;; update the game list buffer - (when (get-buffer "*igs-game-list*") - (save-excursion - (set-buffer (get-buffer "*igs-game-list*")) - (list-buffer-refresh)))))) - -(defun igs-handle-adjournment (number-string) - (if (aget (igs-current-game) :board) - (with-current-buffer (buffer (aget (igs-current-game) :board)) - (with-backends backend - (when (equal (class-of backend) 'igs) - (setf (active backend) nil)))) - (error "igs-handle-adjournment: no board!"))) - -(defun igs-handle-resignation (color) - (if (aget (igs-current-game) :board) - (progn - (go-resign (aget (igs-current-game) :board)) - (with-current-buffer (buffer (aget (igs-current-game) :board)) - (with-backends backend - (when (equal (class-of backend) 'igs) - (setf (active backend) nil))))) - (error "igs-handle-adjournment: no board!"))) - -(defun igs-to-pos (color igs) - (cons (make-keyword color) - (cons :pos - (cons (char-to-num (aref igs 0)) - (1- (read (substring igs 1))))))) - -(defun igs-current-game () - (aget *igs-games* *igs-current-game*)) - -(defun set-igs-current-game (new) - (setf (aget *igs-games* *igs-current-game*) new)) - -(defsetf igs-current-game set-igs-current-game) - -(defun igs-handle-tell (string) - (unless (string-match (format "\\*\\(%s\\)\\*: \\(.*\\)$" igs-player-name-re) - string) - (error "igs: malformed tell string %S" string)) - ;; TODO: keep a message buffer for each user in which conversations - ;; may be saved... during games store messages as SGF comments. - (message "igs[%s]: %s" (match-string 1 string) (match-string 2 string))) - -(defun igs-handle-shout (string) - (unless (string-match "^\\([^:]*\\): \\(.*\\)$" string) - (error "igs: malformed shout string %S" string)) - (message "IGS[%s]: %s" (match-string 1 string) (match-string 2 string))) - -(defun igs-apply-move (move) - (if (aget (igs-current-game) :board) - (setf (go-move (aget (igs-current-game) :board)) move) - (message "igs-apply-move: no board!"))) - -(defun igs-register-game (number) - (setq *igs-current-game* number) - (unless (aget (igs-current-game) :board) - (setf (aget (igs-current-game) :board) - (save-excursion - (setf (number *igs-instance*) number) - (make-instance 'board - :buffer (go-board *igs-instance* - (make-instance 'sgf))))) - (when (aget (igs-current-game) :board) - (igs-send (format "moves %s" number))))) - -(defun igs-update-game-info (info) - (let ((color (car info)) - (name (cadr info)) - (other (cddr info))) - ;; (message "[%s] %s: %s" color name other) - )) - -(defun igs-handle-move (move-string) - (go-re-cond move-string - (igs-move-piece-re (igs-apply-move - (igs-to-pos (match-string 1 move-string) - (match-string 2 move-string)))) - (igs-move-time-re nil) - (igs-move-props-re nil) - (igs-move-game-re - (let ((number (read (match-string 1 move-string))) - (white-info (cons (match-string 2 move-string) - (read (match-string 3 move-string)))) - (black-info (cons (match-string 4 move-string) - (read (match-string 5 move-string))))) - (igs-register-game number) - (igs-update-game-info (cons :W white-info)) - (igs-update-game-info (cons :B black-info)))))) - - -;;; Interface -;; -;; If we find another backend providing game lists and observations -;; then this could be generalized to an interface. -(defun igs-start (&optional name) - "Connect to an IGS server and return the `igs' instance." - (interactive) - (set-buffer (get-buffer-create (or name "*igs*"))) - (if (get-buffer-process (current-buffer)) - *igs-instance* - (let ((*igs* (make-instance 'igs))) - (igs-connect *igs*) - *igs*))) - -(defun igs-get-games (&optional instance) - "List the games of the igs instance." - (interactive) - (set-buffer (buffer (or instance (igs-start)))) - (setf *igs-games* nil) - (igs-send "games")) - -(provide 'igs) -;;; igs.el ends here diff --git a/elpa/go-20160430.1739/back-ends/sgf.el b/elpa/go-20160430.1739/back-ends/sgf.el deleted file mode 100644 index 97de806..0000000 --- a/elpa/go-20160430.1739/back-ends/sgf.el +++ /dev/null @@ -1,196 +0,0 @@ -;;; sgf.el --- SGF GO back end - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;; Commentary: - -;; This file implements an `go-trans' interface into an SGF file. - -;; Code: -(require 'go-api) - -(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) - (setq part (nth (car index) part)) - (setq index (cdr index))) - part)) - -(defun set-sgf-ref (sgf index new) - (eval `(setf ,(reduce (lambda (acc el) (list 'nth el acc)) - index :initial-value 'sgf) - ',new))) - -(defsetf sgf-ref set-sgf-ref) - - -;;; Class -(defclass sgf nil - ((self :initarg :self :accessor self :initform nil) - (index :initarg :index :accessor index :initform (list 0))) - "Class for the SGF back end.") - -(defun sgf-from-file (file) - (interactive "f") - (make-instance 'sgf :self (sgf2el-file-to-el file))) - -(defun sgf-to-file (sgf file) - (interactive "F") - (when (and (file-exists-p file) - (not (y-or-n-p (format "overwrite %s? " file)))) - (error "aborted")) - (with-temp-file file - (delete-region (point-min) (point-max)) - (insert (pp (self sgf))))) - -(defmethod current ((sgf sgf)) - (sgf-ref (self sgf) (index sgf))) - -(defun set-current (sgf new) - (setf (sgf-ref (self sgf) (index sgf)) new)) - -(defsetf current set-current) - -(defmethod root ((sgf sgf)) - (sgf-ref (self sgf) '(0))) - -(defun set-root (sgf new) - (if (self sgf) - (setf (car (self sgf)) new) - (setf (self sgf) (list new)))) - -(defsetf root set-root) - -(defmethod next ((sgf sgf)) - (incf (car (last (index sgf))))) - -(defmethod prev ((sgf sgf)) - (decf (car (last (index sgf))))) - - -;;; interface -(defmethod go-size ((sgf sgf)) - (or (aget (root sgf) :S) - (aget (root sgf) :SZ))) - -(defmethod set-go-size ((sgf sgf) size) - (cond - ((aget (root sgf) :S) (setf (cdr (assoc :S (root sgf))) size)) - ((aget (root sgf) :SZ) (setf (cdr (assoc :SZ (root sgf))) size)) - (t (push (cons :S size) (root sgf))))) - -(defmethod go-level ((sgf sgf)) - (signal 'unsupported-back-end-command (list sgf :go-level))) - -(defmethod set-go-level ((sgf sgf) level) - (signal 'unsupported-back-end-command (list sgf :set-go-level level))) - -(defmethod go-name ((sgf sgf)) - (or (aget (root sgf) :GN) - (aget (root sgf) :EV))) - -(defmethod set-go-name ((sgf sgf) name) - (cond - ((aget (root sgf) :GN) (setf (cdr (assoc :GN (root sgf))) name)) - ((aget (root sgf) :EV) (setf (cdr (assoc :EV (root sgf))) name)) - (t (push (cons :GN name) (root sgf))))) - -(defmethod go-move ((sgf sgf)) - (next sgf) - (let ((turn (current sgf))) - (if turn - (or (assoc :B turn) (assoc :W turn)) - (prev sgf) - (error "sgf: no more moves")))) - -;; TODO: currently this only works with linear sgf files w/o alternatives -(defmethod set-go-move ((sgf sgf) move) - (next sgf) - (if (current sgf) - (setf (current sgf) (list move)) - (setf (self sgf) (rcons (list move) (self sgf))))) - -(defmethod go-labels ((sgf sgf)) - (let ((turn (current sgf))) - (if turn - (remove-if-not (lambda (pair) (member (car pair) '(:LB :LW))) turn) - (prev sgf) - (error "sgf: no more moves")))) - -(defmethod set-go-lables ((sgf sgf) labels) - (if (current sgf) - (setf (current sgf) (cons (or (assoc :B (current sgf)) - (assoc :W (current sgf))) - labels)) - (rpush labels (sgf-ref (self sgf) (butlast (index sgf)))))) - -(defmethod go-comment ((sgf sgf)) - (aget (current sgf) :C)) - -(defmethod set-go-comment ((sgf sgf) comment) - (if (aget (current sgf) :C) - (setf (cdr (assoc :C (current sgf))) comment) - (push (cons :C comment) (current sgf)))) - -(defmethod go-alt ((sgf sgf)) - (error "sgf: go-alt not yet supported")) - -(defmethod set-go-alt ((sgf sgf) alt) - (error "sgf: set-go-alt not yet supported")) - -(defmethod go-color ((sgf sgf)) - (signal 'unsupported-back-end-command (list sgf :move))) - -(defmethod set-go-color ((sgf sgf) color) - (signal 'unsupported-back-end-command (list sgf :set-color color))) - -;; non setf'able generic functions -(defmethod go-undo ((sgf sgf)) (prev sgf)) - -(defmethod go-pass ((sgf sgf)) - (signal 'unsupported-back-end-command (list sgf :pass))) - -(defmethod go-resign ((sgf sgf)) - (signal 'unsupported-back-end-command (list sgf :resign))) - -(defmethod go-quit ((sgf sgf)) - (when (y-or-n-p "Save game to file: ") - (sgf-to-file sgf (read-file-name "Save game to: ")))) - -(defmethod go-score ((sgf sgf)) - (signal 'unsupported-back-end-command (list sgf :score))) - -(defmethod go-territory ((sgf sgf)) - (signal 'unsupported-back-end-command (list sgf :territory))) - -(defmethod go-dead ((sgf sgf)) - (signal 'unsupported-back-end-command (list sgf :dead))) - -(provide 'sgf) -;;; sgf.el ends here diff --git a/elpa/go-20160430.1739/back-ends/sgf2el.el b/elpa/go-20160430.1739/back-ends/sgf2el.el deleted file mode 100644 index e8f9038..0000000 --- a/elpa/go-20160430.1739/back-ends/sgf2el.el +++ /dev/null @@ -1,188 +0,0 @@ -;;; sgf2el.el --- conversion between sgf and emacs-lisp - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Code: -(require 'go-util) - -(defvar prop-re - "\\([[:alpha:]]+\\)\\(\\(\\[\\]\\|[[:space:]]*\\[[^\000]*?[^\\]\\]\\)+\\)") - -(defvar prop-val-re - "\\(\\[\\]\\|\\[\\([^\000]*?[^\\]\\)\\]\\)") - -(defvar sgf2el-special-properties nil - "A-list of properties and functions to specially convert their values.") - -(defun make-keyword (string) - (intern (concat ":" (upcase string)))) - -(defun sgf2el-convert-prop-key (key) - "Convert a keyerty name to elisp." - (save-match-data (make-keyword key))) - -(defun sgf2el-read-prop (val) - (when (and (stringp val) (not (equal val ""))) - (or (go-number-p val) val))) - -(defun sgf2el-convert-prop-vals (key vals) - "Convert a property value to elisp." - (save-match-data - (let ((func (cdr (assoc key sgf2el-special-properties)))) - (if func - (funcall func vals) - (delete nil (mapcar #'sgf2el-read-prop vals)))))) - -(defun sgf2el-all-matches (str re &optional sub-exp) - (save-match-data - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (loop while (re-search-forward re nil t) - collect (go-clean-text-properties - (match-string (or sub-exp 0))))))) - -(defun sgf2el-region (&optional start end) - (interactive "r") - (let ((start (copy-marker (or start (point-min)))) - (end (copy-marker (or end (point-max)))) - (re (format "\\(%s\\|%s\\)" prop-re "\\(([[:space:]]*\\)*\\(;\\)")) - last-node) - (save-excursion (goto-char start) - (while (re-search-forward re end t) - (let ((start (marker-position start))) - (message "parsing %.2f%%" - (* 100 (/ (float (- (point) start)) - (float (- (marker-position end) start)))))) - (if (string= (match-string 6) ";") - (progn - (replace-match "(" nil nil nil 6) - (when last-node - (save-excursion (goto-char (match-beginning 0)) (insert ")"))) - (setq last-node t)) - (let* ((key (sgf2el-convert-prop-key (match-string 2))) - (val (sgf2el-convert-prop-vals key - (sgf2el-all-matches (match-string 3) prop-val-re 2))) - (rep (format "%S " (cons key (if (= 1 (length val)) - (car val) val))))) - (replace-match rep nil 'literal)))) - (when last-node (insert ")"))) - (message "parsing DONE"))) - -(defun sgf2el-normalize (&optional buffer) - "Cleanup the formatting of the elisp sgf data in BUFFER." - (interactive) - (let ((buffer (or buffer (current-buffer))) temp) - (sgf2el-set-to-var temp buffer) - (with-current-buffer buffer - (save-excursion - (delete-region (point-min) (point-max)) - (insert (pp temp)))) - temp)) - -(defun sgf2el (&optional sgf-buffer) - "Convert the content of SGF-BUFFER to emacs-lisp in a new buffer." - (interactive) - (let* ((sgf-buffer (or sgf-buffer (current-buffer))) - (buffer (generate-new-buffer (concat (buffer-name sgf-buffer) "-el"))) - (sgf-str (with-current-buffer sgf-buffer (buffer-string)))) - (with-current-buffer buffer - (insert sgf-str) - (goto-char (point-min)) - (sgf2el-region) - (emacs-lisp-mode)) - (pop-to-buffer 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." - (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-buffer-to-el))) - - -;;; Specific property converters -(defun process-date (date-args) - (save-match-data (parse-time-string - (if (> 1 (length date-args)) - (mapconcat #'number-to-string date-args " ") - (car date-args))))) -(add-to-list 'sgf2el-special-properties (cons :DT #'process-date)) - -(defun process-position (position-string) - (cl-flet ((char-to-num (char) - (cond - ((or (< char ?A) (< ?z char)) - (error "sgf: invalid char %s" char)) - ((< char ?a) (+ 26 (- char ?A))) - (t (- char ?a))))) - (cons (char-to-num (aref position-string 0)) - (char-to-num (aref position-string 1))))) - -(defun process-move (move-args) - (list (cons :pos (process-position (car move-args))))) -(add-to-list 'sgf2el-special-properties (cons :B #'process-move)) -(add-to-list 'sgf2el-special-properties (cons :W #'process-move)) - -(defun process-label (label-args) - (let ((res (mapcar (lambda (l-arg) - (if (string-match "\\([[:alpha:]]+\\):\\(.*\\)" l-arg) - (list - (cons :label (match-string 2 l-arg)) - (cons :pos (process-position - (match-string 1 l-arg)))) - (error "sgf: malformed label %S" l-arg))) - label-args))) - (if (= 1 (length label-args)) (list res) res))) -(add-to-list 'sgf2el-special-properties (cons :LB #'process-label)) -(add-to-list 'sgf2el-special-properties (cons :LW #'process-label)) - -(defun process-comment (comments) - (let ((replacements '(("\\(" . "(") - ("\\)" . ")") - ("\\[" . "[") - ("\\]" . "]")))) - (mapcar (lambda (comment) - (dolist (pair replacements comment) - (setq comment (replace-regexp-in-string - (regexp-quote (car pair)) (cdr pair) comment)))) - comments))) -(add-to-list 'sgf2el-special-properties (cons :C #'process-comment)) - -(provide 'sgf2el) -;;; sgf2el.el ends here diff --git a/elpa/go-20160430.1739/go-api.el b/elpa/go-20160430.1739/go-api.el deleted file mode 100644 index 130b91d..0000000 --- a/elpa/go-20160430.1739/go-api.el +++ /dev/null @@ -1,78 +0,0 @@ -;;; go-api.el --- a uniform API for communication between GO back-ends - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; A board-based interface to GO games which may be connected to a -;; number of GO back-ends through a generic API. To play a game of GO -;; against the gnugo back-end run `play-go'. Current back-ends -;; include the following. -;; - the SGF format -;; - the Go Text Protocol (GTP) -;; - TODO: the IGS protocol - -;;; Code: -(require 'go-util) -(require 'eieio) - -(put 'unsupported-back-end-command - 'error-conditions - '(error unsupported-back-end-command)) - -(defmacro ignoring-unsupported (&rest body) - `(condition-case err ,@body - (unsupported-back-end-command nil))) - -(defmacro defgeneric-w-setf (name doc) - (let ((set-name (intern (concat "set-" (symbol-name name))))) - `(progn - (defgeneric ,name (back-end) ,doc) - (defgeneric ,set-name (back-end new)) - (defsetf ,name ,set-name)))) - -;; setf'able back-end access -(defgeneric-w-setf go-size "Access BACK-END size.") -(defgeneric-w-setf go-level "Access level of BACK-END.") -(defgeneric-w-setf go-name "Access BACK-END name.") -(defgeneric-w-setf go-move "Access current BACK-END move.") -(defgeneric-w-setf go-labels "Access current BACK-END labels.") -(defgeneric-w-setf go-comment "Access current BACK-END comment.") -(defgeneric-w-setf go-alt "Access current BACK-END alternative move.") -(defgeneric-w-setf go-color "Access current BACK-END turn color.") -(defgeneric-w-setf go-player-name "Access current BACK-END player name.") -(defgeneric-w-setf go-player-time "Access current BACK-END player time.") -(defgeneric-w-setf - go-player-prisoners "Access current BACK-END player prisoners.") - -;; sending messages to the back-end -(defgeneric go-connect (back-end) "Connect to BACK-END.") -(defgeneric go-undo (back-end) "Send undo to BACK-END.") -(defgeneric go-pass (back-end) "Send pass to BACK-END.") -(defgeneric go-resign (back-end) "Send resign to BACK-END.") -(defgeneric go-reset (back-end) "Send reset to BACK-END.") -(defgeneric go-quit (back-end) "Quit the BACK-END.") -(defgeneric go-score (back-end) "Ask BACK-END to report the score.") -(defgeneric go-territory (back-end) "Ask BACK-END to report the territory.") -(defgeneric go-dead (back-end) "Ask BACK-END to dead stones.") - -(provide 'go-api) -;;; go-api.el ends here diff --git a/elpa/go-20160430.1739/go-autoloads.el b/elpa/go-20160430.1739/go-autoloads.el deleted file mode 100644 index bdf31e9..0000000 --- a/elpa/go-20160430.1739/go-autoloads.el +++ /dev/null @@ -1,32 +0,0 @@ -;;; go-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil "go" "go.el" (22490 32825 89857 211000)) -;;; Generated autoloads from go.el - -(autoload 'go-play "go" "\ -Play a game of GO. - -\(fn)" t nil) - -(autoload 'go-view-sgf "go" "\ -View an SGF file. - -\(fn &optional FILE)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("go-api.el" "go-board-faces.el" "go-board.el" -;;;;;; "go-pkg.el" "go-util.el" "list-buffer.el") (22490 32825 112091 -;;;;;; 153000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; go-autoloads.el ends here diff --git a/elpa/go-20160430.1739/go-board-faces.el b/elpa/go-20160430.1739/go-board-faces.el deleted file mode 100644 index 6eb390f..0000000 --- a/elpa/go-20160430.1739/go-board-faces.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; go-board-faces.el -- Color for GO boards - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Code: -(defface go-board-background - '((t (:background "#b36108" :foreground "#6f3c04"))) - "woodsy background") - -(defface go-board-hoshi - '((t (:background "#b36108" :foreground "#6d3300"))) - "woodsy background with darker hoshi mark") - -(defface go-board-black - '((t (:background "#b36108" :foreground "black"))) - "black piece on woodsy background") - -(defface go-board-white - '((t (:background "#b36108" :foreground "white"))) - "white piece on woodsy background") - -(defface go-board-black-territory-background - '((t (:background "#6a4014" :foreground "#6f3c04"))) - "woodsy background") - -(defface go-board-black-territory-hoshi - '((t (:background "#6a4014" :foreground "#6d3300"))) - "woodsy background with darker hoshi mark") - -(defface go-board-black-territory-black - '((t (:background "#6a4014" :foreground "black"))) - "black piece on black territory") - -(defface go-board-black-territory-white - '((t (:background "#6a4014" :foreground "#6b6b6b"))) - "white piece on black territory") - -(defface go-board-white-territory-background - '((t (:background "#cd9c67" :foreground "#6f3c04"))) - "white territory") - -(defface go-board-white-territory-hoshi - '((t (:background "#cd9c67" :foreground "#6d3300"))) - "white territory with darker hoshi mark") - -(defface go-board-white-territory-black - '((t (:background "#cd9c67" :foreground "#6b6b6b"))) - "black piece on white territory") - -(defface go-board-white-territory-white - '((t (:background "#cd9c67" :foreground "white"))) - "white piece on white territory") - -;; Maybe use `face-remap-add-relative' to change image sizes. - - -;;; Image utility functions -(defun go-board-svg-trans (list) - (if (and (listp list) (listp (car list))) - (concat (format "<%s%s" (caar list) (if (cdar list) " " "")) - (mapconcat (lambda (pair) (format "%s=\"%s\"" (car pair) (cdr pair))) - (cdar list) " ") - (if (cdr list) - (concat ">" - (mapconcat #'go-board-svg-trans (cdr list) " ") - (format "" (caar list))) - "/>")) - list)) - -(defun go-board-cross (color) - (mapconcat #'go-board-svg-trans - `(((line (x1 . 3.125) (y1 . 3.125) (x2 . 21.875) (y2 . 21.875) - (style . ,(format "stroke: %s;" color)))) - ((line (x1 . 3.125) (y1 . 21.875) (x2 . 21.875) (y2 . 3.125) - (style . ,(format "stroke: %s;" color))))) - "")) - -(defun go-board-label (color label) - (go-board-svg-trans - `((text (x . 8.75) (y . 16.25) (r . 12.25) - (style . ,(format "font-size:12.5;fill:%s;" color))) - ,label))) - -(defun go-board-mark (overlay mark) - "Write MARK over top of the SVG image in OVERLAY." - (let* ((disp (cdr (copy-tree (overlay-get overlay 'display)))) - (data (plist-get disp :data))) - (when (and data (string-match (regexp-quote "") data)) - (plist-put disp :data (concat (substring data 0 (match-beginning 0)) - mark - (substring data (match-beginning 0)))) - (overlay-put overlay 'display (cons 'image disp))))) - -(defmacro go-board-wrap (&rest body) - `(concat - "" - (go-board-svg-trans - '((svg (xmlns . "http://www.w3.org/2000/svg") - (xmlns:xlink . "http://www.w3.org/1999/xlink") - (width . 25) (height . 25) (version . 1.0)) - ,@body)))) - -;; TODO: To allow images to scale with text, this should return a -;; function instead of a list. This function should take a base -;; size (e.g., 12.5), and should return the image list -;; appropriate for that size. -(defmacro go-board-image (&rest body) - ``(image :type svg :ascent center :data - ,(go-board-wrap - ((rect (width . 25) (height . 25) (fill . "#dcb35c"))) - ,@body))) - -(defmacro go-board-image-sides (name &rest base) - (declare (indent 1)) - `(progn - ,@(mapcar - (lambda (p) - `(defvar ,(sym-cat 'go-board-image name (car p)) - (go-board-image - ,(when (cdr p) - `((path (stroke . "#000") (stroke-width . 1) (d . ,(cdr p))))) - ,@base))) - '((left . "M12,12.5H25M12.5,0V25") - (right . "M0,12.5H13M12.5,0V25") - (top . "M0,12.5H25M12.5,12V25") - (bottom . "M0,12.5H25M12.5,0V12.5") - (top-left . "M12,12.5H25M12.5,12V25") - (top-right . "M0,12.5H13M12.5,12V25") - (bottom-left . "M12,12.5H25M12.5,0V13") - (bottom-right . "M0,12.5H13M12.5,0V13") - (nil . "M0,12.5H25M12.5,0V25"))))) - - -;;; SVG Images -(go-board-image-sides background) - -(go-board-image-sides black - ((defs) - ((radialGradient (id . "$rg") (cx . ".3") (cy . ".3") (r . ".8")) - ((stop (offset . 0) (stop-color . "#777"))) - ((stop (offset . 0.3) (stop-color . "#222"))) - ((stop (offset . 1) (stop-color . "#000"))))) - ((circle (cx . 12.5) (cy . 12.5) (r . 9.375) (fill . "url(#$rg)")))) - -(go-board-image-sides white - ((defs) - ((radialGradient (id . "$rg") (cx . ".47") (cy . ".49") (r . ".48")) - ((stop (offset . 0.7) (stop-color . "#FFF"))) - ((stop (offset . 0.9) (stop-color . "#DDD"))) - ((stop (offset . 1) (stop-color . "#777"))))) - ((circle (cx . 12.5) (cy . 12.5) (r . 9.375) (fill . "url(#$rg)")))) - -(defvar go-board-image-hoshi - (go-board-image - ((path (stroke . "#000") (stroke-width . 1) (d . "M0,12.5H25M12.5,0V25"))) - ((circle (cx . 12.5) (cy . 12.5) (r . 2.5))))) - -(provide 'go-board-faces) -;;; go-board-faces.el ends here diff --git a/elpa/go-20160430.1739/go-board.el b/elpa/go-20160430.1739/go-board.el deleted file mode 100644 index 61e4343..0000000 --- a/elpa/go-20160430.1739/go-board.el +++ /dev/null @@ -1,578 +0,0 @@ -;;; go-board.el --- Smart Game Format GO board visualization - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Code: -(require 'go-util) -(require 'go-api) -(require 'go-board-faces) - -(defvar *history* nil "Holds the board history for a GO buffer.") -(defvar *size* nil "Holds the board size.") -(defvar *turn* nil "Holds the color of the current turn.") -(defvar *black* nil "Plist of info on black player.") -(defvar *white* nil "Plist of info on white player.") -(defvar *back-end* nil "Holds the primary back-end connected to a board.") -(defvar *trackers* nil "Holds a list of back-ends which should track the game.") -(defvar *autoplay* nil "Should `*back-end*' automatically respond to moves.") - -(defvar black-piece "X") -(defvar white-piece "O") - -(defvar go-board-use-images t) -(defvar *go-board-overlays* nil - "List of overlays carrying GO board painting information.") - -(defvar go-board-use-move-sound nil) -(defvar go-board-move-sound - `(sound :file ,(expand-file-name "stone.wav" - (file-name-directory - (or load-file-name (buffer-file-name)))))) - - -;;; Board manipulation functions -(defun make-board (size) (make-vector (* size size) nil)) - -(defun board-size (board) (round (sqrt (length board)))) - -(defun go-player-get (color property) - (plist-get (case color (:W *white*) (:B *black*)) property)) - -(defun go-player-set (color property value) - (let ((player (case color (:W *white*) (:B *black*)))) - (plist-put player property value))) - -(defsetf go-player-get go-player-set) - -(defun move-type (move) - (cond - ((member (car move) '(:B :W)) :move) - ((member (car move) '(:LB :LW)) :label))) - -(defun other-color (color) - (if (equal color :B) :W :B)) - -(defun point-of-pos (pos) - (catch 'found-pos - (dotimes (p (1- (point-max)) (error "go: pos %S not found" pos)) - (let ((pos-at-point (get-text-property (1+ p) :pos))) - (when (and pos-at-point (tree-equal pos pos-at-point)) - (throw 'found-pos (1+ p))))))) - -(defun apply-turn-to-board (moves) - (let ((board (pieces-to-board (car *history*) *size*))) - (clear-labels board) - (when go-board-use-move-sound (play-sound go-board-move-sound)) - (dolist (move moves) (apply-move board move)) - (push (board-to-pieces board) *history*) - (update-display (current-buffer)))) - -(defun apply-move (board move) - (cl-flet ((bset (val data) - (let ((data (if (listp (car data)) data (list data)))) - (setf (aref board (pos-to-index (aget data :pos) - (board-size board))) - (case val - (:B :B) - (:W :W) - (:LB (aget data :label)) - (:LW (aget data :label)) - (t nil)))))) - (case (move-type move) - (:move - (bset (car move) (cdr move)) - (let ((color (if (equal :B (car move)) :B :W))) - (remove-dead board (other-color color)) - (remove-dead board color))) - (:label - (dolist (data (cdr move)) (bset (car move) data)))))) - -(defun clear-labels (board) - (dotimes (point (length board) board) - (when (aref board point) - (unless (member (aref board point) '(:B :W)) - (setf (aref board point) nil))))) - -(defun neighbors (board piece) - (let ((size (board-size board)) - neighbors) - (when (not (= (mod piece size) (1- size))) (push (1+ piece) neighbors)) - (when (not (= (mod piece size) 0)) (push (1- piece) neighbors)) - (when (< (+ piece size) (length board)) (push (+ piece size) neighbors)) - (when (> (- piece size) 0) (push (- piece size) neighbors)) - neighbors)) - -(defun alive-p (board piece &optional already) - (let* ((val (aref board piece)) - (enemy (other-color val)) - (neighbors (remove-if (lambda (n) (member n already)) - (neighbors board piece))) - (neighbor-vals (mapcar (lambda (n) (aref board n)) neighbors)) - (friendly (delete nil (mapcar - (lambda (n) (when (equal (aref board n) val) n)) - neighbors))) - (already (cons piece already))) - (or (some (lambda (v) (not (or (equal v enemy) ; touching open space - (equal v val)))) - neighbor-vals) - (some (lambda (n) (alive-p board n already)) ; touching alive dragon - friendly)))) - -(defun remove-dead (board color) - ;; must remove one color at a time for ko situations - (let (cull) - (dotimes (n (length board) board) - (when (and (equal (aref board n) color) (not (alive-p board n))) - (push n cull))) - (incf (go-player-get (other-color color) :prisoners) (length cull)) - (dolist (n cull cull) (setf (aref board n) nil)))) - -(defun board-to-pieces (board) - (let (pieces) - (dotimes (n (length board) pieces) - (let ((val (aref board n))) - (when val (push (cons val n) pieces)))))) - -(defun pieces-to-board (pieces size) - (let ((board (make-vector (* size size) nil))) - (dolist (piece pieces board) - (setf (aref board (cdr piece)) (car piece))))) - - -;;; Visualization -(defun board-header (board) - (cl-flet ((hd (str hd) - (put-text-property 0 1 :type `(,hd . :offboard) str) - str)) - (let ((size (board-size board))) - (concat " " - (hd " " :filler) - (mapconcat (lambda (n) - (let ((char (+ ?A n))) - (when (>= char ?I) (setq char (+ 1 char))) - (hd (string char) :header))) - (range size) (hd " " :filler)))))) - -(defun board-pos-to-string (board pos) - (let ((size (board-size board))) - (cl-flet ((emph (n) - (cond - ((= size 19) - (or (= 3 n) - (= 4 (- size n)) - (= n (/ (- size 1) 2)))) - ((= size 13) - (or (= 3 n) - (= 9 n))) - ((= size 9) - (or (= 2 n) - (= 6 n))))) - (put (str prop val) (put-text-property 0 (length str) prop val str))) - (let* ((val (aref board (pos-to-index pos size))) - (str (cond - ((equal val :W) white-piece) - ((equal val :B) black-piece) - ((and (stringp val) (= 1 (length val)) val)) - (t (if (and (emph (car pos)) (emph (cdr pos))) "+" "."))))) - (put str :type - (cons (cond ;; foreground - ((string= str white-piece) :white) - ((string= str black-piece) :black) - ((string= str "+") :hoshi) - ((string= str ".") :background-1) - (t :background)) - (cond ;; background - ((and (= 0 (car pos)) (= 0 (cdr pos))) :bl) - ((and (= 0 (car pos)) (= (1- size) (cdr pos))) :br) - ((and (= (1- size) (car pos)) (= 0 (cdr pos))) :tl) - ((and (= (1- size) (car pos)) (= (1- size) (cdr pos))) :tr) - ((= 0 (car pos)) :b) - ((= (1- size) (car pos)) :t) - ((= 0 (cdr pos)) :l) - ((= (1- size) (cdr pos)) :r) - (t nil)))) - (put str :pos (cons (cdr pos) (car pos))) - str)))) - -(defun board-row-to-string (board row) - (let* ((size (board-size board)) - (label (format "%3d" (1+ row))) - (row-body "") - (filler " ")) - (put-text-property 0 1 :type (cons :background nil) filler) - (dotimes (n size) - (setq row-body - (concat row-body - (board-pos-to-string board (cons row n)) - filler))) - (concat label " " (substring row-body 0 (1- (length row-body))) label))) - -(defun board-body-to-string (board) - (let ((board (transpose-array board))) - (mapconcat (lambda (m) (board-row-to-string board m)) - (reverse (range (board-size board))) "\n"))) - -(defun board-to-string (board) - (let ((header (board-header board)) - (body (board-body-to-string board))) - (mapconcat #'identity (list header body header) "\n"))) - -(defun go-board-paint (&optional start end) - (interactive "r") - (cl-flet ((ov (point face &optional back) - (let ((ovly (make-overlay point (1+ point)))) - (overlay-put ovly 'go-pt point) - (overlay-put ovly 'face (sym-cat 'go-board face)) - (when go-board-use-images - (overlay-put ovly 'display - (if (equal face 'filler) - '(space :width (18)) - (eval (sym-cat 'go-board 'image face back))))) - (push ovly *go-board-overlays*))) - (hide (point) - (let ((ovly (make-overlay point (1+ point)))) - (overlay-put ovly 'invisible t) - (push ovly *go-board-overlays*)))) - (let ((start (or start (point-min))) - (end (or end (point-max)))) - (dolist (point (range start end)) - (if (get-text-property point :turn) - (font-lock-prepend-text-property point (1+ point) 'face 'underline) - (let ((back (case (cdr (get-text-property point :type)) - (:tl 'top-left) - (:tr 'top-right) - (:bl 'bottom-left) - (:br 'bottom-right) - (:t 'top) - (:b 'bottom) - (:l 'left) - (:r 'right) - (:offboard 'offboard)))) - (case (car (get-text-property point :type)) - (:header nil) - (:filler (ov point 'filler back)) - (:hoshi (ov point 'hoshi)) - (:white (ov point 'white back)) - (:black (ov point 'black back)) - (:background (if go-board-use-images - (hide point) - (ov point 'background))) - (:background-1 (ov point 'background back))))))))) - -(defun player-to-string (color) - (format "%10s: %3d" - (let ((name (go-player-get color :name))) - (put-text-property 0 (length name) :turn (equal *turn* color) name) - name) - (go-player-get color :prisoners))) - -(defun update-display (buffer) - (with-current-buffer buffer - (let ((point (point))) - (delete-region (point-min) (point-max)) - (insert "\n" - (board-to-string - (pieces-to-board (car *history*) *size*)) "\n\n" - (player-to-string :W) "\n" - (player-to-string :B) "\n") - (let ((comment (ignoring-unsupported (go-comment *back-end*)))) - (when comment - (insert (make-string (+ 6 (* 2 *size*)) ?=) - "\n\n" - comment))) - (go-board-paint) - (goto-char point))) - buffer) - -(defun go-board (back-end &rest trackers) - (let ((buffer (generate-new-buffer "*GO*"))) - (with-current-buffer buffer - (go-board-mode) - (let ((name (go-name back-end))) - (when name - (rename-buffer (ear-muffs name) 'unique) - (mapcar (lambda (tr) (setf (go-name tr) name)) trackers))) - (set (make-local-variable '*back-end*) back-end) - (set (make-local-variable '*turn*) :B) - (set (make-local-variable '*black*) '(:name "black" :prisoners 0)) - (set (make-local-variable '*white*) '(:name "white" :prisoners 0)) - (set (make-local-variable '*size*) (go-size back-end)) - (set (make-local-variable '*autoplay*) nil) - (set (make-local-variable '*go-board-overlays*) nil) - (mapcar (lambda (tr) (setf (go-size tr) *size*)) trackers) - (set (make-local-variable '*history*) - (list (board-to-pieces (make-board *size*)))) - (set (make-local-variable '*trackers*) trackers)) - (pop-to-buffer buffer) - (plist-put *black* :prisoners 0) - (plist-put *white* :prisoners 0) - (setq truncate-lines t) - (update-display buffer))) - - -;;; User input -(defmacro with-trackers (sym &rest body) - (declare (indent 1)) - `(ignoring-unsupported - (mapcar (lambda (tr) (let ((,sym tr)) ,@body)) *trackers*))) - -(defmacro with-backends (sym &rest body) - (declare (indent 1)) - `(save-window-excursion - (ignoring-unsupported - (prog1 (let ((,sym *back-end*)) ,@body) - (with-trackers ,sym ,@body))))) -(def-edebug-spec with-backends (sexp body)) - -(defvar go-board-actions '(move resign undo comment) - "List of actions which may be taken on an GO board.") - -(defun go-board-act () - "Send a command to the current GO board." - (interactive) - (let ((command (go-completing-read - "Action: " (mapcar #'symbol-name go-board-actions)))) - (case (intern command) - (move (message "make a move")) - (resign (message "game over")) - (undo (message "loser")) - (comment (message "what?"))))) - -(defun go-board-move (&optional pos) - (interactive) - (let* ((color (case *turn* (:B "black") (:W "white"))) - (pos (or pos (cons (char-to-num - (aref (downcase - (go-completing-read - (format "[%s] X pos: " color) - (mapcar #'string - (mapcar #'gtp-num-to-char - (range 1 *size*))))) - 0)) - (1- (string-to-number - (go-completing-read - (format "[%s] Y pos: " color) - (mapcar #'number-to-string - (range 1 *size*)))))))) - (move (cons *turn* (cons :pos pos)))) - (with-backends back - (setf (go-move back) move)) - (setf *turn* (other-color *turn*)) - (apply-turn-to-board (list move))) - (when *autoplay* (go-board-next))) - -(defun go-board-refresh () - (interactive) - (update-display (current-buffer))) - -(defun go-board-resign () - (interactive) - (with-backends back (go-resign back))) - -(defun go-board-mark-point (point mark) - (mapc (lambda (ov) (go-board-mark ov mark)) (overlays-at point))) - -(defun go-board-pass () - (interactive) - (with-backends back (go-pass back)) - (save-window-excursion - (setf *turn* (other-color *turn*)) - (when *autoplay* - (when (equalp :pass (go-board-next)) - ;; mark open points - (mapc (lambda (move) - (go-board-mark-point (point-of-pos (cddr move)) - (go-board-cross (ecase (car move) - (:B 'black) - (:W 'white))))) - (with-backends back (go-territory back))) - ;; mark dead stones - (mapc (lambda (move) - (let* ((point (point-of-pos (cddr move))) - (color (car (get-text-property point :type)))) - (go-board-mark-point point - (go-board-cross (ecase color - (:black 'white) - (:white 'black)))))) - (with-backends back (go-dead back))) - (message "final score: %s" (with-backends back (go-score back))))))) - -(defun go-board-undo (&optional num) - (interactive "p") - (with-backends back (go-undo back)) - (pop *history*) - (update-display (current-buffer)) - (setf *turn* (other-color *turn*))) - -(defun go-board-comment (&optional comment) - (interactive "MComment: ") - (with-backends back (setf (go-comment back) comment))) - -(defun go-board-level (&optional level) - (interactive "nLevel: ") - (with-backends back (setf (go-level back) level))) - -(defun go-board-next (&optional count) - (interactive "p") - (let (move) - (dotimes (n (or count 1) move) - (setf move (go-move *back-end*)) - (if (equal move :pass) - (message "pass") - (setf *turn* (other-color *turn*)) - (apply-turn-to-board - (cons move (ignoring-unsupported (go-labels *back-end*))))) - (with-trackers tr (setf (go-move tr) move)) - (if (equal move :pass) - (goto-char (point-min)) - (goto-char (point-of-pos (cddr move))))))) - -(defun go-board-mouse-move (ev) - (interactive "e") - (go-board-move (get-text-property (posn-point (event-start ev)) :pos))) - -(defun go-board-quit () - (interactive) - (when (y-or-n-p "quit: ") - (kill-buffer (current-buffer)))) - -(defun go-board-safe-quit () - (ignore-errors (with-backends tr (go-quit tr))) - t) - - -;;; Display mode -(defvar go-board-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "") 'go-board-mouse-move) - (define-key map (kbd "m") 'go-board-move) - (define-key map (kbd "r") 'go-board-refresh) - (define-key map (kbd "R") 'go-board-resign) - (define-key map (kbd "u") 'go-board-undo) - (define-key map (kbd "c") 'go-board-comment) - (define-key map (kbd "l") 'go-board-level) - (define-key map (kbd "p") 'go-board-pass) - (define-key map (kbd "") 'go-board-next) - (define-key map (kbd "") 'go-board-undo) - (define-key map (kbd "q") 'go-board-quit) - map) - "Keymap for `go-board-mode'.") - -(define-derived-mode go-board-mode nil "GO" - "Major mode for viewing a GO board." - (set (make-local-variable 'kill-buffer-query-functions) - (add-to-list 'kill-buffer-query-functions 'go-board-safe-quit))) - - -;;; Class and interface -(defclass board () - ((buffer :initarg :buffer :accessor buffer :initform nil))) - -(defmacro with-board (board &rest body) - (declare (indent 1)) - `(with-current-buffer (buffer ,board) ,@body)) - -(defmethod go-size ((board board)) - (with-board board *size*)) - -(defmethod set-go-size ((board board) size) - (with-board board (setq *size* size))) - -(defmethod go-name ((board board)) - (un-ear-muffs (buffer-name (buffer board)))) - -(defmethod set-go-name ((board board) name) - (with-board board (rename-buffer name 'unique))) - -(defmethod go-move ((board board)) - (signal 'unsupported-back-end-command (list board :move))) - -(defmethod set-go-move ((board board) move) - (with-board board - (setf *turn* (other-color *turn*)) - (apply-turn-to-board (list move)) - (goto-char (point-of-pos (cddr move))) - (with-trackers tr (setf (go-move tr) move)))) - -(defmethod go-labels ((board board)) - (signal 'unsupported-back-end-command (list board :labels))) - -(defmethod set-go-labels ((board board) labels) - (signal 'unsupported-back-end-command (list board :set-labels labels))) - -(defmethod go-comment ((board board)) - (signal 'unsupported-back-end-command (list board :comment))) - -(defmethod set-go-comment ((board board) comment) - (signal 'unsupported-back-end-command (list board :set-comment comment))) - -(defmethod go-alt ((board board)) - (signal 'unsupported-back-end-command (list board :alt))) - -(defmethod set-go-alt ((board board) alt) - (signal 'unsupported-back-end-command (list board :set-alt alt))) - -(defmethod go-color ((board board)) - (with-board board *turn*)) - -(defmethod set-go-color ((board board) color) - (with-board board (setq *turn* color))) - -(defmethod go-player-name ((board board) color) - (with-board board (go-player-get color :name))) - -(defmethod set-go-player-name ((board board) color name) - (with-board board (go-player-set color :name name))) - -(defmethod go-player-time ((board board) color) - (with-board board (go-player-get color :time))) - -(defmethod set-go-player-time ((board board) color time) - (with-board board (go-player-set color :time time))) - -(defmethod go-player-prisoners ((board board) color) - (with-board board (go-player-get color :prisoners))) - -(defmethod set-go-player-prisoners ((board board) color prisoners) - (with-board board (go-player-set color :prisoners prisoners))) - -;; non setf'able generic functions -(defmethod go-undo ((board board)) - (with-board board (go-board-undo))) - -(defmethod go-pass ((board board)) - (with-board board - (message "pass") - (setf *turn* (other-color *turn*)))) - -(defmethod go-resign ((board board)) - (with-board board (message "%s resign" *turn*))) - -(defmethod go-reset ((board board)) - (with-board board - (setf *history* nil) - (update-display))) - -(defmethod go-quit ((board board)) - (with-board board (go-quit))) - -(provide 'go-board) -;;; go-board.el ends here diff --git a/elpa/go-20160430.1739/go-pkg.el b/elpa/go-20160430.1739/go-pkg.el deleted file mode 100644 index fc9dd2e..0000000 --- a/elpa/go-20160430.1739/go-pkg.el +++ /dev/null @@ -1,7 +0,0 @@ -(define-package "go" "20160430.1739" "Play GO, translate and transfer between GO back ends" - '((emacs "24")) - :url "http://eschulte.github.io/el-go/" :keywords - '("game" "go" "sgf")) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/go-20160430.1739/go-util.el b/elpa/go-20160430.1739/go-util.el deleted file mode 100644 index aff1672..0000000 --- a/elpa/go-20160430.1739/go-util.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; go-util.el --- utility functions for GO functions - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2012-05-15 -;; Version: 0.1 -;; Keywords: game go sgf - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Code: -(eval-when-compile (require 'cl)) -(require 'assoc) - -(defun curry (function &rest arguments) - (lexical-let ((function function) - (arguments arguments)) - (lambda (&rest more) (apply function (append arguments more))))) - -(defun rcurry (function &rest arguments) - (lexical-let ((function function) - (arguments arguments)) - (lambda (&rest more) (apply function (append more arguments))))) - -(defun compose (function &rest more-functions) - (cl-reduce (lambda (f g) - (lexical-let ((f f) (g g)) - (lambda (&rest arguments) - (funcall f (apply g arguments))))) - more-functions - :initial-value function)) - -(defun indexed (list) - (loop for el in list as i from 0 collect (list i el))) - -(defun rcons (x lst) - (append lst (list x))) - -(defmacro rpush (x place) - "Insert X at the back of the list stored in PLACE." - (if (symbolp place) (list 'setq place (list 'rcons x place)) - (list 'callf2 'rcons x place))) - -(defun range (a &optional b) - (block nil - (let (tmp) - (unless b - (cond ((> a 0) (decf a)) - ((= a 0) (return nil)) - ((> 0 a) (incf a))) - (setq b a a 0)) - (if (> a b) (setq tmp a a b b tmp)) - (let ((res (number-sequence a b))) - (if tmp (nreverse res) res))))) - -(defun take (num list) (subseq list 0 num)) - -(defun set-aget (list key new) - (if (aget list key) - (setf (cdr (assoc key list)) new) - (setf (cdr (last list)) (list (cons key new))))) - -(defsetf aget set-aget) - -(defmacro until (test &rest body) - (declare (indent 1)) - `(while (not ,test) ,@body)) - -(defun alistp (list) - (and (listp list) - (listp (car list)) - (not (listp (caar list))))) - -(defun pos-to-index (pos size) - (+ (car pos) (* (cdr pos) size))) - -(defun transpose-array (board) - (let ((size (round (sqrt (length board)))) - (trans (make-vector (length board) nil))) - (dotimes (row size trans) - (dotimes (col size) - (setf (aref trans (pos-to-index (cons row col) size)) - (aref board (pos-to-index (cons col row) size))))))) - -(defun ear-muffs (str) (concat "*" str "*")) - -(defun un-ear-muffs (str) - (let ((pen-ult (1- (length str)))) - (if (and (= ?\* (aref str 0)) - (= ?\* (aref str pen-ult))) - (substring str 1 pen-ult) - str))) - -(defun char-to-num (char) - (cl-flet ((err () (error "gtp: invalid char %s" char))) - (cond - ((< char ?A) (err)) - ((< char ?I) (- char ?A)) - ((<= char ?T) (1- (- char ?A))) - ((< char ?a) (err)) - ((< char ?i) (- char ?a)) - ((<= char ?t) (1- (- char ?a))) - (t (err))))) - -(defun num-to-char (num) - (cl-flet ((err () (error "gtp: invalid num %s" num))) - (cond - ((< num 1) (err)) - ((< num 9) (+ ?A (1- num))) - (t (+ ?A num))))) - -(defun sym-cat (&rest syms) - (intern (mapconcat #'symbol-name (delq nil syms) "-"))) - -(defun go-number-p (string) - "If STRING represents a number return its value." - (if (and (string-match "[0-9]+" string) - (string-match "^-?[0-9]*\\.?[0-9]*$" string) - (= (length (substring string (match-beginning 0) - (match-end 0))) - (length string))) - (string-to-number string))) - -(defun go-clean-text-properties (string) - (set-text-properties 0 (length string) nil string) string) - -(defmacro go-re-cond (string &rest body) - (declare (indent 1)) - `(save-match-data - (cond ,@(mapcar - (lambda (part) - (cons (if (or (keywordp (car part)) (eq t (car part))) - (car part) - `(string-match ,(car part) ,string)) - (cdr part))) - body)))) -(def-edebug-spec go-re-cond (form body)) - -(defvar *go-partial-line* nil "Holds partial lines of input from a process.") -(defun make-go-insertion-filter (func) - (lexical-let ((func func)) - (lambda (proc string) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) - (save-excursion - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point)) - (let ((lines (split-string (if *go-partial-line* - (concat *go-partial-line* string) - string) - "[\n\r]"))) - (if (string-match "[\n\r]$" (car (last lines))) - (setf *go-partial-line* nil) - (setf *go-partial-line* (car (last lines))) - (setf lines (butlast lines))) - (mapc (lambda (s) (funcall func proc s)) lines))) - (when moving (goto-char (process-mark proc)))))))) - -(defalias 'go-completing-read (if (fboundp 'org-icompleting-read) - 'org-icompleting-read - 'completing-read)) - -(provide 'go-util) -;;; go-util.el ends here diff --git a/elpa/go-20160430.1739/go.el b/elpa/go-20160430.1739/go.el deleted file mode 100644 index b90170f..0000000 --- a/elpa/go-20160430.1739/go.el +++ /dev/null @@ -1,87 +0,0 @@ -;;; go.el --- Play GO, translate and transfer between GO back ends - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Maintainer: Eric Schulte -;; Version: 0.0.1 -;; Package-Requires: ((emacs "24")) -;; Created: 2012-05-15 -;; Keywords: game go sgf -;; URL: http://eschulte.github.io/el-go/ - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; A board-based interface to GO games which may be connected to a -;; number of GO back-ends through a generic API. To play a game of GO -;; against the gnugo back-end run `play-go'. Current back-ends -;; include the following. -;; - the SGF format -;; - the Go Text Protocol (GTP) -;; - TODO: the IGS protocol - -;;; Code: -(let ((load-path - (cons (file-name-directory (or load-file-name (buffer-file-name))) - load-path))) - (require 'go-util "go-util.el") - (require 'go-api "go-api.el") - (require 'go-board "go-board.el") - (require 'go-board-faces "go-board-faces.el") - (require 'gtp "back-ends/gtp.el") - (require 'gnugo "back-ends/gnugo.el") - (require 'sgf "back-ends/sgf.el") - (require 'sgf2el "back-ends/sgf2el.el") - (require 'igs "back-ends/igs.el") - (require 'gtp-pipe "back-ends/gtp-pipe.el")) - -(defun go-instantiate (back-end) - (interactive) - ;; TODO: read and set handicap. - (let ((it (make-instance back-end)) - (size (read (go-completing-read - "board size: " - (mapcar #'number-to-string '(19 13 9)))))) - (go-connect it) - (setf (go-size it) size) - it)) - -;;;###autoload -(defun go-play () - "Play a game of GO." - (interactive) - (let ((back-end (case (intern (go-completing-read - "play against: " '("gnugo" "person"))) - (gnugo (go-instantiate 'gnugo)) - (person (go-instantiate 'sgf))))) - (with-current-buffer (apply #'go-board - (cons back-end - (unless (equal (class-of back-end) 'sgf) - (list (make-instance 'sgf))))) - (unless (equal (class-of back-end) 'sgf) - (setq *autoplay* t))))) - -;;;###autoload -(defun go-view-sgf (&optional file) - "View an SGF file." - (interactive "fSGF file: ") - (let* ((sgf (make-instance 'sgf :self (sgf2el-file-to-el file) :index '(0))) - (buffer (go-board sgf))) - (with-current-buffer buffer - (setf (index *back-end*) (list 0))))) - -(provide 'go) -;;; go.el ends here diff --git a/elpa/go-20160430.1739/list-buffer.el b/elpa/go-20160430.1739/list-buffer.el deleted file mode 100644 index 850c586..0000000 --- a/elpa/go-20160430.1739/list-buffer.el +++ /dev/null @@ -1,192 +0,0 @@ -;;; list-buffer.el --- view a list as a table in a buffer - -;; Copyright (C) 2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Created: 2013-08-02 -;; Version: 0.1 -;; Keywords: list buffer cl - -;; This software is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This software is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Code: -(eval-when-compile (require 'cl)) -(require 'go-util) - -(defvar *buffer-list* nil - "List associated with the current list buffer.") - -(defvar *buffer-headers* nil - "Headers associated with the current list buffer.") - -(defvar *buffer-width* nil - "Width associated with the current list buffer.") - -(defvar *enter-function* nil - "Function used to enter a list element. -The function should take two arguments, the current row and -column respectively and may access the current buffer list -through the `*buffer-list*' variable.") - -(defvar *refresh-function* nil - "Function used to refresh a list element or the whole list. -The function should take two arguments, the current row and -column respectively and may access the current buffer list -through the `*buffer-list*' variable.") - -(defun list-buffer-create - (buffer list &optional headers enter-function refresh-function) - (pop-to-buffer buffer) - (list-mode) - (set (make-local-variable '*buffer-width*) (window-total-width)) - (set (make-local-variable '*buffer-list*) list) - (set (make-local-variable '*buffer-headers*) - (mapcar (curry #'format "%s") headers)) - (set (make-local-variable '*enter-function*) - (or enter-function - (lambda (row col) - (message "enter %S" (nth col (nth row *buffer-list*)))))) - (set (make-local-variable '*refresh-function*) - (or refresh-function - (lambda (row col) - (message "refresh %S" (nth col (nth row *buffer-list*)))))) - ;; refresh every time the buffer changes size - (set (make-local-variable 'window-size-change-functions) - (cons (lambda (b) - (when (or (not (numberp *buffer-width*)) - (not (equal *buffer-width* (window-total-width)))) - (set '*buffer-width* (window-total-width)) - (list-buffer-refresh))) - window-size-change-functions)) - (goto-char (point-min)) - (list-buffer-refresh)) - -(defun list-format-row (widths row &optional row-num) - (cl-flet ((num (type number string) - (put-text-property 0 (length string) type number string) - string)) - (let ((col 0)) - (num :row row-num - (apply #'concat - (cl-mapcar - (lambda (width cell) - (prog1 - (num :col col - (if (< (length cell) width) - (concat cell - (make-list (- width (length cell)) - ?\ )) - (concat (subseq cell 0 (- width 2)) "… "))) - (incf col))) - widths row)))))) - -(defun list-buffer-refresh () - (when *buffer-list* - (let* ((start (point)) - (strings (mapcar (curry #'mapcar (curry #'format "%s")) *buffer-list*)) - (lengths (mapcar (curry #'mapcar #'length) - (if *buffer-headers* - (cons *buffer-headers* strings) - strings))) - (widths (apply #'cl-mapcar (compose '1+ #'max) lengths)) - ;; scale widths by buffer width - (widths (mapcar (compose #'floor (curry #'* (/ (window-total-width) - (float (apply #'+ widths))))) - widths))) - ;; write headers - (when *buffer-headers* - (set (make-local-variable 'header-line-format) - (concat " " (list-format-row widths *buffer-headers*)))) - ;; write rows - (delete-region (point-min) (point-max)) - (insert (mapconcat (compose (curry #'apply #'list-format-row widths) #'reverse) - (indexed strings) "\n")) - (goto-char start)))) - -(defun list-buffer-sort (col predicate) - (set '*buffer-list* (cl-sort *buffer-list* predicate :key (curry #'nth col))) - (list-buffer-refresh)) - -(defun list-current-row () (get-text-property (point) :row)) - -(defun list-current-col () (get-text-property (point) :col)) - -(defun list< (a b) - (cond - ((and (numberp a) (numberp b) (< a b))) - ((and (stringp a) (stringp b) (string< a b))))) - -(defun list> (a b) - (cond - ((and (numberp a) (numberp b) (> a b))) - ((and (stringp a) (stringp b) (string> a b))))) - -(defun list-up () - (interactive) - (list-buffer-sort (get-text-property (point) :col) #'list<)) - -(defun list-down () - (interactive) - (list-buffer-sort (get-text-property (point) :col) #'list>)) - -(defun list-enter () - (interactive) - (funcall *enter-function* (list-current-row) (list-current-col))) - -(defun list-refresh () - (interactive) - (funcall *refresh-function* (list-current-row) (list-current-col))) - -(defun list-filter () - (interactive) - (error "not implemented.")) - -(defun list-move-col (direction) - (cl-flet ((col () (or (get-text-property (point) :col) start-col))) - (let ((start-col (col))) - (while (= start-col (col)) - (case direction - (:forward (forward-char)) - (:backward (backward-char)))) - (when (eql direction :backward) - (let ((end-col (col))) - (while (= end-col (col)) (backward-char)) - (forward-char)))))) - -(defun list-next-col () (interactive) (list-move-col :forward)) -(defun list-prev-col () (interactive) (list-move-col :backward)) - -(defvar list-mode-map - (let ((map (make-sparse-keymap))) - ;; navigation - (define-key map (kbd "j") 'next-line) - (define-key map (kbd "k") 'previous-line) - (define-key map (kbd "u") 'scroll-down-command) - (define-key map (kbd "") 'list-next-col) - (define-key map (kbd "") 'list-prev-col) - ;; list functions - (define-key map (kbd "") 'list-up) - (define-key map (kbd "") 'list-down) - (define-key map (kbd "f") 'list-filter) - (define-key map (kbd "r") 'list-refresh) - (define-key map (kbd "RET") 'list-enter) - (define-key map (kbd "q") 'bury-buffer) - map) - "Keymap for `list-mode'.") - -(define-derived-mode list-mode nil "list" - "Major mode for viewing a list.") - -(provide 'list-buffer) -;;; list-buffer.el ends here diff --git a/elpa/go-20160430.1739/stone.wav b/elpa/go-20160430.1739/stone.wav deleted file mode 100644 index 253078f..0000000 Binary files a/elpa/go-20160430.1739/stone.wav and /dev/null differ