;; This file is distributed with GNU Go, a Go program.
;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005. 2006
;; 2007, 2008 and 2009 by the Free Software Foundation.
;; This program is free software; you can redistribute it and/
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation - version 3
;; or (at your option) any later version.
;; This program is distributed in the hope that it will be
;; useful, but WITHOUT ANY WARRANTY; without even the implied
;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE. See the GNU General Public License in file COPYIN
;; You should have received a copy of the GNU General Public
;; License along with this program; if not, write to the Free
;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02111, USA.
;; GNU Emacs mode for editing pattern database files.
;; Put this file to emacs/site-lisp directory and add
;; to your ~/.emacs file. If you want gnugo-db-mode to be selected
;; automatically for every .db file, add these lines also:
;; '(("\\.db\\'" . gnugo-db-mode))))
(defvar gnugo-db-mode-map nil)
(unless gnugo-db-mode-map
(setq gnugo-db-mode-map (make-sparse-keymap))
(define-key gnugo-db-mode-map "\C-c\C-p" 'gnugo-db-insert-pattern)
(define-key gnugo-db-mode-map "\C-c\C-c"
'gnugo-db-copy-main-diagram-to-constraint))
(defvar gnugo-db-mode-abbrev-table nil)
(define-abbrev-table 'gnugo-db-mode-abbrev-table ())
(defvar gnugo-db-mode-syntax-table nil)
(unless gnugo-db-mode-syntax-table
(setq gnugo-db-mode-syntax-table (make-syntax-table))
(modify-syntax-entry ?\# "<" gnugo-db-mode-syntax-table)
(modify-syntax-entry ?\n ">#" gnugo-db-mode-syntax-table))
(defvar gnugo-db-font-lock-keywords (list "Pattern"
"Major mode for editing pattern database files."
(kill-all-local-variables)
(use-local-map gnugo-db-mode-map)
(setq local-abbrev-table gnugo-db-mode-abbrev-table)
(set-syntax-table gnugo-db-mode-syntax-table)
(set (make-local-variable 'paragraph-start) "Pattern")
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'comment-start) "# ")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-start-skip) "#+ *")
(setq font-lock-defaults '(gnugo-db-font-lock-keywords nil nil ((?_ . "w"))))
(set (make-local-variable 'indent-line-function) 'gnugo-db-indent-line)
(set (make-local-variable 'indent-region-function) 'gnugo-db-indent-region)
(setq mode-name "GNU Go pattern database")
(setq major-mode 'gnugo-db-mode))
(defun gnugo-db-indent-line(&optional indenting-region)
"Indents a line of a constraint or main diagram line with comment."
(let ((return-point (point)))
(let ((line-beginning (point))
(first-char (char-after)))
(unless (= first-char ?\;)
(when (= (char-after) ?\;)
(while (and (= (char-after) ?\;)
(= (forward-line -1) 0)))
(while (search-forward-regexp "[][()]" line-beginning t)
(let ((char (char-before)))
(if (memq char '(?\( ?\[))
(push (list char (current-column)) paren-stack)
(let ((pop-paren (cond ((= char ?\)) ?\()
(while (not (= (car (pop paren-stack)) pop-paren))
(goto-char line-beginning)
(setq column (if paren-stack
(make-string (/ column tab-width) ?\t)
(make-string (if (< column tab-width)
(goto-char line-beginning)
(if (memq first-char '(?- ?+ ?| ?. ?X ?O ?x ?o
(while (not (memq (char-after) '(? ?\t ?\n nil)))
(setq diagram-width (1+ diagram-width))
(setq column (+ diagram-width 4))
(let ((indentation-point (point))
(indentation-length (length indentation))
(while (and (< matched indentation-length)
(eq (char-after) (aref indentation matched)))
(setq matched (1+ matched))
(while (memq (char-after) '(? ?\t))
(unless (or (= (current-column) column)
(and indenting-region (memq (char-after) '(?\n nil))))
(setq return-point (+ return-point
(- indentation-point (point))))
(delete-region (+ indentation-point matched) (point))
(when (< matched indentation-length)
(insert (substring indentation matched))))
(when (< return-point (point))
(setq return-point (point)))))))
(goto-char return-point)))
(defun gnugo-db-indent-region(start end)
"Indents a region. Indents in the same way as `gnugo-db-indent-line'."
(setq end (copy-marker end))
(gnugo-db-indent-line t))
(defun gnugo-db-insert-pattern()
"Inserts a new pattern after the current one. Tries to pick up a
suitable name by incrementing numeric part of the previous pattern
This function heavily depends on correctness of the current pattern."
(if (re-search-backward "^Pattern " 0 t)
(when (looking-at "\\([^0-9]+\\)\\([0-9]*\\)\\(.*\\)")
(setq first-name (match-string-no-properties 1)
middle-name (match-string-no-properties 2)
last-name (match-string-no-properties 3)))
(re-search-forward "^:" (1+ (buffer-size)) t)
(unless (memq (char-after) '(?\n ? ?\t))
(re-search-forward "^[;>]" (1+ (buffer-size)) t)
(while (looking-at "[;>]")
(when (looking-at "[;>]")
(while (looking-at "[;>]")
(when (= (forward-line) 1)
(re-search-forward "^Pattern " (1+ (buffer-size)) t)
(let ((move-to-point (1- (point))))
(unless (string= first-name "")
(if (string= last-name "")
(number-to-string (1+ (string-to-number middle-name))))
(concat first-name middle-name
(char-to-string (1+ (string-to-char last-name)))))))
(when (string= last-name "")
(re-search-forward "^Pattern " (1+ (buffer-size)) t)
(or (looking-at pattern-name)
(looking-at (concat first-name middle-name))))
(setq pattern-name (concat first-name middle-name "a"))))
(unless (string= first-name "")
(setq move-to-point (point)))
(goto-char move-to-point))))
(defun gnugo-db-copy-main-diagram-to-constraint()
"Copies pattern diagram to constraint and inserts a dummy constraint line"
(let ((start-point (point)))
(unless (re-search-backward "^Pattern " 0 t)
(re-search-forward "^Pattern" (1+ (buffer-size)) t)
(while (not (looking-at "[-+|.XOxo,!*?YQ]"))
(let ((diagram-beginning (point)))
(while (looking-at "[-+|.XOxo,!*?YQ]")
(let ((diagram (buffer-substring diagram-beginning (point))))
(re-search-forward "^:" (1+ (buffer-size)) t)
(when (memq (char-after) '(?\n ? ?\t))
(when (looking-at "[-+|.XOxo,!*?YQ;>]")
(error "Pattern already seems to have a constraint"))
(let ((constraint-diagram-beginning (point)))
(let ((constraint-diagram-end (point)))
(goto-char constraint-diagram-beginning)
(while (not (= (point) constraint-diagram-end))
(while (not (memq (char-after) '(?\n ? ?\t)))
(unless (= (char-after) ?\n)
(let ((diagram-line-end (point)))
(setq constraint-diagram-end
(- constraint-diagram-end (- (point) diagram-line-end)))
(delete-region diagram-line-end (point))))
(goto-char constraint-diagram-beginning)))))))