Commit | Line | Data |
---|---|---|
7eeb782e AT |
1 | ;; This file is distributed with GNU Go, a Go program. |
2 | ;; | |
3 | ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005. 2006 | |
4 | ;; 2007, 2008 and 2009 by the Free Software Foundation. | |
5 | ;; | |
6 | ;; This program is free software; you can redistribute it and/ | |
7 | ;; modify it under the terms of the GNU General Public License | |
8 | ;; as published by the Free Software Foundation - version 3 | |
9 | ;; or (at your option) any later version. | |
10 | ;; | |
11 | ;; This program is distributed in the hope that it will be | |
12 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied | |
13 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR | |
14 | ;; PURPOSE. See the GNU General Public License in file COPYIN | |
15 | ;; for more details. | |
16 | ;; | |
17 | ;; You should have received a copy of the GNU General Public | |
18 | ;; License along with this program; if not, write to the Free | |
19 | ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
20 | ;; Boston, MA 02111, USA. | |
21 | ||
22 | ||
23 | ;; GNU Emacs mode for editing pattern database files. | |
24 | ;; | |
25 | ;; Put this file to emacs/site-lisp directory and add | |
26 | ;; | |
27 | ;; (require 'gnugo-db) | |
28 | ;; | |
29 | ;; to your ~/.emacs file. If you want gnugo-db-mode to be selected | |
30 | ;; automatically for every .db file, add these lines also: | |
31 | ;; | |
32 | ;; (setq auto-mode-alist | |
33 | ;; (append | |
34 | ;; auto-mode-alist | |
35 | ;; '(("\\.db\\'" . gnugo-db-mode)))) | |
36 | ||
37 | ||
38 | (defvar gnugo-db-mode-map nil) | |
39 | (unless gnugo-db-mode-map | |
40 | (setq gnugo-db-mode-map (make-sparse-keymap)) | |
41 | (define-key gnugo-db-mode-map "\C-c\C-p" 'gnugo-db-insert-pattern) | |
42 | (define-key gnugo-db-mode-map "\C-c\C-c" | |
43 | 'gnugo-db-copy-main-diagram-to-constraint)) | |
44 | ||
45 | (defvar gnugo-db-mode-abbrev-table nil) | |
46 | (define-abbrev-table 'gnugo-db-mode-abbrev-table ()) | |
47 | ||
48 | (defvar gnugo-db-mode-syntax-table nil) | |
49 | (unless gnugo-db-mode-syntax-table | |
50 | (setq gnugo-db-mode-syntax-table (make-syntax-table)) | |
51 | (modify-syntax-entry ?\# "<" gnugo-db-mode-syntax-table) | |
52 | (modify-syntax-entry ?\n ">#" gnugo-db-mode-syntax-table)) | |
53 | ||
54 | (defvar gnugo-db-font-lock-keywords (list "Pattern" | |
55 | "goal_elements" | |
56 | "callback_data" | |
57 | "attribute_map")) | |
58 | ||
59 | ||
60 | (defun gnugo-db-mode() | |
61 | "Major mode for editing pattern database files." | |
62 | (interactive) | |
63 | (kill-all-local-variables) | |
64 | (use-local-map gnugo-db-mode-map) | |
65 | (setq local-abbrev-table gnugo-db-mode-abbrev-table) | |
66 | (set-syntax-table gnugo-db-mode-syntax-table) | |
67 | (set (make-local-variable 'paragraph-start) "Pattern") | |
68 | (set (make-local-variable 'paragraph-separate) paragraph-start) | |
69 | (set (make-local-variable 'comment-start) "# ") | |
70 | (set (make-local-variable 'comment-end) "") | |
71 | (set (make-local-variable 'comment-start-skip) "#+ *") | |
72 | (setq font-lock-defaults '(gnugo-db-font-lock-keywords nil nil ((?_ . "w")))) | |
73 | (set (make-local-variable 'indent-line-function) 'gnugo-db-indent-line) | |
74 | (set (make-local-variable 'indent-region-function) 'gnugo-db-indent-region) | |
75 | (setq mode-name "GNU Go pattern database") | |
76 | (setq major-mode 'gnugo-db-mode)) | |
77 | ||
78 | ||
79 | (defun gnugo-db-indent-line(&optional indenting-region) | |
80 | "Indents a line of a constraint or main diagram line with comment." | |
81 | (let ((return-point (point))) | |
82 | (beginning-of-line) | |
83 | (let ((line-beginning (point)) | |
84 | (first-char (char-after))) | |
85 | (unless (= first-char ?\;) | |
86 | (forward-line -1) | |
87 | (when (= (char-after) ?\;) | |
88 | (setq first-char ?\;))) | |
89 | ||
90 | (let* ((column) | |
91 | (indentation | |
92 | (if (= first-char ?\;) | |
93 | (progn | |
94 | (while (and (= (char-after) ?\;) | |
95 | (= (forward-line -1) 0))) | |
96 | (let ((paren-stack ())) | |
97 | (while (search-forward-regexp "[][()]" line-beginning t) | |
98 | (let ((char (char-before))) | |
99 | (if (memq char '(?\( ?\[)) | |
100 | (push (list char (current-column)) paren-stack) | |
101 | (let ((pop-paren (cond ((= char ?\)) ?\() | |
102 | ((= char ?\]) ?\[)))) | |
103 | (while (not (= (car (pop paren-stack)) pop-paren)) | |
104 | ()))))) | |
105 | (goto-char line-beginning) | |
106 | (setq column (if paren-stack | |
107 | (cadr (car paren-stack)) | |
108 | 2))) | |
109 | (concat ";" | |
110 | (make-string (/ column tab-width) ?\t) | |
111 | (make-string (if (< column tab-width) | |
112 | (1- column) | |
113 | (% column tab-width)) | |
114 | ? ))) | |
115 | ||
116 | (goto-char line-beginning) | |
117 | (if (memq first-char '(?- ?+ ?| ?. ?X ?O ?x ?o | |
118 | ?, ?! ?* ?? ?Y ?Q)) | |
119 | (progn | |
120 | (let ((diagram-width 0)) | |
121 | (while (not (memq (char-after) '(? ?\t ?\n nil))) | |
122 | (setq diagram-width (1+ diagram-width)) | |
123 | (forward-char)) | |
124 | (if (< diagram-width 8) | |
125 | (progn (setq column 12) | |
126 | "\t ") | |
127 | (setq column (+ diagram-width 4)) | |
128 | " "))) | |
129 | nil)))) | |
130 | ||
131 | (when indentation | |
132 | (let ((indentation-point (point)) | |
133 | (indentation-length (length indentation)) | |
134 | (matched 0)) | |
135 | (while (and (< matched indentation-length) | |
136 | (eq (char-after) (aref indentation matched))) | |
137 | (setq matched (1+ matched)) | |
138 | (forward-char)) | |
139 | (while (memq (char-after) '(? ?\t)) | |
140 | (forward-char)) | |
141 | (unless (or (= (current-column) column) | |
142 | (and indenting-region (memq (char-after) '(?\n nil)))) | |
143 | (setq return-point (+ return-point | |
144 | indentation-length | |
145 | (- indentation-point (point)))) | |
146 | (delete-region (+ indentation-point matched) (point)) | |
147 | (when (< matched indentation-length) | |
148 | (insert (substring indentation matched)))) | |
149 | (when (< return-point (point)) | |
150 | (setq return-point (point))))))) | |
151 | ||
152 | (goto-char return-point))) | |
153 | ||
154 | ||
155 | (defun gnugo-db-indent-region(start end) | |
156 | "Indents a region. Indents in the same way as `gnugo-db-indent-line'." | |
157 | (interactive "r") | |
158 | (save-excursion | |
159 | (setq end (copy-marker end)) | |
160 | (goto-char start) | |
161 | (while (< (point) end) | |
162 | (or (and (bolp) (eolp)) | |
163 | (gnugo-db-indent-line t)) | |
164 | (forward-line)) | |
165 | (move-marker end nil))) | |
166 | ||
167 | ||
168 | (defun gnugo-db-insert-pattern() | |
169 | "Inserts a new pattern after the current one. Tries to pick up a | |
170 | suitable name by incrementing numeric part of the previous pattern | |
171 | name. | |
172 | ||
173 | This function heavily depends on correctness of the current pattern." | |
174 | (interactive) | |
175 | (let ((first-name "") | |
176 | (middle-name "") | |
177 | (last-name "")) | |
178 | (end-of-line) | |
179 | (if (re-search-backward "^Pattern " 0 t) | |
180 | (progn | |
181 | (forward-char 8) | |
182 | (when (looking-at "\\([^0-9]+\\)\\([0-9]*\\)\\(.*\\)") | |
183 | (setq first-name (match-string-no-properties 1) | |
184 | middle-name (match-string-no-properties 2) | |
185 | last-name (match-string-no-properties 3))) | |
186 | (re-search-forward "^:" (1+ (buffer-size)) t) | |
187 | (backward-char) | |
188 | (forward-line 2) | |
189 | (unless (memq (char-after) '(?\n ? ?\t)) | |
190 | (re-search-forward "^[;>]" (1+ (buffer-size)) t) | |
191 | (backward-char) | |
192 | (while (looking-at "[;>]") | |
193 | (forward-line)) | |
194 | (forward-line) | |
195 | (when (looking-at "[;>]") | |
196 | (while (looking-at "[;>]") | |
197 | (forward-line)) | |
198 | (forward-line))) | |
199 | (when (= (forward-line) 1) | |
200 | (end-of-line) | |
201 | (insert "\n"))) | |
202 | (re-search-forward "^Pattern " (1+ (buffer-size)) t) | |
203 | (beginning-of-line)) | |
204 | ||
205 | (insert "Pattern \n") | |
206 | (let ((move-to-point (1- (point)))) | |
207 | (unless (string= first-name "") | |
208 | (let ((pattern-name | |
209 | (if (string= last-name "") | |
210 | (concat first-name | |
211 | (number-to-string (1+ (string-to-number middle-name)))) | |
212 | (concat first-name middle-name | |
213 | (char-to-string (1+ (string-to-char last-name))))))) | |
214 | (when (string= last-name "") | |
215 | (when (save-excursion | |
216 | (re-search-forward "^Pattern " (1+ (buffer-size)) t) | |
217 | (or (looking-at pattern-name) | |
218 | (looking-at (concat first-name middle-name)))) | |
219 | (setq pattern-name (concat first-name middle-name "a")))) | |
220 | (backward-char) | |
221 | (insert pattern-name) | |
222 | (forward-char))) | |
223 | (insert "\n") | |
224 | (unless (string= first-name "") | |
225 | (setq move-to-point (point))) | |
226 | (insert "\n\n:\n\n\n") | |
227 | (goto-char move-to-point)))) | |
228 | ||
229 | ||
230 | (defun gnugo-db-copy-main-diagram-to-constraint() | |
231 | "Copies pattern diagram to constraint and inserts a dummy constraint line" | |
232 | (interactive) | |
233 | (let ((start-point (point))) | |
234 | (end-of-line) | |
235 | (unless (re-search-backward "^Pattern " 0 t) | |
236 | (re-search-forward "^Pattern" (1+ (buffer-size)) t) | |
237 | (beginning-of-line)) | |
238 | ||
239 | (forward-line) | |
240 | (while (not (looking-at "[-+|.XOxo,!*?YQ]")) | |
241 | (forward-line)) | |
242 | ||
243 | (let ((diagram-beginning (point))) | |
244 | (while (looking-at "[-+|.XOxo,!*?YQ]") | |
245 | (forward-line)) | |
246 | ||
247 | (let ((diagram (buffer-substring diagram-beginning (point)))) | |
248 | (re-search-forward "^:" (1+ (buffer-size)) t) | |
249 | (backward-char) | |
250 | (forward-line) | |
251 | (while (looking-at "#") | |
252 | (forward-line)) | |
253 | (when (memq (char-after) '(?\n ? ?\t)) | |
254 | (forward-line)) | |
255 | ||
256 | (when (looking-at "[-+|.XOxo,!*?YQ;>]") | |
257 | (goto-char start-point) | |
258 | (error "Pattern already seems to have a constraint")) | |
259 | ||
260 | (let ((constraint-diagram-beginning (point))) | |
261 | (insert diagram) | |
262 | (let ((constraint-diagram-end (point))) | |
263 | (goto-char constraint-diagram-beginning) | |
264 | (while (not (= (point) constraint-diagram-end)) | |
265 | (while (not (memq (char-after) '(?\n ? ?\t))) | |
266 | (forward-char)) | |
267 | (unless (= (char-after) ?\n) | |
268 | (let ((diagram-line-end (point))) | |
269 | (end-of-line) | |
270 | (setq constraint-diagram-end | |
271 | (- constraint-diagram-end (- (point) diagram-line-end))) | |
272 | (delete-region diagram-line-end (point)))) | |
273 | (forward-char)) | |
274 | ||
275 | (insert "\n; \n\n") | |
276 | (goto-char constraint-diagram-beginning))))))) | |
277 | ||
278 | ||
279 | (provide 'gnugo-db) |