20782
|
1 ;;; gametree.el --- manage game analysis trees in Emacs
|
|
2
|
|
3 ;; Copyright (C) 1997 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,
|
24225
|
70 ;; quite simple.
|
20782
|
71
|
24225
|
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.
|
20782
|
81
|
|
82 ;;; Code:
|
|
83
|
|
84 (require 'derived)
|
|
85 (require 'outline)
|
|
86
|
|
87 ;;;; Configuration variables
|
|
88
|
21363
|
89 (defgroup gametree nil
|
|
90 "Manage game analysis trees in Emacs."
|
|
91 :prefix "gametree-"
|
21651
|
92 :group 'games
|
|
93 :version "20.3")
|
21363
|
94
|
|
95 (defcustom gametree-half-ply-regexp (regexp-quote ":")
|
20782
|
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
|
21363
|
102 LaTeX macros he uses for typesetting annotated games."
|
|
103 :type 'regexp
|
|
104 :group 'gametree)
|
20782
|
105
|
21363
|
106 (defcustom gametree-full-ply-regexp (regexp-quote ".")
|
20782
|
107 "*Matches ends of numbers of moves by the \"first\" player.
|
|
108 For instance, it is an almost universal convention in chess to postfix
|
21363
|
109 numbers of moves by White (if considered in isolation) by the dot \".\"."
|
|
110 :type 'regexp
|
|
111 :group 'gametree)
|
20782
|
112
|
21363
|
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."
|
20782
|
120 "*Output format for move numbers of moves by the \"first\" player.
|
21363
|
121 Has to contain \"%d\" to output the actual number."
|
|
122 :type 'string
|
|
123 :group 'gametree)
|
20782
|
124
|
21363
|
125 (defcustom gametree-make-heading-function
|
20782
|
126 (function (lambda (level)
|
|
127 (insert (make-string level ?*))))
|
|
128 "A function of one numeric argument, LEVEL, to insert a heading at point.
|
21363
|
129 You should change this if you change `outline-regexp'."
|
|
130 :type 'function
|
|
131 :group 'gametree)
|
20782
|
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
|
24226
|
141 (defcustom gametree-score-opener "{score="
|
|
142 "*The string which opens a score tag, and precedes the actual score."
|
|
143 :type 'string
|
24227
|
144 :group 'gametree)
|
24225
|
145
|
24226
|
146 (defcustom gametree-score-manual-flag "!"
|
|
147 "*String marking the line as manually (as opposed to automatically) scored."
|
|
148 :type 'string
|
24227
|
149 :group 'gametree)
|
24225
|
150
|
24226
|
151 (defcustom gametree-score-closer "}"
|
|
152 "*The string which closes a score tag, and follows the actual score."
|
|
153 :type 'string
|
24227
|
154 :group 'gametree)
|
24225
|
155
|
24226
|
156 (defcustom gametree-score-regexp
|
24225
|
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
|
24226
|
171 score instead."
|
|
172 :type 'regexp
|
24227
|
173 :group 'gametree)
|
24225
|
174
|
24226
|
175 (defcustom gametree-default-score 0
|
|
176 "*Score to assume for branches lacking score tags."
|
|
177 :type 'integer
|
24227
|
178 :group 'gametree)
|
24225
|
179
|
20782
|
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
|
24225
|
222 (defsubst gametree-forward-line ()
|
|
223 (re-search-forward "[\n\^M]" nil 'move))
|
|
224
|
20782
|
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
|
24225
|
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
|
20782
|
249 ;;;; Functions related to the task of saving and restoring current
|
|
250 ;;;; outline layout
|
|
251
|
24225
|
252 (defsubst gametree-show-children-and-entry ()
|
20782
|
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
|
24225
|
341
|
|
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
|
20782
|
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."
|
24225
|
396 (interactive "*P")
|
20782
|
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'."
|
24225
|
434 (interactive "*P")
|
20782
|
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))))
|
24225
|
446 (gametree-transpose-following-leaves)
|
20782
|
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."
|
24225
|
489 (interactive "*")
|
20782
|
490 (if (zerop (gametree-current-branch-depth))
|
|
491 (outline-up-heading 0))
|
24225
|
492 (if (looking-at gametree-score-regexp)
|
|
493 (delete-region (match-beginning 1) (match-end 1)))
|
20782
|
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
|
24225
|
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
|
20782
|
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."
|
24225
|
553 (interactive "*cApply layout from register: ")
|
20782
|
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)
|
24225
|
566 (let ((inhibit-read-only t))
|
|
567 (gametree-hack-file-layout))
|
20782
|
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)
|
24225
|
589 (define-key gametree-mode-map "\C-c;" 'gametree-insert-score)
|
|
590 (define-key gametree-mode-map "\C-c^" 'gametree-compute-and-insert-score)
|
20782
|
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 ;;; gametree.el ends here
|