| 1 | ;;; gametree.el --- manage game analysis trees in Emacs |
| 2 | |
| 3 | ;; Copyright (C) 1997, 1999 Free Software Foundation, Inc |
| 4 | |
| 5 | ;; Author: Ian T Zimmerman <itz@rahul.net> |
| 6 | ;; Created: Wed Dec 10 07:41:46 PST 1997 |
| 7 | ;; Keywords: games |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 14 | ;; any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 24 | ;; Boston, MA 02111-1307, USA. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; This little hack has enabled me to keep track of my email chess |
| 29 | ;; games in Emacs. For a long time I dreamt about writing a real, |
| 30 | ;; graphical tree editor; but, then the idea struck me, why do it |
| 31 | ;; graphically, when it can be done in Emacs? :-) And in fact Emacs |
| 32 | ;; almost had what I needed out of the box, namely the powerful |
| 33 | ;; Outline mode. This code is built entirely on Outline mode, it |
| 34 | ;; only adds two commands that I found indispensable when dealing |
| 35 | ;; with the special kind of trees that analysis trees comprise. |
| 36 | |
| 37 | ;; The built-in documentation should be enough to explain the use, |
| 38 | ;; along with the following example (yes, this is a real game). |
| 39 | |
| 40 | ;; *** 23. f4 ef 24. Nf3 Rf3 -/+ |
| 41 | ;; 25. Rf3 Qh2 26. Kh1 Qh1 27. Ke2 Qg2 -+ |
| 42 | ;; ******* 25. gf3 Nce3 26. Qe2 Nf1 -/+ |
| 43 | ;; 27. Qe5 Ne5 28. Kf1 Nf3 -/+ |
| 44 | ;; 27. Kf1 Nh2 28. Kf2 Ng4 29. fg4 Rf8 30. Ke1 Qg3 31. Kd1 Rf2 -+ |
| 45 | |
| 46 | ;; Place the preceding in a scratch buffer, load this code, and do |
| 47 | ;; M-x gametree-mode. Now place the cursor just after the `Nf3' and |
| 48 | ;; before the `Rf3' on the first line, and do C-c C-j. The result is |
| 49 | |
| 50 | ;; *** 23. f4 ef 24. Nf3 |
| 51 | ;; ****** 24: Rf3 -/+ |
| 52 | ;; 25. Rf3 Qh2 26. Kh1 Qh1 27. Ke2 Qg2 -+ |
| 53 | ;; ******* 25. gf3 Nce3 26. Qe2 Nf1 -/+ |
| 54 | ;; 27. Qe5 Ne5 28. Kf1 Nf3 -/+ |
| 55 | ;; 27. Kf1 Nh2 28. Kf2 Ng4 29. fg4 Rf8 30. Ke1 Qg3 31. Kd1 Rf2 -+ |
| 56 | |
| 57 | ;; Now you can add another subvariation on Black's 24th move: with |
| 58 | ;; the cursor still on the first line, do C-c C-v, and voila |
| 59 | |
| 60 | ;; *** 23. f4 ef 24. Nf3 |
| 61 | ;; 24: |
| 62 | ;; ****** 24: Rf3 -/+ |
| 63 | ;; 25. Rf3 Qh2 26. Kh1 Qh1 27. Ke2 Qg2 -+ |
| 64 | ;; ******* 25. gf3 Nce3 26. Qe2 Nf1 -/+ |
| 65 | ;; 27. Qe5 Ne5 28. Kf1 Nf3 -/+ |
| 66 | ;; 27. Kf1 Nh2 28. Kf2 Ng4 29. fg4 Rf8 30. Ke1 Qg3 31. Kd1 Rf2 -+ |
| 67 | |
| 68 | ;; and the cursor is positioned on the new line just after the move |
| 69 | ;; number, so you can start typing the new analysis. That's it, |
| 70 | ;; quite simple. |
| 71 | |
| 72 | ;; As of version 1.1, a simple score reducer has been implemented. |
| 73 | ;; As you type in leaf variations, you can add a numerical score tag |
| 74 | ;; to them with C-c ; . Then, with the cursor on a variation higher |
| 75 | ;; up in the tree, you can do C-c ^ and the program will compute the |
| 76 | ;; reduced score of the internal variation based on the scores of its |
| 77 | ;; children (which are recursively computed). You can use any range |
| 78 | ;; of numbers you wish as scores, maybe -1000 to 1000 or 0 to 100, |
| 79 | ;; all that matters to the program is that higher means better for |
| 80 | ;; White, lower means better for Black. |
| 81 | |
| 82 | ;;; Code: |
| 83 | |
| 84 | (require 'derived) |
| 85 | (require 'outline) |
| 86 | |
| 87 | ;;;; Configuration variables |
| 88 | |
| 89 | (defgroup gametree nil |
| 90 | "Manage game analysis trees in Emacs." |
| 91 | :prefix "gametree-" |
| 92 | :group 'games |
| 93 | :version "20.3") |
| 94 | |
| 95 | (defcustom gametree-half-ply-regexp (regexp-quote ":") |
| 96 | "*Matches ends of numbers of moves by the \"second\" player. |
| 97 | For instance, it is an almost universal convention in chess to postfix |
| 98 | numbers of moves by Black (if considered in isolation) by the ellipsis |
| 99 | \"...\". This is NOT a good choice for this program, though, because it |
| 100 | conflicts with the use of ellipsis by Outline mode to denote collapsed |
| 101 | subtrees. The author uses \":\" because it agrees nicely with a set of |
| 102 | LaTeX macros he uses for typesetting annotated games." |
| 103 | :type 'regexp |
| 104 | :group 'gametree) |
| 105 | |
| 106 | (defcustom gametree-full-ply-regexp (regexp-quote ".") |
| 107 | "*Matches ends of numbers of moves by the \"first\" player. |
| 108 | For instance, it is an almost universal convention in chess to postfix |
| 109 | numbers of moves by White (if considered in isolation) by the dot \".\"." |
| 110 | :type 'regexp |
| 111 | :group 'gametree) |
| 112 | |
| 113 | (defcustom gametree-half-ply-format "%d:" |
| 114 | "*Output format for move numbers of moves by the \"second\" player. |
| 115 | Has to contain \"%d\" to output the actual number." |
| 116 | :type 'string |
| 117 | :group 'gametree) |
| 118 | |
| 119 | (defcustom gametree-full-ply-format "%d." |
| 120 | "*Output format for move numbers of moves by the \"first\" player. |
| 121 | Has to contain \"%d\" to output the actual number." |
| 122 | :type 'string |
| 123 | :group 'gametree) |
| 124 | |
| 125 | (defcustom gametree-make-heading-function |
| 126 | (function (lambda (level) |
| 127 | (insert (make-string level ?*)))) |
| 128 | "A function of one numeric argument, LEVEL, to insert a heading at point. |
| 129 | You should change this if you change `outline-regexp'." |
| 130 | :type 'function |
| 131 | :group 'gametree) |
| 132 | |
| 133 | (defvar gametree-local-layout nil |
| 134 | "A list encoding the layout (i.e. the show or hide state) of the file. |
| 135 | If Emacs notices a local variable specification of this variable in |
| 136 | the first line of the buffer while saving the buffer to the visited |
| 137 | file, the local value will be saved there and restored the next time |
| 138 | the file is visited (subject to the usual restriction via |
| 139 | `enable-local-variables'), and the layout will be set accordingly.") |
| 140 | |
| 141 | (defcustom gametree-score-opener "{score=" |
| 142 | "*The string which opens a score tag, and precedes the actual score." |
| 143 | :type 'string |
| 144 | :group 'gametree) |
| 145 | |
| 146 | (defcustom gametree-score-manual-flag "!" |
| 147 | "*String marking the line as manually (as opposed to automatically) scored." |
| 148 | :type 'string |
| 149 | :group 'gametree) |
| 150 | |
| 151 | (defcustom gametree-score-closer "}" |
| 152 | "*The string which closes a score tag, and follows the actual score." |
| 153 | :type 'string |
| 154 | :group 'gametree) |
| 155 | |
| 156 | (defcustom gametree-score-regexp |
| 157 | (concat "[^\n\^M]*\\(" |
| 158 | (regexp-quote gametree-score-opener) |
| 159 | "[ ]*\\(" |
| 160 | (regexp-quote gametree-score-manual-flag) |
| 161 | "[ ]*\\)?\\([-+]?[0-9]+\\)" |
| 162 | (regexp-quote gametree-score-closer) |
| 163 | "[ ]*\\)[\n\^M]") |
| 164 | "*Regular expression matching lines that guide the program in scoring. |
| 165 | Its third parenthetical group should match the actual score. Its |
| 166 | first parenthetical group should match the entire score tag. Its |
| 167 | second parenthetical group should be an optional flag that marks the |
| 168 | line as *manually* (as opposed to automatically) scored, which |
| 169 | prevents the program from recursively applying the scoring algorithm |
| 170 | on the subtree headed by the marked line, and makes it use the manual |
| 171 | score instead." |
| 172 | :type 'regexp |
| 173 | :group 'gametree) |
| 174 | |
| 175 | (defcustom gametree-default-score 0 |
| 176 | "*Score to assume for branches lacking score tags." |
| 177 | :type 'integer |
| 178 | :group 'gametree) |
| 179 | \f |
| 180 | ;;;; Helper functions |
| 181 | |
| 182 | (defun gametree-prettify-heading () |
| 183 | "Insert/delete space between leading asterisks and heading text. |
| 184 | If the current variation is an internal node (i.e. starts with one or |
| 185 | more asterisks), ensure there's at least one space between the |
| 186 | asterisks and the text. If on the other hand this is a leaf, there |
| 187 | should be no leading white space." |
| 188 | (save-excursion |
| 189 | (beginning-of-line 1) |
| 190 | (if (re-search-forward (concat "\\=" outline-regexp) nil t) |
| 191 | (if (not (looking-at "[ \t]+")) (insert " ")) |
| 192 | (delete-char (save-excursion (skip-chars-forward " \t")))) |
| 193 | (if (re-search-forward (concat "\\=[ \t]*[1-9][0-9]*\\(" |
| 194 | gametree-full-ply-regexp "\\|" |
| 195 | gametree-half-ply-regexp "\\)") nil t) |
| 196 | (if (not (looking-at "[ \t]+")) (insert " ") |
| 197 | (delete-char (1- (save-excursion (skip-chars-forward " \t")))))))) |
| 198 | |
| 199 | (defun gametree-looking-at-ply () |
| 200 | "Read and return the number of the ply under point." |
| 201 | (if (eobp) 0 |
| 202 | (let ((boundary (concat "[ \t]*\\([1-9][0-9]*\\)\\(" |
| 203 | gametree-full-ply-regexp "\\|" |
| 204 | gametree-half-ply-regexp "\\)")) |
| 205 | (limit (save-excursion (beginning-of-line 1) (point)))) |
| 206 | (if (looking-at boundary) |
| 207 | (+ (* 2 (string-to-int (match-string 1))) |
| 208 | (if (string-match gametree-half-ply-regexp (match-string 2)) 1 0)) |
| 209 | (save-excursion |
| 210 | (re-search-backward boundary limit) |
| 211 | (skip-chars-backward "0123456789") |
| 212 | (1+ (* 2 (string-to-int |
| 213 | (buffer-substring (point) (match-end 1)))))))))) |
| 214 | |
| 215 | (defun gametree-current-branch-ply () |
| 216 | "Return the ply number of the first move of the current variation." |
| 217 | (save-excursion |
| 218 | (beginning-of-line 1) |
| 219 | (re-search-forward (concat "\\=" outline-regexp) nil t) |
| 220 | (gametree-looking-at-ply))) |
| 221 | |
| 222 | (defsubst gametree-forward-line () |
| 223 | (re-search-forward "[\n\^M]" nil 'move)) |
| 224 | |
| 225 | (defun gametree-current-branch-depth () |
| 226 | "Return the depth of the current variation in the analysis tree. |
| 227 | This value is simply the outline heading level of the current line." |
| 228 | (save-excursion |
| 229 | (beginning-of-line 1) |
| 230 | (if (looking-at outline-regexp) |
| 231 | (outline-level) 0))) |
| 232 | |
| 233 | (defun gametree-transpose-following-leaves () |
| 234 | "Move the current leaf variation behind all others on the same level." |
| 235 | (let ((following-leaves |
| 236 | (save-excursion |
| 237 | (gametree-forward-line) |
| 238 | (let ((p (point))) |
| 239 | (while (and (not (eobp)) |
| 240 | (= 0 (gametree-current-branch-depth))) |
| 241 | (gametree-forward-line)) |
| 242 | (prog1 (buffer-substring p (point)) |
| 243 | (delete-region p (point))))))) |
| 244 | (save-excursion |
| 245 | (beginning-of-line 1) |
| 246 | (insert following-leaves)))) |
| 247 | |
| 248 | \f |
| 249 | ;;;; Functions related to the task of saving and restoring current |
| 250 | ;;;; outline layout |
| 251 | |
| 252 | (defsubst gametree-show-children-and-entry () |
| 253 | (show-children) |
| 254 | (show-entry)) |
| 255 | |
| 256 | (defun gametree-entry-shown-p () |
| 257 | (save-excursion |
| 258 | (forward-line 1) |
| 259 | (and (bolp) (not (eobp)) (not (looking-at outline-regexp))))) |
| 260 | |
| 261 | (defun gametree-children-shown-p () |
| 262 | (save-excursion |
| 263 | (condition-case nil |
| 264 | (let ((depth (gametree-current-branch-depth))) |
| 265 | (outline-next-visible-heading 1) |
| 266 | (< depth (gametree-current-branch-depth))) |
| 267 | (error nil)))) |
| 268 | |
| 269 | (defun gametree-current-layout (depth &optional top-level) |
| 270 | (let ((layout nil) (first-time t)) |
| 271 | (while (save-excursion |
| 272 | (condition-case nil |
| 273 | (progn |
| 274 | (or (and first-time top-level |
| 275 | (bolp) (looking-at outline-regexp)) |
| 276 | (setq first-time nil) |
| 277 | (outline-next-visible-heading 1)) |
| 278 | (< depth (gametree-current-branch-depth))) |
| 279 | (error nil))) |
| 280 | (if (not first-time) |
| 281 | (outline-next-visible-heading 1)) |
| 282 | (setq first-time nil) |
| 283 | (if (not (gametree-children-shown-p)) |
| 284 | (setq layout |
| 285 | (nconc layout |
| 286 | (if (gametree-entry-shown-p) |
| 287 | (list 'show-entry) |
| 288 | (list nil)))) |
| 289 | (setq layout (nconc layout (if (gametree-entry-shown-p) |
| 290 | (list 'gametree-show-children-and-entry) |
| 291 | (list 'show-children)))) |
| 292 | (let ((sub-layout |
| 293 | (gametree-current-layout (gametree-current-branch-depth)))) |
| 294 | (setq layout (nconc layout (list sub-layout)))))) |
| 295 | layout)) |
| 296 | |
| 297 | (defun gametree-save-layout () |
| 298 | (save-excursion |
| 299 | (goto-char (point-min)) |
| 300 | (setq gametree-local-layout (gametree-current-layout 0 t)))) |
| 301 | |
| 302 | (defun gametree-apply-layout (layout depth &optional top-level) |
| 303 | (let ((first-time t)) |
| 304 | (while (and layout |
| 305 | (save-excursion |
| 306 | (condition-case nil |
| 307 | (progn |
| 308 | (or (and first-time top-level |
| 309 | (bolp) (looking-at outline-regexp)) |
| 310 | (setq first-time nil) |
| 311 | (outline-next-visible-heading 1)) |
| 312 | (< depth (gametree-current-branch-depth))) |
| 313 | (error nil)))) |
| 314 | (if (not first-time) |
| 315 | (outline-next-visible-heading 1)) |
| 316 | (setq first-time nil) |
| 317 | (hide-subtree) |
| 318 | (if (nth 0 layout) |
| 319 | (funcall (nth 0 layout))) |
| 320 | (if (not (and (nth 1 layout) (listp (nth 1 layout)))) |
| 321 | (setq layout (cdr layout)) |
| 322 | (gametree-apply-layout (nth 1 layout) |
| 323 | (gametree-current-branch-depth)) |
| 324 | (setq layout (cdr (cdr layout))))))) |
| 325 | |
| 326 | (defun gametree-restore-layout () |
| 327 | (save-excursion |
| 328 | (goto-char (point-min)) |
| 329 | (gametree-apply-layout gametree-local-layout 0 t))) |
| 330 | |
| 331 | (defun gametree-hack-file-layout () |
| 332 | (save-excursion |
| 333 | (goto-char (point-min)) |
| 334 | (if (looking-at "[^\n]*-\*-[^\n]*gametree-local-layout: \\([^;\n]*\\);") |
| 335 | (progn |
| 336 | (goto-char (match-beginning 1)) |
| 337 | (delete-region (point) (match-end 1)) |
| 338 | (let ((standard-output (current-buffer))) |
| 339 | (princ gametree-local-layout)))))) |
| 340 | |
| 341 | \f |
| 342 | ;;;; Scoring functions |
| 343 | |
| 344 | (defun gametree-current-branch-score () |
| 345 | "Return score of current variation according to its score tag. |
| 346 | When no score tag is present, use the value of `gametree-default-score'." |
| 347 | (if (looking-at gametree-score-regexp) |
| 348 | (string-to-int (match-string 3)) |
| 349 | gametree-default-score)) |
| 350 | |
| 351 | (defun gametree-compute-reduced-score () |
| 352 | "Return current internal node score computed recursively from subnodes. |
| 353 | Subnodes which have been manually scored are honored." |
| 354 | (if (or |
| 355 | (= 0 (gametree-current-branch-depth)) |
| 356 | (save-excursion (gametree-forward-line) (eobp)) |
| 357 | (and (looking-at gametree-score-regexp) |
| 358 | (not (null (match-string 2))))) |
| 359 | (gametree-current-branch-score) |
| 360 | (let ((depth (gametree-current-branch-depth))) |
| 361 | (save-excursion |
| 362 | (gametree-forward-line) |
| 363 | ;; the case of a leaf node has already been handled, so here I |
| 364 | ;; know I am on the 1st line of the current subtree. This can |
| 365 | ;; be either a leaf child, or a subheading. |
| 366 | (let ((running gametree-default-score) |
| 367 | (minmax |
| 368 | (if (= 0 (mod (gametree-current-branch-ply) 2)) |
| 369 | 'max 'min))) |
| 370 | (while (and (not (eobp)) |
| 371 | (= 0 (gametree-current-branch-depth))) ;handle leaves |
| 372 | (setq running (funcall minmax running |
| 373 | (gametree-current-branch-score))) |
| 374 | (gametree-forward-line)) |
| 375 | (let ((done (and (not (eobp)) |
| 376 | (< depth (gametree-current-branch-depth))))) |
| 377 | (while (not done) ;handle subheadings |
| 378 | (setq running (funcall minmax running |
| 379 | (gametree-compute-reduced-score))) |
| 380 | (setq done (condition-case nil |
| 381 | (outline-forward-same-level 1) |
| 382 | (error nil))))) |
| 383 | running))))) |
| 384 | \f |
| 385 | ;;;; Commands |
| 386 | |
| 387 | (defun gametree-insert-new-leaf (&optional at-depth) |
| 388 | "Start a new leaf variation under the current branching point. |
| 389 | The new variation can later be split to be a branching point itself, |
| 390 | with \\[gametree-break-line-here]. If the point is currently on a |
| 391 | leaf variation, this command won't work; use \\[gametree-break-line-here] |
| 392 | on the current line first. |
| 393 | |
| 394 | With a numeric arg AT-DEPTH, first go up the tree until a node of |
| 395 | depth AT-DEPTH or smaller is found." |
| 396 | (interactive "*P") |
| 397 | (if (zerop (gametree-current-branch-depth)) |
| 398 | (outline-up-heading 0)) |
| 399 | (if at-depth |
| 400 | (while (> (gametree-current-branch-depth) |
| 401 | (prefix-numeric-value at-depth)) |
| 402 | (outline-up-heading 1))) |
| 403 | (beginning-of-line 1) |
| 404 | (let ((parent-depth (gametree-current-branch-depth))) |
| 405 | (show-entry) |
| 406 | (condition-case nil |
| 407 | (outline-next-visible-heading 1) |
| 408 | (error |
| 409 | (goto-char (point-max)) |
| 410 | (if (not (bolp)) (insert "\n")))) |
| 411 | (let ((starting-plys |
| 412 | (if (> (gametree-current-branch-depth) parent-depth) |
| 413 | (gametree-current-branch-ply) |
| 414 | (save-excursion (forward-line -1) |
| 415 | (gametree-current-branch-ply))))) |
| 416 | (goto-char (1- (point))) |
| 417 | (insert "\n") |
| 418 | (insert (format (if (= 0 (mod starting-plys 2)) |
| 419 | gametree-full-ply-format |
| 420 | gametree-half-ply-format) |
| 421 | (/ starting-plys 2)))))) |
| 422 | |
| 423 | (defun gametree-break-line-here (&optional at-move) |
| 424 | "Split the variation node at the point position. |
| 425 | This command works whether the current variation node is a leaf, or is |
| 426 | already branching at its end. The new node is created at a level that |
| 427 | reflects the number of game plys between the beginning of the current |
| 428 | variation and the breaking point. |
| 429 | |
| 430 | With a numerical argument AT-MOVE, split the variation before |
| 431 | White's AT-MOVEth move, or Black's if negative. The last option will |
| 432 | only work of Black's moves are explicitly numbered, for instance |
| 433 | `1. e4 1: e5'." |
| 434 | (interactive "*P") |
| 435 | (if at-move (progn |
| 436 | (end-of-line 1) |
| 437 | (let ((limit (point))) |
| 438 | (beginning-of-line 1) |
| 439 | (re-search-forward |
| 440 | (concat |
| 441 | (regexp-quote |
| 442 | (int-to-string (abs (prefix-numeric-value at-move)))) |
| 443 | (if (> at-move 0) gametree-full-ply-regexp |
| 444 | gametree-half-ply-regexp)) limit)) |
| 445 | (goto-char (match-beginning 0)))) |
| 446 | (gametree-transpose-following-leaves) |
| 447 | (let* ((pt (set-marker (make-marker) (point))) |
| 448 | (plys (gametree-current-branch-ply)) |
| 449 | (depth (gametree-current-branch-depth)) |
| 450 | (old-depth depth)) |
| 451 | (if (= depth 0) |
| 452 | (progn |
| 453 | (save-excursion |
| 454 | (outline-previous-visible-heading 1) |
| 455 | (setq depth |
| 456 | (let ((old-branch-ply |
| 457 | (condition-case nil |
| 458 | (gametree-current-branch-ply) |
| 459 | (error 0)))) |
| 460 | (if (zerop old-branch-ply) |
| 461 | (1+ (gametree-current-branch-depth)) |
| 462 | (+ (gametree-current-branch-depth) |
| 463 | (- plys old-branch-ply)))))) |
| 464 | (save-excursion |
| 465 | (beginning-of-line 1) |
| 466 | (funcall gametree-make-heading-function depth) |
| 467 | (gametree-prettify-heading)))) |
| 468 | (save-excursion |
| 469 | (if (not (looking-at (concat "[ \t]*[1-9][0-9]*\\(" |
| 470 | gametree-full-ply-regexp "\\|" |
| 471 | gametree-half-ply-regexp "\\)"))) |
| 472 | (progn |
| 473 | (insert (format (if (= 0 (mod (gametree-looking-at-ply) 2)) |
| 474 | gametree-full-ply-format |
| 475 | gametree-half-ply-format) |
| 476 | (/ (gametree-looking-at-ply) 2))) |
| 477 | (gametree-prettify-heading) |
| 478 | (beginning-of-line 1))) |
| 479 | (goto-char pt) |
| 480 | (insert "\n") |
| 481 | (if (not (= 0 old-depth)) |
| 482 | (funcall gametree-make-heading-function |
| 483 | (+ depth (- (gametree-current-branch-ply) plys)))) |
| 484 | (gametree-prettify-heading)))) |
| 485 | |
| 486 | (defun gametree-merge-line () |
| 487 | "Merges a variation with its only child. |
| 488 | Does *not* check if the variation has in fact a unique child; users beware." |
| 489 | (interactive "*") |
| 490 | (if (zerop (gametree-current-branch-depth)) |
| 491 | (outline-up-heading 0)) |
| 492 | (if (looking-at gametree-score-regexp) |
| 493 | (delete-region (match-beginning 1) (match-end 1))) |
| 494 | (end-of-line 1) |
| 495 | (let ((prev-depth (save-excursion (forward-line 1) |
| 496 | (gametree-current-branch-depth)))) |
| 497 | (delete-char (1+ prev-depth)) |
| 498 | (if (zerop prev-depth) |
| 499 | (save-excursion |
| 500 | (beginning-of-line 1) |
| 501 | (delete-char (gametree-current-branch-depth)) |
| 502 | (gametree-prettify-heading))))) |
| 503 | |
| 504 | (defun gametree-insert-score (score &optional auto) |
| 505 | "Insert a score tag with value SCORE at the end of the current line. |
| 506 | If this line already has a score tag, just jump to it and alter it. |
| 507 | When called from a program, optional AUTO flag tells if the score is |
| 508 | being entered automatically (and thus should lack the manual mark)." |
| 509 | (interactive "*P") |
| 510 | (beginning-of-line 1) |
| 511 | (if (looking-at gametree-score-regexp) |
| 512 | (progn |
| 513 | (goto-char (match-beginning 3)) |
| 514 | (if (and auto (not (null (match-string 2)))) |
| 515 | (delete-region (match-beginning 2) (match-end 2))) |
| 516 | (if (not (null score)) |
| 517 | (delete-region (match-beginning 3) (match-end 3))) |
| 518 | (if (and (not auto) (null (match-string 2))) |
| 519 | (insert gametree-score-manual-flag))) |
| 520 | (end-of-line 1) |
| 521 | (if (= 0 (save-excursion (skip-chars-backward " \t"))) |
| 522 | (insert " ")) |
| 523 | (insert gametree-score-opener) |
| 524 | (if (not auto) (insert gametree-score-manual-flag)) |
| 525 | (save-excursion (insert gametree-score-closer))) |
| 526 | (if (not (null score)) |
| 527 | (save-excursion |
| 528 | (insert (int-to-string (prefix-numeric-value score)))))) |
| 529 | |
| 530 | (defun gametree-compute-and-insert-score () |
| 531 | "Compute current node score, maybe recursively from subnodes. Insert it. |
| 532 | Subnodes which have been manually scored are honored." |
| 533 | (interactive "*") |
| 534 | (let ((auto (not (and (looking-at gametree-score-regexp) |
| 535 | (not (null (match-string 2)))))) |
| 536 | (score (gametree-compute-reduced-score))) |
| 537 | (gametree-insert-score score auto))) |
| 538 | |
| 539 | |
| 540 | (defun gametree-layout-to-register (register) |
| 541 | "Store current tree layout in register REGISTER. |
| 542 | Use \\[gametree-apply-register-layout] to restore that configuration. |
| 543 | Argument is a character, naming the register." |
| 544 | (interactive "cLayout to register: ") |
| 545 | (save-excursion |
| 546 | (goto-char (point-min)) |
| 547 | (set-register register |
| 548 | (gametree-current-layout 0 t)))) |
| 549 | |
| 550 | (defun gametree-apply-register-layout (char) |
| 551 | "Return to a tree layout stored in a register. |
| 552 | Argument is a character, naming the register." |
| 553 | (interactive "*cApply layout from register: ") |
| 554 | (save-excursion |
| 555 | (goto-char (point-min)) |
| 556 | (gametree-apply-layout (get-register char) 0 t))) |
| 557 | |
| 558 | (defun gametree-save-and-hack-layout () |
| 559 | "Save the current tree layout and hack the file local variable spec. |
| 560 | This function saves the current layout in `gametree-local-layout' and, |
| 561 | if a local file varible specification for this variable exists in the |
| 562 | buffer, it is replaced by the new value. See the documentation for |
| 563 | `gametree-local-layout' for more information." |
| 564 | (interactive) |
| 565 | (gametree-save-layout) |
| 566 | (let ((inhibit-read-only t)) |
| 567 | (gametree-hack-file-layout)) |
| 568 | nil) |
| 569 | |
| 570 | (define-derived-mode gametree-mode outline-mode "GameTree" |
| 571 | "Major mode for managing game analysis trees. |
| 572 | Useful to postal and email chess (and, it is hoped, also checkers, go, |
| 573 | shogi, etc.) players, it is a slightly modified version of Outline mode. |
| 574 | |
| 575 | \\{gametree-mode-map}" |
| 576 | (auto-fill-mode 0) |
| 577 | (make-variable-buffer-local 'write-contents-hooks) |
| 578 | (add-hook 'write-contents-hooks 'gametree-save-and-hack-layout)) |
| 579 | |
| 580 | ;;;; Key bindings |
| 581 | |
| 582 | (define-key gametree-mode-map "\C-c\C-j" 'gametree-break-line-here) |
| 583 | (define-key gametree-mode-map "\C-c\C-v" 'gametree-insert-new-leaf) |
| 584 | (define-key gametree-mode-map "\C-c\C-m" 'gametree-merge-line) |
| 585 | (define-key gametree-mode-map "\C-c\C-r " 'gametree-layout-to-register) |
| 586 | (define-key gametree-mode-map "\C-c\C-r/" 'gametree-layout-to-register) |
| 587 | (define-key gametree-mode-map "\C-c\C-rj" 'gametree-apply-register-layout) |
| 588 | (define-key gametree-mode-map "\C-c\C-y" 'gametree-save-and-hack-layout) |
| 589 | (define-key gametree-mode-map "\C-c;" 'gametree-insert-score) |
| 590 | (define-key gametree-mode-map "\C-c^" 'gametree-compute-and-insert-score) |
| 591 | |
| 592 | ;;;; Goodies for mousing users |
| 593 | (and (fboundp 'track-mouse) |
| 594 | (defun gametree-mouse-break-line-here (event) |
| 595 | (interactive "e") |
| 596 | (mouse-set-point event) |
| 597 | (gametree-break-line-here)) |
| 598 | (defun gametree-mouse-show-children-and-entry (event) |
| 599 | (interactive "e") |
| 600 | (mouse-set-point event) |
| 601 | (gametree-show-children-and-entry)) |
| 602 | (defun gametree-mouse-show-subtree (event) |
| 603 | (interactive "e") |
| 604 | (mouse-set-point event) |
| 605 | (show-subtree)) |
| 606 | (defun gametree-mouse-hide-subtree (event) |
| 607 | (interactive "e") |
| 608 | (mouse-set-point event) |
| 609 | (hide-subtree)) |
| 610 | (define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] |
| 611 | 'gametree-mouse-break-line-here) |
| 612 | (define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] |
| 613 | 'gametree-mouse-show-children-and-entry) |
| 614 | (define-key gametree-mode-map [S-down-mouse-2 S-mouse-2] |
| 615 | 'gametree-mouse-show-subtree) |
| 616 | (define-key gametree-mode-map [S-down-mouse-3 S-mouse-3] |
| 617 | 'gametree-mouse-hide-subtree)) |
| 618 | |
| 619 | (provide 'gametree) |
| 620 | |
| 621 | ;;; arch-tag: aaa30943-9ae4-4cc1-813d-a46f96b7e4f1 |
| 622 | ;;; gametree.el ends here |