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