;;; chip-mode.el --- Major mode for editing and executing prolog chip code.

;; Copyright (C) 1998, 2001 Stéphane Levant <sun@tuxfamily.org>

;; Author: Stéphane Levant <sun@tuxfamily.org>
;; Created: 1998
;; Keywords: languages
;; Version: 1.1
;; URL: http://arsunik.free.fr/emacs

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file 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 for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Major mode for editing and executing chip code.

;;; Code:

;; inspired from prolog.el


(defvar chip-mode-syntax-table nil)
(defvar chip-mode-abbrev-table nil)
(defvar chip-mode-map nil)

(defgroup chip nil
  "Major mode for editing and running Chip under Emacs"
  :group 'languages)

(defcustom chip-program-name "chip"
  "*Program name for invoking an inferior Chip with `run-chip'."
  :type 'string
  :group 'chip)

(defcustom chip-indent-width -2
  "Level of indentation in Chip buffers."
  :type 'integer
  :group 'chip)

(defcustom chip-window-height nil
  "Size of Compilation Windows in chip"
  :group 'chip)

(defvar chip-font-lock-keywords
  '(("^\\([A-Za-z0-9_]+\\)\\(\\s *(\\([^)]*\\|\n\\))\\)?\\(\\s \\|\n\\)*\\(:-\\|\\.\\)"
     1 font-lock-function-name-face)
    ("\\(\\b\\([A-Z][A-Za-z0-9_]*\\)\\b\\|\\[.*\\]\\)\\s *\\(::\\)\\s *\\([0-9]+..[0-9]+\\)"
     (1 font-lock-variable-name-face)
     (3 font-lock-keyword-face)
     (4 font-lock-constant-face))
    ("\\b\\(\\([A-Z][A-Za-z0-9_]*\\)\\)\\b\\s *\\([#^]\\\\?[=]\\)"
     (1 font-lock-variable-name-face)
     (3 font-lock-keyword-face))
    ("\\<\\(scanf\\|get0\\|abort\\|in\\|if\\|then\\|else\\|not\
\\|delete\\|length\\|min_max\\|sleep\
\\|alldifferent\\|labeling\\|append\\|member\\|indomain\\|label\\)\\>"
     1 font-lock-keyword-face)
    ("[-,; \n\t]\\(!\\)[.,; \n\t]" 1 font-lock-keyword-face)
    ("\\<\\(most_constrained\\|first_fail\\|smallest\\|largest\\|max_regret\\)\\>" 1 font-lock-constant-face)
    ))

(defvar chip-menu
  '("Chip"
    ["Start Chip" run-chip t]
    ["Switch to \"*chip*\" Buffer" chip-display-chip (get-buffer "*chip*")]
    ["Stop Chip" chip-quit t]
    ["-" ignore nil]
    ["Reconsult File" chip-reconsult-fichier t]
    ["Run Current Line" chip-send-line t]
    ["Run Current Definition" chip-send-definition t]
    ["Run Region" chip-send-region
     (condition-case () (mark) (error nil))]
    ["Next Solution" chip-next-answer t]
    ["End of Solutions" chip-end-answer t]
;     ["--" ignore nil]
;     ["Help" chip-help t]
    ))

(defun chip-display-chip ()
  (interactive)
  (let* ((w (display-buffer "*scratch*"))
	 (h (window-height w)))
    (if (and chip-window-height (> h chip-window-height))
	(enlarge-window (- h chip-window-height)))))

(if chip-mode-syntax-table
    ()
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?_ "w" table)
    (modify-syntax-entry ?\\ "\\" table)
    (modify-syntax-entry ?+ "." table)
    (modify-syntax-entry ?- "." table)
    (modify-syntax-entry ?= "." table)
    (modify-syntax-entry ?< "." table)
    (modify-syntax-entry ?> "." table)
    (modify-syntax-entry ?\' "\"" table)
    (modify-syntax-entry ?/ ". 14b" table)
    (modify-syntax-entry ?* ". 23b" table)
    (modify-syntax-entry ?% "<" table)
    (modify-syntax-entry ?\n ">" table)
    (setq chip-mode-syntax-table table)))

