| 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) |