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