gaucheの補完をanythingから使えるようにしてみた

symbol名の補完

inferior-gauche-modeでは以下の点が不満でした。

    • scheme-other-window*1で立ち上がったreplとも通信できない
    • anythingで候補を選択できない*2
      • inferior-gauche-modeではcompleting-readを利用して候補を選択する

replと通信する

scheme-other-windowで使われているrun-schemeはcomint.elの関数を使ってます。
なので、replの出力を得るには、comintのprocess-filterを通る出力をどこかで読み取ることができればいいんじゃないかと思いました。
図にするとこんな感じです。

eval -> (comintの処理) -> replの出力
eval -> 新しく作成するfilter -> (comintの処理) -> replの出力

comintのfilterの部分を探す

(process-filter (get-process "scheme")); =>comint-output-filter
(describe-function 'comint-output-filter)

;;comint.elのcomint-output-filterの定義を見る
(defun comint-output-filter (process string)
  (let ((oprocbuf (process-buffer process)))
    ;; First check for killed buffer or no input.
    (when (and string oprocbuf (buffer-name oprocbuf))
      (with-current-buffer oprocbuf
	;; Run preoutput filters
	(let ((functions comint-preoutput-filter-functions))
	  (while (and functions string)
	    (if (eq (car functions) t)
		(let ((functions (default-value 'comint-preoutput-filter-functions)))
		  (while (and functions string)
		    (setq string (funcall (car functions) string))
		    (setq functions (cdr functions))))
	      (setq string (funcall (car functions) string)))
	    (setq functions (cdr functions))))
....

comint-preoutput-filter-functionsにfilter操作を行う関数を定義してあげれば良さそうです。

filterの作成

(setq my-test-store nil)
(setq comint-preoutput-filter-functions
      '((lambda (s) (progn (push s my-test-store) s))))

(defun scheme-send-string (str)
  (let ((process (get-process "scheme")))
  (comint-send-string process (format "%s\n" str))))

(scheme-send-string "(+ 1 2)")

(pp my-test-store (current-buffer));;("3\ngosh> ")

無事、出力結果を取ることができました。
というわけで、コードを書きます。

使い方

.emacs

(add-hook 'scheme-mode-hook
	  (lambda ()
	    (define-key "\C-c\C-i" 'mg-completion)
))

という感じでmg-completionを好きなキーにバインドすれば使えます。
(schemeのreplを立ち上げて置く必要があります)

code

gaucheのaproposをそのまま使っているので、他の処理系だと自分でaproposのような関数を定義しないとだめかもしれません。

(require 'cl)
(require 'anything)
(require 'cmuscheme)

(defvar mg-process-name "scheme")
(defvar mg-prompt "gosh>")
(defvar mg-reading-p nil)
(defvar mg-filter-regexp (regexp-quote mg-prompt))
(defvar mg-output-storage nil)
(defvar mg-not-output-filter-functions
  '((lambda (s) (if (string-match mg-filter-regexp s)
		    (let* ((len (min (length s) (+ 2 (length mg-prompt))))
			   (str (substring s 0 (- len))))
		      (setq mg-reading-p nil)
		      (push str mg-output-storage)
		      mg-prompt)
		  (progn (push s mg-output-storage) "")))
    ))

(defun mg-cleanup-storage ()  
  (setq mg-output-storage nil))

(defun mg-process-filter-switch (repl-not-output-flag)
  (if repl-not-output-flag
    (progn (mg-cleanup-storage)
	   (setq mg-reading-p t)
	   mg-not-output-filter-functions)
    nil))
  
(defun mg-send-string (str &optional flag)
  (declare (special comint-preoutput-filter-functions))
  (let ((proc (get-process mg-process-name)))
    (setq comint-preoutput-filter-functions (mg-process-filter-switch flag))
    (process-send-string proc (format "%s\n" str))
    (when flag
      (while mg-reading-p (sleep-for 0 100) )
      (apply 'concat (reverse mg-output-storage)))))

(defun mg-apropos (pattern &optional repl-not-output)
  (interactive "sapropos:\nP")
  (mg-send-string (format "(apropos #/%s/)" pattern) repl-not-output))

;;;;

(defun mg-initial-input ()
  (save-excursion
    (let ((end (point))
	  (start (progn (skip-syntax-backward "w_") (point))))
      (buffer-substring-no-properties start end))))

(defun mg-make-completion-source (part)
  `((name . "scheme symbol")
    (init . (lambda ()
	      (with-current-buffer (anything-candidate-buffer 'global)
		(insert (mg-apropos ,(format "^%s" part) t)))))
    (candidates-in-buffer)
    (action . (("Insert" . (lambda (candidate)
			     (delete-backward-char (length ,part))
			     (when (string-match "^[^ ]+" candidate)
			       (insert (match-string 0 candidate)))))))))
  
(defun mg-completion () (interactive)
  (let* ((init (mg-initial-input))
	(source (mg-make-completion-source init)))
    (anything (list source))))

slimeはもっと便利なのかもしれない

CLの人などはslimeを使っている人が多いみたいですが、slimeのことはよく分からないです><.

*1:大抵のひとはこの関数を作っていると思う

*2:少しいじればanythingに対応させることも可能だけど