my-gauche.el

;;;
;;;   skimu の .emacs を晒します。
;;;
(setq scheme-program-name "gosh -i")

;;
;; C-c C-f で Web 版のマニュアル(あるいは schemexref)を引く、
;;
;(setq gauche-man-base "http://practical-scheme.net/wiliki/schemexref.cgi?")
 (setq gauche-man-base "http://practical-scheme.net/gauche/man/?l=en&p=")

(defun gauche-man ()
  (interactive)
  (let ((key (if (use-region-p)
                 (buffer-substring-no-properties
                  (region-beginning)
                  (region-end))
               (thing-at-point 'symbol))))
    (browse-url (concat gauche-man-base key))))

;;
;; C-x C-e でカーソルの手前にある S-式を gosh に送る。
;; C-u C-x C-e で結果をインサート。
;;
(defun my-scheme-send-last-sexp (arg)
  "Send the previous sexp to the inferior Scheme process."
  (interactive "P")
  (if (null arg)
      (scheme-send-region (save-excursion (backward-sexp) (point))
                          (point))
    (scheme-send-region-and-insert (save-excursion (backward-sexp) (point))
                                   (point))))

(setq my-last-scheme-output nil)

(defun scheme-send-region-and-insert (start end)
  "Send the current region to the inferior Scheme process."
  (interactive "r")
  (setq my-last-scheme-output nil)
  (comint-send-region (scheme-proc) start end)
  (comint-send-string (scheme-proc) "\n")
  (accept-process-output (scheme-proc))
  (while (accept-process-output (scheme-proc) 0.2))
  (let ((string (apply 'concat (reverse my-last-scheme-output))))
    (insert (substring string 0 (- (length string) 7))) ; "\ngosh> "
    ))

(defun my-scheme-output-filter (string)
  (setq my-last-scheme-output
        (cons string my-last-scheme-output))
  string)

(add-hook 'comint-output-filter-functions 'my-scheme-output-filter)
(add-hook 'inferior-scheme-mode-hook
          (function
           (lambda ()
             (define-key scheme-mode-map "\C-c\C-c" 'compile)
             (define-key scheme-mode-map "\C-x\C-e" 'my-scheme-send-last-sexp))))
(add-hook 'scheme-mode-hook
          (function
           (lambda ()
             (define-key scheme-mode-map "\C-c\C-c" 'compile)
             (define-key scheme-mode-map "\C-c\C-f" 'gauche-man))))

;;
;; インデント
;; WiLiKi (http://practical-scheme.net/wiliki/wiliki.cgi?Gauche%3AEditingWithEmacs)
;; にあったものをカスタマイズ。
;;
(dolist (x '(
             (and-let* 1)                   ; srfi-2
             (begin0   0)                   ; MzScheme Gauche
             (call-with-input-file 1)
             (call-with-input-file/column 1)
             (call-with-input-process 1)    ; Gauche
             (call-with-input-port/column 1)
             (call-with-input-string 1)
             (call-with-mirroring-input 2)
             (call-with-mirroring-output 2)
             (call-with-output-file 1)
             (call-with-output-string 0)
             (call-with-process-io 1)       ; Gauche
             (call-with-values 1)
             (dolist 1)                     ;
             (dotimes 1)                    ; STk, Gauche (CommonLisp)
             (guard 1)
             (glim-horizontally 1)
             (glim-labelling 1)
             (glim-outlined 1)
             (glim-scrolling 1)
             (glim-vertically 1)
             (if 1)
             (if-match 2)
             (let*-values 1)                ; srfi-11
             (let-args 2)
             (let-keywords* 2)
             (let-match 2)
             (let-optionals* 2)
             (let-syntax 1)
             (let-values 1)                 ; srfi-11
             (let1 2)                       ; Gauche
             (letrec-syntax 1)
             (make 1)
             (match 1)                      ; Chicken
             (match-lambda 0)               ; Chicken, STk
             (match-lambda* 0)              ; Chicken
             (multiple-value-bind 2)
             (parameterize 1)
             (parse-options 1)
             (receive 2)                    ; srfi-8
             (respond/ok 1)                 ; makiki
             (rxmatch-case 1)
             (rxmatch-cond 0)
             (rxmatch-if 2)
             (rxmatch-let 2)
             (set-signal-handler! 1)
             (syntax-rules 1)
             (test 2)                       ; Gauche
             (unless 1)                     ; Gauche
             (until 1)                      ;  STk
             (unwind-protect 1)             ; Gauche Common-Lisp
             (when 1)                       ; Gauche
             (while 1)                      ;  STk
             (with-builder 1)
             (with-error-handler 0)         ; Gauche
             (with-error-to-port 1)
             (with-exception-handler 0)     ; srfi-18, srfi-21
             (with-input-from-file        1)
             (with-input-from-file/column 1); ggc.port.column
             (with-input-from-port/column 1); ggc.port.column
             (with-input-from-port/mirroring-to-port 2)   ; ggc.port.mirroring
             (with-input-from-process 1)    ; Gauche
             (with-input-from-string 1)
             (with-input-from-string/mirroring-to-file 2) ; ggc.port.mirroring
             (with-input-from-string/mirroring-to-port 2) ; ggc.port.mirroring
             (with-iterator 1)
             (with-module 1)                ; STk, Gauche
             (with-output-to-process 1)     ; Gauche
             (with-output-to-port/mirroring-to-port 2)
             (with-output-to-port/mirroring-to-file 2)
             (with-ports 3)
             ))
  (put (car x) 'scheme-indent-function (cadr x)))

;;; EOF おしまい