(define-abbrev-table 'chip-mode-abbrev-table ())

(defun chip-mode-variables ()
  (set-syntax-table chip-mode-syntax-table)
  (setq local-abbrev-table chip-mode-abbrev-table)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "%%\\|$\\|" page-delimiter)) ;'%%..'
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (setq paragraph-ignore-fill-prefix t)
  (make-local-variable 'imenu-generic-expression)
  (setq imenu-generic-expression "^[a-z][a-zA-Z0-9_]+")
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'chip-indent-line)
  (make-local-variable 'comment-start)
  (setq comment-start "%")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "%+ *")
  (make-local-variable 'comment-column)
  (setq comment-column 48)
  (make-local-variable 'comment-indent-function)
  (setq comment-indent-function 'chip-comment-indent)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(chip-font-lock-keywords nil nil nil)))

(defun chip-mode-commands (map)
  (define-key map "\t" 'chip-indent-line)
  (define-key map "\C-c\C-q" 'chip-quit)
  (define-key map "\C-x\C-e" 'chip-send-line)
  (define-key map "\C-c\C-c" 'chip-send-region)
  (define-key map "\C-c\C-s" 'run-chip)
  (define-key map "\C-c\C-b" 'chip-display-chip)
  (define-key map "\e\C-x" 'chip-send-definition)
  (if (not (lookup-key map [(control ?\;)]))
      (define-key map [(control ?\;)] 'chip-next-answer))
  (if (not (lookup-key map [(control ?\.)]))
      (define-key map [(control ?\.)] 'chip-end-answer))
  (define-key map [(control c) (control ?\;)] 'chip-next-answer)
  (define-key map [(control c) (control ?\.)] 'chip-end-answer)
  (define-key map "\C-c\C-r" 'chip-reconsult-fichier))

(if chip-mode-map
    nil
  (setq chip-mode-map (make-sparse-keymap))
  (chip-mode-commands chip-mode-map)
  (easy-menu-define
   chip-easy-menu chip-mode-map "Menu for Chip mode." chip-menu))

;;;###autoload
(defun chip-mode ()
  "Major mode for editing Chip code for Chips.
Blank lines and `%%...' separate paragraphs.  `%'s start comments.
Commands:
\\{chip-mode-map}
Entry to this mode calls the value of `chip-mode-hook'
if that value is non-nil."
  (interactive)
  (kill-all-local-variables)
  (use-local-map chip-mode-map)
  (setq major-mode 'chip-mode)
  (setq mode-name "Chip")
  (chip-mode-variables)
  (run-hooks 'chip-mode-hook))

(defun chip-indent-line (&optional whole-exp)
  "Indent current line as Chip code.
With argument, indent any additional lines of the same clause
rigidly along with this one (not yet)."
  (interactive "p")
  (let ((indent (chip-indent-level))
	(pos (- (point-max) (point))) beg)
    (beginning-of-line)
    (setq beg (point))
    (skip-chars-forward " \t")
    (if (zerop (- indent (current-column)))
	nil
      (delete-region beg (point))
      (indent-to indent))
    (if (> (- (point-max) pos) (point))
	(goto-char (- (point-max) pos)))
    ))

(defun chip-indent-level ()
  "Compute chip indentation level."
  (save-excursion
    (beginning-of-line)
    (skip-chars-forward " \t")
    (cond
     ((looking-at "%%%") 0)		;Large comment starts
     ((looking-at "%[^%]") comment-column) ;Small comment starts
     ((bobp) 0)				;Beginning of buffer
     (t
      (let ((empty t) ind more less)
	(if (looking-at ")")
	    (setq less t)		;Find close
	  (setq less nil))
	;; See previous indentation
	(while empty
	  (forward-line -1)
	  (beginning-of-line)
 	  (if (bobp)
 	      (setq empty nil)
 	    (skip-chars-forward " \t")
 	    (if (not (or (looking-at "%[^%]") (looking-at "\n")))
 		(setq empty nil))))
 	(if (bobp)
 	    (setq ind 0)		;Beginning of buffer
	  (setq ind (current-column)))	;Beginning of clause
	;; See its beginning
	(if (looking-at "%%[^%]")
	    ind
	  ;; Real chip code
	  (if (looking-at "(")
	      (setq more t)		;Find open
	    (setq more nil))
	  ;; See its tail
	  (end-of-chip-clause)
	  (or (bobp) (forward-char -1))
	  (cond ((looking-at "[,(;>]")
		 (if (and more (looking-at "[^,]"))
		     (+ ind chip-indent-width) ;More indentation
		   (max tab-width ind))) ;Same indentation
		((looking-at "-") tab-width) ;TAB
		((or less (looking-at "[^.]"))
		 (max (- ind chip-indent-width) 0)) ;Less indentation
		(t 0))			;No indentation
	  )))
     )))

(defun end-of-chip-clause ()
  "Go to end of clause in this line."
  (beginning-of-line 1)
  (let* ((eolpos (save-excursion (end-of-line) (point))))
    (if (re-search-forward comment-start-skip eolpos 'move)
	(goto-char (match-beginning 0)))
    (skip-chars-backward " \t")))

(defun chip-comment-indent ()
  "Compute chip comment indentation."
  (cond ((looking-at "%%%") 0)
	((looking-at "%%") (chip-indent-level))
	(t
	 (save-excursion
	       (skip-chars-backward " \t")
	       ;; Insert one space at least, except at left margin.
	       (max (+ (current-column) (if (bolp) 0 1))
		    comment-column)))
	))


;;;
;;; Inferior chip mode
;;;
(defvar inferior-chip-mode-map nil)

(defun inferior-chip-mode ()
  "Major mode for interacting with an inferior Chip process.

The following commands are available:
\\{inferior-chip-mode-map}

Entry to this mode calls the value of `chip-mode-hook' with no arguments,
if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
`chip-mode-hook' is called after `comint-mode-hook'.

You can send text to the inferior Chip from other buffers
using the commands `send-region', `send-string' and \\[chip-consult-region].

Commands:
Tab indents for Chip; with argument, shifts rest
 of expression rigidly with the current line.
Paragraphs are separated only by blank lines and '%%'.
'%'s start comments.

Return at end of buffer sends line as input.
Return not at end copies rest of line to end and sends it.
\\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
\\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
\\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal."
  (interactive)
  (require 'comint)
  (comint-mode)
  (setq major-mode 'inferior-chip-mode
	mode-name "Inferior Chip"
	comint-prompt-regexp "^[0-9]+[?][-] *"
	)
  (chip-mode-variables)
  (if inferior-chip-mode-map nil
    (setq inferior-chip-mode-map (copy-keymap comint-mode-map))
    (chip-mode-commands inferior-chip-mode-map))
  (use-local-map inferior-chip-mode-map)
  (run-hooks 'chip-mode-hook))

;;;###autoload
(defun run-chip ()
  "Run an inferior Chip process, input and output via buffer *chip*."
  (interactive)
  (require 'comint)
  (set-buffer (get-buffer-create "*chip*"))
  (display-buffer (current-buffer))
  (make-comint "chip" chip-program-name)
  (inferior-chip-mode))


(defun chip-send-region (beg end)
  "Send the region to the inferior Chip, and switch to *chip* buffer.
If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
  (interactive "r")
  (chip-send-string (buffer-substring beg end)))

(defun chip-reconsult-fichier ()
  (interactive)
  (chip-send-string
   (concat "reconsult('" (buffer-file-name) "').")))

(defun chip-send-line ()
  (interactive)
  (chip-send-string (buffer-substring (line-beginning-position)
				      (line-end-position))))

(defun chip-send-definition ()
  (interactive)
  (save-excursion
    (let (pt)
      (beginning-of-line)
      (if (looking-at "[0-9]+[?]- ")
	  (progn
	    (skip-chars-forward "- \t\n.%/*0-9?")
	    (setq pt (point))
	    (search-forward "."))
	(search-forward ".")
	(setq pt (point))
	(backward-char 1)
	(search-backward-regexp "\\(\\`\\|[.%]\\|/[*]\\)")
	(skip-chars-forward "- \t\n.%/*0-9?"))
;      (insert (concat "*" (buffer-substring pt (point)) "\n*")))))
      (chip-send-string (buffer-substring pt (point))))))

(defun chip-next-answer ()
  (interactive)
  (chip-send-string ";"))

(defun chip-end-answer ()
  (interactive)
  (chip-send-string "."))

(defun chip-quit ()
  (interactive)
  (chip-send-string "\C-chalt."))

(defun chip-send-string (string)
    (set-buffer (get-buffer-create "*chip*"))
    (goto-char (point-max))
    (let ((s string))
      (while (equal (substring s -1) "\n")
	(setq s (substring s 0 -1)))
      (insert s)
      (comint-send-input)))

;;; chip-mode.el ends here