Updated README: Equal sign not required with `--mode` flag.

[sgk-go] / patterns / gnugo-db.el

;; 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
;; for more details.
;;
;; 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
;;
;;	(require 'gnugo-db)
;;
;; to your ~/.emacs file. If you want gnugo-db-mode to be selected
;; automatically for every .db file, add these lines also:
;;
;;	(setq auto-mode-alist
;;	      (append
;;	       auto-mode-alist
;;	       '(("\\.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"
					  "goal_elements"
					  "callback_data"
					  "attribute_map"))


(defun gnugo-db-mode()
  "Major mode for editing pattern database files."
  (interactive)
  (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)))
    (beginning-of-line)
    (let ((line-beginning (point))
	  (first-char (char-after)))
      (unless (= first-char ?\;)
	(forward-line -1)
	(when (= (char-after) ?\;)
	  (setq first-char ?\;)))

      (let* ((column)
	     (indentation
	      (if (= first-char ?\;)
		  (progn
		    (while (and (= (char-after) ?\;)
				(= (forward-line -1) 0)))
		    (let ((paren-stack ()))
		      (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 ?\)) ?\()
						   ((= char ?\]) ?\[))))
			      (while (not (= (car (pop paren-stack)) pop-paren))
				())))))
		      (goto-char line-beginning)
		      (setq column (if paren-stack
				       (cadr (car paren-stack))
				     2)))
		    (concat ";"
			    (make-string (/ column tab-width) ?\t)
			    (make-string (if (< column tab-width)
					     (1- column)
					   (% column tab-width))
					 ? )))

		(goto-char line-beginning)
		(if (memq first-char '(?- ?+ ?| ?. ?X ?O ?x ?o
					  ?, ?! ?* ?? ?Y ?Q))
		    (progn
		      (let ((diagram-width 0))
			(while (not (memq (char-after) '(?  ?\t ?\n nil)))
			  (setq diagram-width (1+ diagram-width))
			  (forward-char))
			(if (< diagram-width 8)
			    (progn (setq column 12)
				   "\t    ")
			  (setq column (+ diagram-width 4))
			  "    ")))
		  nil))))

	(when indentation
	  (let ((indentation-point (point))
		(indentation-length (length indentation))
		(matched 0))
	    (while (and (< matched indentation-length)
			(eq (char-after) (aref indentation matched)))
	      (setq matched (1+ matched))
	      (forward-char))
	    (while (memq (char-after) '(?  ?\t))
	      (forward-char))
	    (unless (or (= (current-column) column)
			(and indenting-region (memq (char-after) '(?\n nil))))
	      (setq return-point (+ return-point
				    indentation-length
				    (- 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'."
  (interactive "r")
  (save-excursion
    (setq end (copy-marker end))
    (goto-char start)
    (while (< (point) end)
      (or (and (bolp) (eolp))
	  (gnugo-db-indent-line t))
      (forward-line))
    (move-marker end nil)))


(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
name.

This function heavily depends on correctness of the current pattern."
  (interactive)
  (let ((first-name "")
	(middle-name "")
	(last-name ""))
    (end-of-line)
    (if (re-search-backward "^Pattern " 0 t)
	(progn
	  (forward-char 8)
	  (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)
	  (backward-char)
	  (forward-line 2)
	  (unless (memq (char-after) '(?\n ?  ?\t))
	    (re-search-forward "^[;>]" (1+ (buffer-size)) t)
	    (backward-char)
	    (while (looking-at "[;>]")
	      (forward-line))
	    (forward-line)
	    (when (looking-at "[;>]")
	      (while (looking-at "[;>]")
		(forward-line))
	      (forward-line)))
	  (when (= (forward-line) 1)
	    (end-of-line)
	    (insert "\n")))
      (re-search-forward "^Pattern " (1+ (buffer-size)) t)
      (beginning-of-line))

    (insert "Pattern \n")
    (let ((move-to-point (1- (point))))
      (unless (string= first-name "")
	(let ((pattern-name
	       (if (string= last-name "")
		   (concat first-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 "")
	    (when (save-excursion
		    (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"))))
	  (backward-char)
	  (insert pattern-name)
	  (forward-char)))
      (insert "\n")
      (unless (string= first-name "")
	(setq move-to-point (point)))
      (insert "\n\n:\n\n\n")
      (goto-char move-to-point))))


(defun gnugo-db-copy-main-diagram-to-constraint()
  "Copies pattern diagram to constraint and inserts a dummy constraint line"
  (interactive)
  (let ((start-point (point)))
    (end-of-line)
    (unless (re-search-backward "^Pattern " 0 t)
      (re-search-forward "^Pattern" (1+ (buffer-size)) t)
      (beginning-of-line))

    (forward-line)
    (while (not (looking-at "[-+|.XOxo,!*?YQ]"))
      (forward-line))

    (let ((diagram-beginning (point)))
      (while (looking-at "[-+|.XOxo,!*?YQ]")
	(forward-line))

      (let ((diagram (buffer-substring diagram-beginning  (point))))
	(re-search-forward "^:" (1+ (buffer-size)) t)
	(backward-char)
	(forward-line)
	(while (looking-at "#")
	  (forward-line))
	(when (memq (char-after) '(?\n ?  ?\t))
	  (forward-line))

	(when (looking-at "[-+|.XOxo,!*?YQ;>]")
	  (goto-char start-point)
	  (error "Pattern already seems to have a constraint"))

	(let ((constraint-diagram-beginning (point)))
	  (insert diagram)
	  (let ((constraint-diagram-end (point)))
	    (goto-char constraint-diagram-beginning)
	    (while (not (= (point) constraint-diagram-end))
	      (while (not (memq (char-after) '(?\n ?  ?\t)))
		(forward-char))
	      (unless (= (char-after) ?\n)
		(let ((diagram-line-end (point)))
		  (end-of-line)
		  (setq constraint-diagram-end
			(- constraint-diagram-end (- (point) diagram-line-end)))
		  (delete-region diagram-line-end (point))))
	      (forward-char))

	    (insert "\n; \n\n")
	    (goto-char constraint-diagram-beginning)))))))


(provide 'gnugo-db)