Mercurial > emacs
annotate lisp/play/gametree.el @ 22841:330629423307
(push_key_description): Output multibyte char as itself.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 28 Jul 1998 23:10:44 +0000 |
parents | 86fcccceba7b |
children | 985eb547550f |
rev | line source |
---|---|
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, | |
70 ;; quite simple. If you want more, read on. | |
71 | |
72 ;;; ToDo: | |
73 | |
74 ;; BIG: automatic score reducer. It should be possible to label the | |
75 ;; leaf variations with numeric scores (instead of the Informant-like | |
76 ;; symbols used in the example) and have the program apply the | |
77 ;; min-max algorithm to score the internal nodes. That's about as | |
78 ;; far as one can go in a postal game while honestly claiming not to | |
79 ;; use computer analysis. | |
80 | |
81 ;; I'd definitely like to hear from you if you use this, and even | |
82 ;; more if you have suggestions for improvement, ranging from bug | |
83 ;; reports to feature requests. (But be warned that I am a fan of | |
84 ;; simplicity and orthogonality). | |
85 | |
86 ;;; Code: | |
87 | |
88 (require 'derived) | |
89 (require 'outline) | |
90 | |
91 ;;;; Configuration variables | |
92 | |
21363 | 93 (defgroup gametree nil |
94 "Manage game analysis trees in Emacs." | |
95 :prefix "gametree-" | |
21651
86fcccceba7b
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
21363
diff
changeset
|
96 :group 'games |
86fcccceba7b
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
21363
diff
changeset
|
97 :version "20.3") |
21363 | 98 |
99 (defcustom gametree-half-ply-regexp (regexp-quote ":") | |
20782 | 100 "*Matches ends of numbers of moves by the \"second\" player. |
101 For instance, it is an almost universal convention in chess to postfix | |
102 numbers of moves by Black (if considered in isolation) by the ellipsis | |
103 \"...\". This is NOT a good choice for this program, though, because it | |
104 conflicts with the use of ellipsis by Outline mode to denote collapsed | |
105 subtrees. The author uses \":\" because it agrees nicely with a set of | |
21363 | 106 LaTeX macros he uses for typesetting annotated games." |
107 :type 'regexp | |
108 :group 'gametree) | |
20782 | 109 |
21363 | 110 (defcustom gametree-full-ply-regexp (regexp-quote ".") |
20782 | 111 "*Matches ends of numbers of moves by the \"first\" player. |
112 For instance, it is an almost universal convention in chess to postfix | |
21363 | 113 numbers of moves by White (if considered in isolation) by the dot \".\"." |
114 :type 'regexp | |
115 :group 'gametree) | |
20782 | 116 |
21363 | 117 (defcustom gametree-half-ply-format "%d:" |
118 "*Output format for move numbers of moves by the \"second\" player. | |
119 Has to contain \"%d\" to output the actual number." | |
120 :type 'string | |
121 :group 'gametree) | |
122 | |
123 (defcustom gametree-full-ply-format "%d." | |
20782 | 124 "*Output format for move numbers of moves by the \"first\" player. |
21363 | 125 Has to contain \"%d\" to output the actual number." |
126 :type 'string | |
127 :group 'gametree) | |
20782 | 128 |
21363 | 129 (defcustom gametree-make-heading-function |
20782 | 130 (function (lambda (level) |
131 (insert (make-string level ?*)))) | |
132 "A function of one numeric argument, LEVEL, to insert a heading at point. | |
21363 | 133 You should change this if you change `outline-regexp'." |
134 :type 'function | |
135 :group 'gametree) | |
20782 | 136 |
137 (defvar gametree-local-layout nil | |
138 "A list encoding the layout (i.e. the show or hide state) of the file. | |
139 If Emacs notices a local variable specification of this variable in | |
140 the first line of the buffer while saving the buffer to the visited | |
141 file, the local value will be saved there and restored the next time | |
142 the file is visited (subject to the usual restriction via | |
143 `enable-local-variables'), and the layout will be set accordingly.") | |
144 | |
145 ;;;; Helper functions | |
146 | |
147 (defun gametree-prettify-heading () | |
148 "Insert/delete space between leading asterisks and heading text. | |
149 If the current variation is an internal node (i.e. starts with one or | |
150 more asterisks), ensure there's at least one space between the | |
151 asterisks and the text. If on the other hand this is a leaf, there | |
152 should be no leading white space." | |
153 (save-excursion | |
154 (beginning-of-line 1) | |
155 (if (re-search-forward (concat "\\=" outline-regexp) nil t) | |
156 (if (not (looking-at "[ \t]+")) (insert " ")) | |
157 (delete-char (save-excursion (skip-chars-forward " \t")))) | |
158 (if (re-search-forward (concat "\\=[ \t]*[1-9][0-9]*\\(" | |
159 gametree-full-ply-regexp "\\|" | |
160 gametree-half-ply-regexp "\\)") nil t) | |
161 (if (not (looking-at "[ \t]+")) (insert " ") | |
162 (delete-char (1- (save-excursion (skip-chars-forward " \t")))))))) | |
163 | |
164 (defun gametree-looking-at-ply () | |
165 "Read and return the number of the ply under point." | |
166 (if (eobp) 0 | |
167 (let ((boundary (concat "[ \t]*\\([1-9][0-9]*\\)\\(" | |
168 gametree-full-ply-regexp "\\|" | |
169 gametree-half-ply-regexp "\\)")) | |
170 (limit (save-excursion (beginning-of-line 1) (point)))) | |
171 (if (looking-at boundary) | |
172 (+ (* 2 (string-to-int (match-string 1))) | |
173 (if (string-match gametree-half-ply-regexp (match-string 2)) 1 0)) | |
174 (save-excursion | |
175 (re-search-backward boundary limit) | |
176 (skip-chars-backward "0123456789") | |
177 (1+ (* 2 (string-to-int | |
178 (buffer-substring (point) (match-end 1)))))))))) | |
179 | |
180 (defun gametree-current-branch-ply () | |
181 "Return the ply number of the first move of the current variation." | |
182 (save-excursion | |
183 (beginning-of-line 1) | |
184 (re-search-forward (concat "\\=" outline-regexp) nil t) | |
185 (gametree-looking-at-ply))) | |
186 | |
187 (defun gametree-current-branch-depth () | |
188 "Return the depth of the current variation in the analysis tree. | |
189 This value is simply the outline heading level of the current line." | |
190 (save-excursion | |
191 (beginning-of-line 1) | |
192 (if (looking-at outline-regexp) | |
193 (outline-level) 0))) | |
194 | |
195 ;;;; Functions related to the task of saving and restoring current | |
196 ;;;; outline layout | |
197 | |
198 (defun gametree-show-children-and-entry () | |
199 (show-children) | |
200 (show-entry)) | |
201 | |
202 (defun gametree-entry-shown-p () | |
203 (save-excursion | |
204 (forward-line 1) | |
205 (and (bolp) (not (eobp)) (not (looking-at outline-regexp))))) | |
206 | |
207 (defun gametree-children-shown-p () | |
208 (save-excursion | |
209 (condition-case nil | |
210 (let ((depth (gametree-current-branch-depth))) | |
211 (outline-next-visible-heading 1) | |
212 (< depth (gametree-current-branch-depth))) | |
213 (error nil)))) | |
214 | |
215 (defun gametree-current-layout (depth &optional top-level) | |
216 (let ((layout nil) (first-time t)) | |
217 (while (save-excursion | |
218 (condition-case nil | |
219 (progn | |
220 (or (and first-time top-level | |
221 (bolp) (looking-at outline-regexp)) | |
222 (setq first-time nil) | |
223 (outline-next-visible-heading 1)) | |
224 (< depth (gametree-current-branch-depth))) | |
225 (error nil))) | |
226 (if (not first-time) | |
227 (outline-next-visible-heading 1)) | |
228 (setq first-time nil) | |
229 (if (not (gametree-children-shown-p)) | |
230 (setq layout | |
231 (nconc layout | |
232 (if (gametree-entry-shown-p) | |
233 (list 'show-entry) | |
234 (list nil)))) | |
235 (setq layout (nconc layout (if (gametree-entry-shown-p) | |
236 (list 'gametree-show-children-and-entry) | |
237 (list 'show-children)))) | |
238 (let ((sub-layout | |
239 (gametree-current-layout (gametree-current-branch-depth)))) | |
240 (setq layout (nconc layout (list sub-layout)))))) | |
241 layout)) | |
242 | |
243 (defun gametree-save-layout () | |
244 (save-excursion | |
245 (goto-char (point-min)) | |
246 (setq gametree-local-layout (gametree-current-layout 0 t)))) | |
247 | |
248 (defun gametree-apply-layout (layout depth &optional top-level) | |
249 (let ((first-time t)) | |
250 (while (and layout | |
251 (save-excursion | |
252 (condition-case nil | |
253 (progn | |
254 (or (and first-time top-level | |
255 (bolp) (looking-at outline-regexp)) | |
256 (setq first-time nil) | |
257 (outline-next-visible-heading 1)) | |
258 (< depth (gametree-current-branch-depth))) | |
259 (error nil)))) | |
260 (if (not first-time) | |
261 (outline-next-visible-heading 1)) | |
262 (setq first-time nil) | |
263 (hide-subtree) | |
264 (if (nth 0 layout) | |
265 (funcall (nth 0 layout))) | |
266 (if (not (and (nth 1 layout) (listp (nth 1 layout)))) | |
267 (setq layout (cdr layout)) | |
268 (gametree-apply-layout (nth 1 layout) | |
269 (gametree-current-branch-depth)) | |
270 (setq layout (cdr (cdr layout))))))) | |
271 | |
272 (defun gametree-restore-layout () | |
273 (save-excursion | |
274 (goto-char (point-min)) | |
275 (gametree-apply-layout gametree-local-layout 0 t))) | |
276 | |
277 (defun gametree-hack-file-layout () | |
278 (save-excursion | |
279 (goto-char (point-min)) | |
280 (if (looking-at "[^\n]*-\*-[^\n]*gametree-local-layout: \\([^;\n]*\\);") | |
281 (progn | |
282 (goto-char (match-beginning 1)) | |
283 (delete-region (point) (match-end 1)) | |
284 (let ((standard-output (current-buffer))) | |
285 (princ gametree-local-layout)))))) | |
286 | |
287 ;;;; Commands | |
288 | |
289 (defun gametree-insert-new-leaf (&optional at-depth) | |
290 "Start a new leaf variation under the current branching point. | |
291 The new variation can later be split to be a branching point itself, | |
292 with \\[gametree-break-line-here]. If the point is currently on a | |
293 leaf variation, this command won't work; use \\[gametree-break-line-here] | |
294 on the current line first. | |
295 | |
296 With a numeric arg AT-DEPTH, first go up the tree until a node of | |
297 depth AT-DEPTH or smaller is found." | |
298 (interactive "P") | |
299 (if (zerop (gametree-current-branch-depth)) | |
300 (outline-up-heading 0)) | |
301 (if at-depth | |
302 (while (> (gametree-current-branch-depth) | |
303 (prefix-numeric-value at-depth)) | |
304 (outline-up-heading 1))) | |
305 (beginning-of-line 1) | |
306 (let ((parent-depth (gametree-current-branch-depth))) | |
307 (show-entry) | |
308 (condition-case nil | |
309 (outline-next-visible-heading 1) | |
310 (error | |
311 (goto-char (point-max)) | |
312 (if (not (bolp)) (insert "\n")))) | |
313 (let ((starting-plys | |
314 (if (> (gametree-current-branch-depth) parent-depth) | |
315 (gametree-current-branch-ply) | |
316 (save-excursion (forward-line -1) | |
317 (gametree-current-branch-ply))))) | |
318 (goto-char (1- (point))) | |
319 (insert "\n") | |
320 (insert (format (if (= 0 (mod starting-plys 2)) | |
321 gametree-full-ply-format | |
322 gametree-half-ply-format) | |
323 (/ starting-plys 2)))))) | |
324 | |
325 (defun gametree-break-line-here (&optional at-move) | |
326 "Split the variation node at the point position. | |
327 This command works whether the current variation node is a leaf, or is | |
328 already branching at its end. The new node is created at a level that | |
329 reflects the number of game plys between the beginning of the current | |
330 variation and the breaking point. | |
331 | |
332 With a numerical argument AT-MOVE, split the variation before | |
333 White's AT-MOVEth move, or Black's if negative. The last option will | |
334 only work of Black's moves are explicitly numbered, for instance | |
335 `1. e4 1: e5'." | |
336 (interactive "P") | |
337 (if at-move (progn | |
338 (end-of-line 1) | |
339 (let ((limit (point))) | |
340 (beginning-of-line 1) | |
341 (re-search-forward | |
342 (concat | |
343 (regexp-quote | |
344 (int-to-string (abs (prefix-numeric-value at-move)))) | |
345 (if (> at-move 0) gametree-full-ply-regexp | |
346 gametree-half-ply-regexp)) limit)) | |
347 (goto-char (match-beginning 0)))) | |
348 (let* ((pt (set-marker (make-marker) (point))) | |
349 (plys (gametree-current-branch-ply)) | |
350 (depth (gametree-current-branch-depth)) | |
351 (old-depth depth)) | |
352 (if (= depth 0) | |
353 (progn | |
354 (save-excursion | |
355 (outline-previous-visible-heading 1) | |
356 (setq depth | |
357 (let ((old-branch-ply | |
358 (condition-case nil | |
359 (gametree-current-branch-ply) | |
360 (error 0)))) | |
361 (if (zerop old-branch-ply) | |
362 (1+ (gametree-current-branch-depth)) | |
363 (+ (gametree-current-branch-depth) | |
364 (- plys old-branch-ply)))))) | |
365 (save-excursion | |
366 (beginning-of-line 1) | |
367 (funcall gametree-make-heading-function depth) | |
368 (gametree-prettify-heading)))) | |
369 (save-excursion | |
370 (if (not (looking-at (concat "[ \t]*[1-9][0-9]*\\(" | |
371 gametree-full-ply-regexp "\\|" | |
372 gametree-half-ply-regexp "\\)"))) | |
373 (progn | |
374 (insert (format (if (= 0 (mod (gametree-looking-at-ply) 2)) | |
375 gametree-full-ply-format | |
376 gametree-half-ply-format) | |
377 (/ (gametree-looking-at-ply) 2))) | |
378 (gametree-prettify-heading) | |
379 (beginning-of-line 1))) | |
380 (goto-char pt) | |
381 (insert "\n") | |
382 (if (not (= 0 old-depth)) | |
383 (funcall gametree-make-heading-function | |
384 (+ depth (- (gametree-current-branch-ply) plys)))) | |
385 (gametree-prettify-heading)))) | |
386 | |
387 (defun gametree-merge-line () | |
388 "Merges a variation with its only child. | |
389 Does *not* check if the variation has in fact a unique child; users beware." | |
390 (interactive) | |
391 (if (zerop (gametree-current-branch-depth)) | |
392 (outline-up-heading 0)) | |
393 (end-of-line 1) | |
394 (let ((prev-depth (save-excursion (forward-line 1) | |
395 (gametree-current-branch-depth)))) | |
396 (delete-char (1+ prev-depth)) | |
397 (if (zerop prev-depth) | |
398 (save-excursion | |
399 (beginning-of-line 1) | |
400 (delete-char (gametree-current-branch-depth)) | |
401 (gametree-prettify-heading))))) | |
402 | |
403 (defun gametree-layout-to-register (register) | |
404 "Store current tree layout in register REGISTER. | |
405 Use \\[gametree-apply-register-layout] to restore that configuration. | |
406 Argument is a character, naming the register." | |
407 (interactive "cLayout to register: ") | |
408 (save-excursion | |
409 (goto-char (point-min)) | |
410 (set-register register | |
411 (gametree-current-layout 0 t)))) | |
412 | |
413 (defun gametree-apply-register-layout (char) | |
414 "Return to a tree layout stored in a register. | |
415 Argument is a character, naming the register." | |
416 (interactive "cApply layout from register: ") | |
417 (save-excursion | |
418 (goto-char (point-min)) | |
419 (gametree-apply-layout (get-register char) 0 t))) | |
420 | |
421 (defun gametree-save-and-hack-layout () | |
422 "Save the current tree layout and hack the file local variable spec. | |
423 This function saves the current layout in `gametree-local-layout' and, | |
424 if a local file varible specification for this variable exists in the | |
425 buffer, it is replaced by the new value. See the documentation for | |
426 `gametree-local-layout' for more information." | |
427 (interactive) | |
428 (gametree-save-layout) | |
429 (gametree-hack-file-layout) | |
430 nil) | |
431 | |
432 (define-derived-mode gametree-mode outline-mode "GameTree" | |
433 "Major mode for managing game analysis trees. | |
434 Useful to postal and email chess (and, it is hoped, also checkers, go, | |
435 shogi, etc.) players, it is a slightly modified version of Outline mode. | |
436 | |
437 \\{gametree-mode-map}" | |
438 (auto-fill-mode 0) | |
439 (make-variable-buffer-local 'write-contents-hooks) | |
440 (add-hook 'write-contents-hooks 'gametree-save-and-hack-layout)) | |
441 | |
442 ;;;; Key bindings | |
443 | |
444 (define-key gametree-mode-map "\C-c\C-j" 'gametree-break-line-here) | |
445 (define-key gametree-mode-map "\C-c\C-v" 'gametree-insert-new-leaf) | |
446 (define-key gametree-mode-map "\C-c\C-m" 'gametree-merge-line) | |
447 (define-key gametree-mode-map "\C-c\C-r " 'gametree-layout-to-register) | |
448 (define-key gametree-mode-map "\C-c\C-r/" 'gametree-layout-to-register) | |
449 (define-key gametree-mode-map "\C-c\C-rj" 'gametree-apply-register-layout) | |
450 (define-key gametree-mode-map "\C-c\C-y" 'gametree-save-and-hack-layout) | |
451 | |
452 ;;;; Goodies for mousing users | |
453 (and (fboundp 'track-mouse) | |
454 (defun gametree-mouse-break-line-here (event) | |
455 (interactive "e") | |
456 (mouse-set-point event) | |
457 (gametree-break-line-here)) | |
458 (defun gametree-mouse-show-children-and-entry (event) | |
459 (interactive "e") | |
460 (mouse-set-point event) | |
461 (gametree-show-children-and-entry)) | |
462 (defun gametree-mouse-show-subtree (event) | |
463 (interactive "e") | |
464 (mouse-set-point event) | |
465 (show-subtree)) | |
466 (defun gametree-mouse-hide-subtree (event) | |
467 (interactive "e") | |
468 (mouse-set-point event) | |
469 (hide-subtree)) | |
470 (define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] | |
471 'gametree-mouse-break-line-here) | |
472 (define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] | |
473 'gametree-mouse-show-children-and-entry) | |
474 (define-key gametree-mode-map [S-down-mouse-2 S-mouse-2] | |
475 'gametree-mouse-show-subtree) | |
476 (define-key gametree-mode-map [S-down-mouse-3 S-mouse-3] | |
477 'gametree-mouse-hide-subtree)) | |
478 | |
479 (provide 'gametree) | |
480 | |
481 ;;; gametree.el ends here |