#:g1: 簡単なSWANKの拡張で適当補完

Posted 2010-09-18 17:11:00 GMT

slime-complete-formというコマンドがあるのですが、これは文脈に応じて実行すると、

;; ■ = カーソル
(EVAL-WHEN ■)
;->
(EVAL-WHEN (:compile-toplevel :load-toplevel :execute) body...)
と補完してくれるというものです。
そんなに活躍するところもないのですが、ぴったりはまる場所では便利です。(eval-whenとか、(declare (optimize))とか)
そんな slime-complete-form の実装を眺めてみたのですが、なにかを補完したい場合には流用できそうだったので、試しにお決まりのパターンを補完するようなものをでっち上げてみました(コードは文末)
かなり適当なコードですが、
(MAPCAR ■)
;->
(MAPCAR (LAMBDA ()))
(DEFPACKAGE ■)
;->
(DEFPACKAGE :FOO
  (:USE :CL))
(REDUCE #'+ FOO■)
;->
(REDUCE #'+ FOO :INITIAL-VALUE)
(SET-DISPATCH-MACRO-CHARACTER ■)
;->
(SET-DISPATCH-MACRO-CHARACTER #\# #\? (LAMBDA (STREAM SUBCHAR ARG) (DECLARE (IGNORE SUBCHAR ARG)) ))
位のことはできます。
補完した後にカーソルも適切な場所に移動したりできたら、それなりに便利にはなりそうではあります。

ちなみに、SWANKを眺めていたら、パターンマッチのユーティリティが取り込まれていたので使ってみました。
Stephen Adams氏作で、
http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/match/miranda/select.cl
のものと同一だと思われます。
以前、Chaton COMMON LISP JP部屋でshiroさんにCLを書く時に使っているライブラリを伺ったときに、パターンマッチがないとやってられないので、これを改造して利用していると伺った覚えがあります。
SWANKに付いてくるので、自分がCLを使っている時は常時読み込まれていますし、しばらく積極的に使ってみようかなと思っています。

コード

emacs側

(progn
  (defun slime-my-complete-form ()
    (interactive)
    ;; Find the (possibly incomplete) form around point.
    (let ((buffer-form (slime-parse-form-upto-point)))
      (let ((result (slime-eval `(swank:my-complete-form ',buffer-form))))
        (if (eq result :not-available)
            (error "Could not generate completion for the form `%s'" buffer-form)
          (progn
            (just-one-space (if (looking-back "\\s(" (1- (point)))
                                0
                              1))
            (save-excursion
              (insert result)
              (let ((slime-close-parens-limit 1))
                (slime-close-all-parens-in-sexp)))
            (save-excursion
              (backward-up-list 1)
              (indent-sexp)))))))

(define-key slime-mode-map [(control ?c) (control shift ?s)] 'slime-my-complete-form))

SWANK側

(IN-PACKAGE :SWANK)

(DEFSLIMEFUN MY-COMPLETE-FORM (RAW-FORM) (FLET ((STRING-UPCASE-SAFE (X) (IF (STRINGP X) (STRING-UPCASE X) X))) (MATCH (MAPCAR #'STRING-UPCASE-SAFE RAW-FORM) (("MAPCAR" . REST) "(LAMBDA ())") (("SET-MACRO-CHARACTER" . REST) "#\\ (LAMBDA (STREAM CHAR) (DECLARE (IGNORE CHAR)))")

(("SET-DISPATCH-MACRO-CHARACTER" . REST) "#\\ #\\ (LAMBDA (STREAM SUBCHAR ARG) (DECLARE (IGNORE SUBCHAR ARG)) )")

(("EVAL-WHEN" (":COMPILE-TOPLEVEL" ":LOAD-TOPLEVEL" ":EXECUTE") . REST) ":?")

(("EVAL-WHEN" . REST) "(:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)")

(("LOOP" . REST) ":FOR X :FROM 0 :TO 100 :COLLECT X")

(("LET" ("" %CURSOR-MARKER%) . REST) "(X X)")

(("LET" . REST) "()")

(("DEFPACKAGE" . REST) ":FOO (:USE :CL)")

(("REDUCE" #:_ #:_ %cursor-marker%) ":INITIAL-VALUE")

(("REDUCE" #:_ #:_ "" %cursor-marker% . REST) ":INITIAL-VALUE")

(OTHER :NOT-AVAILABLE))))


comments powered by Disqus