lisp/play/gametree.el

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