Commit | Line | Data |
---|---|---|
747c1a5e RS |
1 | ;;; gametree.el --- manage game analysis trees in Emacs |
2 | ||
acaf905b | 3 | ;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc. |
747c1a5e RS |
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 | ||
b1fc2b50 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
747c1a5e | 12 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
747c1a5e RS |
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 | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
747c1a5e RS |
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, | |
a1506d29 | 68 | ;; quite simple. |
3bc5a5ee RS |
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. | |
747c1a5e RS |
79 | |
80 | ;;; Code: | |
81 | ||
82 | (require 'derived) | |
83 | (require 'outline) | |
84 | ||
85 | ;;;; Configuration variables | |
86 | ||
323f7c49 SE |
87 | (defgroup gametree nil |
88 | "Manage game analysis trees in Emacs." | |
89 | :prefix "gametree-" | |
42dfe0ad DN |
90 | :group 'games |
91 | :version "20.3") | |
323f7c49 SE |
92 | |
93 | (defcustom gametree-half-ply-regexp (regexp-quote ":") | |
67d110f1 | 94 | "Matches ends of numbers of moves by the \"second\" player. |
747c1a5e RS |
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 | |
323f7c49 SE |
100 | LaTeX macros he uses for typesetting annotated games." |
101 | :type 'regexp | |
102 | :group 'gametree) | |
747c1a5e | 103 | |
323f7c49 | 104 | (defcustom gametree-full-ply-regexp (regexp-quote ".") |
67d110f1 | 105 | "Matches ends of numbers of moves by the \"first\" player. |
747c1a5e | 106 | For instance, it is an almost universal convention in chess to postfix |
323f7c49 SE |
107 | numbers of moves by White (if considered in isolation) by the dot \".\"." |
108 | :type 'regexp | |
109 | :group 'gametree) | |
747c1a5e | 110 | |
323f7c49 | 111 | (defcustom gametree-half-ply-format "%d:" |
67d110f1 | 112 | "Output format for move numbers of moves by the \"second\" player. |
323f7c49 SE |
113 | Has to contain \"%d\" to output the actual number." |
114 | :type 'string | |
115 | :group 'gametree) | |
747c1a5e | 116 | |
323f7c49 | 117 | (defcustom gametree-full-ply-format "%d." |
67d110f1 | 118 | "Output format for move numbers of moves by the \"first\" player. |
323f7c49 SE |
119 | Has to contain \"%d\" to output the actual number." |
120 | :type 'string | |
121 | :group 'gametree) | |
747c1a5e | 122 | |
323f7c49 | 123 | (defcustom gametree-make-heading-function |
747c1a5e RS |
124 | (function (lambda (level) |
125 | (insert (make-string level ?*)))) | |
126 | "A function of one numeric argument, LEVEL, to insert a heading at point. | |
323f7c49 SE |
127 | You should change this if you change `outline-regexp'." |
128 | :type 'function | |
129 | :group 'gametree) | |
747c1a5e RS |
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 | ||
79c48ffe | 139 | (defcustom gametree-score-opener "{score=" |
67d110f1 | 140 | "The string which opens a score tag, and precedes the actual score." |
79c48ffe | 141 | :type 'string |
29114287 | 142 | :group 'gametree) |
3bc5a5ee | 143 | |
79c48ffe | 144 | (defcustom gametree-score-manual-flag "!" |
67d110f1 | 145 | "String marking the line as manually (as opposed to automatically) scored." |
79c48ffe | 146 | :type 'string |
29114287 | 147 | :group 'gametree) |
3bc5a5ee | 148 | |
79c48ffe | 149 | (defcustom gametree-score-closer "}" |
67d110f1 | 150 | "The string which closes a score tag, and follows the actual score." |
79c48ffe | 151 | :type 'string |
29114287 | 152 | :group 'gametree) |
3bc5a5ee | 153 | |
79c48ffe | 154 | (defcustom gametree-score-regexp |
3bc5a5ee RS |
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]") | |
67d110f1 | 162 | "Regular expression matching lines that guide the program in scoring. |
3bc5a5ee RS |
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 | |
79c48ffe RS |
169 | score instead." |
170 | :type 'regexp | |
29114287 | 171 | :group 'gametree) |
3bc5a5ee | 172 | |
79c48ffe | 173 | (defcustom gametree-default-score 0 |
67d110f1 | 174 | "Score to assume for branches lacking score tags." |
79c48ffe | 175 | :type 'integer |
29114287 | 176 | :group 'gametree) |
3bc5a5ee | 177 | \f |
747c1a5e RS |
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 | |
a1506d29 | 200 | (let ((boundary (concat "[ \t]*\\([1-9][0-9]*\\)\\(" |
747c1a5e RS |
201 | gametree-full-ply-regexp "\\|" |
202 | gametree-half-ply-regexp "\\)")) | |
5ed619e0 | 203 | (limit (line-beginning-position 1))) |
747c1a5e | 204 | (if (looking-at boundary) |
027a4b6b | 205 | (+ (* 2 (string-to-number (match-string 1))) |
747c1a5e | 206 | (if (string-match gametree-half-ply-regexp (match-string 2)) 1 0)) |
a1506d29 | 207 | (save-excursion |
747c1a5e RS |
208 | (re-search-backward boundary limit) |
209 | (skip-chars-backward "0123456789") | |
027a4b6b | 210 | (1+ (* 2 (string-to-number |
747c1a5e | 211 | (buffer-substring (point) (match-end 1)))))))))) |
a1506d29 | 212 | |
747c1a5e RS |
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 | ||
3bc5a5ee RS |
220 | (defsubst gametree-forward-line () |
221 | (re-search-forward "[\n\^M]" nil 'move)) | |
222 | ||
747c1a5e RS |
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 | ||
3bc5a5ee RS |
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)))) | |
a1506d29 | 245 | |
3bc5a5ee | 246 | \f |
747c1a5e RS |
247 | ;;;; Functions related to the task of saving and restoring current |
248 | ;;;; outline layout | |
249 | ||
3bc5a5ee | 250 | (defsubst gametree-show-children-and-entry () |
747c1a5e RS |
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 | |
121656e9 | 261 | (ignore-errors |
747c1a5e RS |
262 | (let ((depth (gametree-current-branch-depth))) |
263 | (outline-next-visible-heading 1) | |
121656e9 | 264 | (< depth (gametree-current-branch-depth)))))) |
747c1a5e | 265 | |
121656e9 | 266 | (defun gametree-current-layout (depth &optional from-top-level) |
747c1a5e RS |
267 | (let ((layout nil) (first-time t)) |
268 | (while (save-excursion | |
121656e9 JB |
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)))) | |
747c1a5e RS |
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 | ||
121656e9 | 297 | (defun gametree-apply-layout (layout depth &optional from-top-level) |
747c1a5e RS |
298 | (let ((first-time t)) |
299 | (while (and layout | |
300 | (save-excursion | |
121656e9 JB |
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))))) | |
747c1a5e RS |
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))) | |
a1506d29 | 332 | (princ gametree-local-layout)))))) |
747c1a5e | 333 | |
3bc5a5ee RS |
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) | |
027a4b6b | 341 | (string-to-number (match-string 3)) |
3bc5a5ee RS |
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))) | |
121656e9 | 373 | (setq done (ignore-errors (outline-forward-same-level 1))))) |
3bc5a5ee RS |
374 | running))))) |
375 | \f | |
747c1a5e RS |
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." | |
3bc5a5ee | 387 | (interactive "*P") |
747c1a5e RS |
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")))) | |
a1506d29 | 402 | (let ((starting-plys |
747c1a5e RS |
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-plys 2)) | |
410 | gametree-full-ply-format | |
411 | gametree-half-ply-format) | |
412 | (/ starting-plys 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 plys 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 | |
a1506d29 | 423 | only work of Black's moves are explicitly numbered, for instance |
747c1a5e | 424 | `1. e4 1: e5'." |
3bc5a5ee | 425 | (interactive "*P") |
747c1a5e RS |
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)))) | |
3bc5a5ee | 437 | (gametree-transpose-following-leaves) |
747c1a5e RS |
438 | (let* ((pt (set-marker (make-marker) (point))) |
439 | (plys (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 | (- plys 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 | |
a1506d29 JB |
460 | (if (not (looking-at (concat "[ \t]*[1-9][0-9]*\\(" |
461 | gametree-full-ply-regexp "\\|" | |
747c1a5e RS |
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) plys)))) | |
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." | |
3bc5a5ee | 480 | (interactive "*") |
747c1a5e RS |
481 | (if (zerop (gametree-current-branch-depth)) |
482 | (outline-up-heading 0)) | |
3bc5a5ee RS |
483 | (if (looking-at gametree-score-regexp) |
484 | (delete-region (match-beginning 1) (match-end 1))) | |
747c1a5e RS |
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 | ||
3bc5a5ee RS |
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 | |
a1506d29 JB |
519 | (insert (int-to-string (prefix-numeric-value score)))))) |
520 | ||
3bc5a5ee RS |
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 | ||
747c1a5e RS |
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 | (interactive "cLayout to register: ") | |
536 | (save-excursion | |
537 | (goto-char (point-min)) | |
538 | (set-register register | |
539 | (gametree-current-layout 0 t)))) | |
540 | ||
541 | (defun gametree-apply-register-layout (char) | |
542 | "Return to a tree layout stored in a register. | |
543 | Argument is a character, naming the register." | |
3bc5a5ee | 544 | (interactive "*cApply layout from register: ") |
747c1a5e RS |
545 | (save-excursion |
546 | (goto-char (point-min)) | |
547 | (gametree-apply-layout (get-register char) 0 t))) | |
548 | ||
549 | (defun gametree-save-and-hack-layout () | |
550 | "Save the current tree layout and hack the file local variable spec. | |
551 | This function saves the current layout in `gametree-local-layout' and, | |
c80e3b4a | 552 | if a local file variable specification for this variable exists in the |
747c1a5e RS |
553 | buffer, it is replaced by the new value. See the documentation for |
554 | `gametree-local-layout' for more information." | |
555 | (interactive) | |
556 | (gametree-save-layout) | |
3bc5a5ee RS |
557 | (let ((inhibit-read-only t)) |
558 | (gametree-hack-file-layout)) | |
747c1a5e RS |
559 | nil) |
560 | ||
b016851c SM |
561 | ;;;; Key bindings |
562 | (defvar gametree-mode-map | |
563 | (let ((map (make-sparse-keymap))) | |
564 | (define-key map "\C-c\C-j" 'gametree-break-line-here) | |
565 | (define-key map "\C-c\C-v" 'gametree-insert-new-leaf) | |
566 | (define-key map "\C-c\C-m" 'gametree-merge-line) | |
567 | (define-key map "\C-c\C-r " 'gametree-layout-to-register) | |
568 | (define-key map "\C-c\C-r/" 'gametree-layout-to-register) | |
569 | (define-key map "\C-c\C-rj" 'gametree-apply-register-layout) | |
570 | (define-key map "\C-c\C-y" 'gametree-save-and-hack-layout) | |
571 | (define-key map "\C-c;" 'gametree-insert-score) | |
572 | (define-key map "\C-c^" 'gametree-compute-and-insert-score) | |
573 | map)) | |
574 | ||
747c1a5e | 575 | (define-derived-mode gametree-mode outline-mode "GameTree" |
a1506d29 | 576 | "Major mode for managing game analysis trees. |
747c1a5e RS |
577 | Useful to postal and email chess (and, it is hoped, also checkers, go, |
578 | shogi, etc.) players, it is a slightly modified version of Outline mode. | |
579 | ||
580 | \\{gametree-mode-map}" | |
47ef2dea RS |
581 | (auto-fill-mode 0) |
582 | (make-local-variable 'write-contents-hooks) | |
583 | (add-hook 'write-contents-hooks 'gametree-save-and-hack-layout)) | |
747c1a5e | 584 | |
747c1a5e RS |
585 | ;;;; Goodies for mousing users |
586 | (and (fboundp 'track-mouse) | |
587 | (defun gametree-mouse-break-line-here (event) | |
588 | (interactive "e") | |
589 | (mouse-set-point event) | |
590 | (gametree-break-line-here)) | |
591 | (defun gametree-mouse-show-children-and-entry (event) | |
592 | (interactive "e") | |
593 | (mouse-set-point event) | |
594 | (gametree-show-children-and-entry)) | |
595 | (defun gametree-mouse-show-subtree (event) | |
596 | (interactive "e") | |
597 | (mouse-set-point event) | |
598 | (show-subtree)) | |
599 | (defun gametree-mouse-hide-subtree (event) | |
600 | (interactive "e") | |
601 | (mouse-set-point event) | |
602 | (hide-subtree)) | |
603 | (define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] | |
604 | 'gametree-mouse-break-line-here) | |
605 | (define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] | |
606 | 'gametree-mouse-show-children-and-entry) | |
607 | (define-key gametree-mode-map [S-down-mouse-2 S-mouse-2] | |
608 | 'gametree-mouse-show-subtree) | |
609 | (define-key gametree-mode-map [S-down-mouse-3 S-mouse-3] | |
610 | 'gametree-mouse-hide-subtree)) | |
611 | ||
612 | (provide 'gametree) | |
613 | ||
614 | ;;; gametree.el ends here |