;; $Id: gauche-mode.el,v 1.8 2004/05/25 14:26:44 hip Exp $
;; gauche scheme mode
;;
;; .emacs:
;;
;; (autoload 'gauche-mode "gauche-mode" nil t)
;; (let ((spec (assoc "\\.scm\\'" auto-mode-alist)))
;;   (if spec
;;       (rplacd spec 'gauche-mode)
;;     (add-to-list 'auto-mode-alist '("\\.scm$" . gauche-mode))))
;;
;; (defun gauche () (interactive) (run-scheme "gosh"))

(load "r5rs")

(defun gauche-eval-buffer ()
  "Evaluate the buffer with gosh"
  (interactive)
  (shell-command-on-region (point-min) (point-max) "gosh"))

(defun gauche-info ()
  (interactive)
  (info "gauche-refe"))

(defun gauche-info-index (topic)
  (interactive
   (list (read-string
	  (concat "Gauche info lookup: ")
          (current-word))))
  (info "gauche-refe")
  (Info-index topic))

(defun r5rs-info-index (topic)
  (interactive
   (list (read-string
	  (concat "R5RS info lookup: ")
          (current-word))))
  (info "r5rs")
  (Info-index topic))

;; ((gauche-form number-of-special-subforms) ...)
(defvar gauche-extra-syntax
  '((and-let* 1)
    (call-with-input-file 1)
    (call-with-input-string 1)
    (call-with-output-file 1)
    (call-with-output-string 0)
    (call-with-values 1)
    (dolist 1)
    (dotimes 1)
    (if-match 2)
    (let*-values 1)
    (let-keywords* 2)
    (let-match 2)
    (let-optionals* 2)
    (let-syntax 1)
    (let-values 1)
    (let1 2)
    (letrec-syntax 1)
    (make 1)
    (match 1)
    (match-define 0)
    (match-lambda 0)
    (match-lambda* 0)
    (match-let 1)
    (match-let* 1)
    (match-let1 2)
    (match-letrec 1)
    (multiple-value-bind 2)
    (parameterize 1)
    (parse-options 1)
    (receive 2)
    (rxmatch-case 1)
    (rxmatch-cond 0)
    (rxmatch-if 2)
    (rxmatch-let 2)
    (syntax-rules 1)
    (unless 1)
    (until 1)
    (when 1)
    (while 1)
    (with-builder 1)
    (with-error-handler 1)
    (with-input-from-string 1)
    (with-iterator 1)
    (with-module 1)))

(define-derived-mode gauche-mode scheme-mode "gauche"
  ;; indentation:
  ;; (put 'form 'scheme-indent-function number-of-special-subforms)
  (dolist (syn gauche-extra-syntax)
    (put (car syn) 'scheme-indent-function (cadr syn)))
  ;; font-lock
  (font-lock-add-keywords
   'gauche-mode
   (eval-when-compile
     (list
      ;; gauche-specific forms from the indent list
      (cons (concat "(" (regexp-opt (mapcar (lambda (x)
                                              (symbol-name (car x)))
                                            gauche-extra-syntax) t)
                    "\\>") 1)
      ;; additional gauche-specific forms
      (cons (concat "("
                    (regexp-opt
                     '("use" "select-module" "export" "export-all" "import"
                       "extend" "define-in-module" "define-constant"
                       "define-values") t)
                    "\\>") 1)
      ;; r5rs-standard-procedures
      (cons (concat "(" (regexp-opt (mapcar 'symbol-name
                                            r5rs-standard-procedures) t)
                    "\\>") '(1 font-lock-variable-name-face))
      ;; regular expressions
      '("#/.*?/" (0 font-lock-builtin-face t))
      ;; string interpolation variables
      '(",|.*?|" (0 font-lock-variable-name-face t)))))

  ;; keymap
  (define-key gauche-mode-map [(control c) (control c)] 'comment-region)
  (define-key gauche-mode-map [(meta return)] 'gauche-eval-buffer)
  (define-key gauche-mode-map [(control c) (control i)] 'gauche-info)
  (define-key gauche-mode-map [(control c) (control s)] 'gauche-info-index)
  (define-key gauche-mode-map [(control c) (control r)] 'r5rs-info-index))