lisp/play/gametree.el

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