2011年6月12日日曜日

dabbrevのポップアップにXTAGSの関数リストを追加する

普段XYZZYで開発をしています。
文字補完にdabbrevを利用しているわけですが、dabbrevは表示バッファしか候補リストに表示してくれないので、補完リストに表示させるためだけに編集しないファイルを開いたりしなければいけなくって結構に面倒に感じていました。
関数が補完候補にあがってきてくれればいいので、関数のタグジャンプ機能を利用する際に生成されるファイル(XTAGS)をdabbrev実行時に読み込んで、関数を補完リストに表示させるようにしました。
仕事でつかっているのがPHP4(というか関数しかつかってないPHP)なので、そういった環境での利用を想定しています。

まずは関数一覧ファイルの取得

(defun find-tags-file(&optional dir)
  (or dir
      (setq dir (default-directory)))
  (let ((file (merge-pathnames "XTAGS" dir)))
    (unless (file-exist-p file)
      (return-from find-tags-file nil))
    (let ((buffer (create-new-buffer " *TAGS*")))
      (save-excursion
        (set-buffer buffer)
        (insert-file-contents file t)
        (goto-char (point-min))
        (if (looking-at "#USE \\(\\(../\\)+\\)$")
            (setq buffer (find-tags-file (namestring (match-string 1))))
        )
      )
      buffer
    )
  )
)
タグファイルは階層の最上位に全関数の一覧が集められているという構造になっているので、開いているファイルのフォルダから順番に階層をさかのぼっていくようにします。

次にdabbrev.lで補完候補リストに自分独自のリストを追加できるようにします。
dabbrev.lはXYZZYをインストールしたフォルダの「lisp」フォルダ内にあります。
補完候補はポップアップに表示する文字列のリストの形になっているので、そのリストに独自に文字列を挿入できるようにしました。

(defun dabbrev-popup ()
  (interactive "*")
  (let* ((end (point))
         (start (save-excursion (dabbrev-start))))
    (when (= start end)
      (return-from dabbrev-popup nil))
    (let* ((abbrev (buffer-substring start end))
           (match-table (make-hash-table
                         :test (if *dabbrevs-case-fold* #'equalp #'equal)))
           matches)
      (setf (gethash abbrev match-table) start)
      (setq matches (dabbrev-find-all-expansion abbrev *dabbrevs-case-fold*
                                                match-table start nil))
      (unless *dabbrev-popup-this-buffer-only*
        (let ((curbuf (selected-buffer))
              (case-fold *dabbrevs-case-fold*)
              (syntax-table (syntax-table)))
          (with-set-buffer
            (with-interval-message (300)
              (save-excursion
                (dolist (buffer (buffer-list))
                  (unless (eq buffer curbuf)
                    (message "Searching (~A)..." (buffer-name buffer))
                    (set-buffer buffer)
                    (save-excursion
                      (let ((osyntax-table (syntax-table)))
                        (unwind-protect
                            (progn
                              (use-syntax-table syntax-table nil t)
                              (setq matches (dabbrev-find-all-expansion
                                             abbrev case-fold match-table nil matches)))
                          (use-syntax-table osyntax-table nil t))))))))))
        (clear-message))
      ; ------------- ここから追加箇所 ---------------------
      (unless (minibuffer-window-p (selected-window))                   ; ミニバッファ内では補完しないようにする
        (setq matches (funcall *dabbrev-matches-hook* matches abbrev))
      )
      ; ------------- ここまで追加箇所 ---------------------
      (if matches
          (popup-completion-list (sort matches #'string-lessp) start end)
        (plain-error "ないよん")))))
matches ・・・ ポップアップに表示する文字列のリスト
abbrev ・・・ 補完対象の文字列
になります。
追加した関数を他で変更できるようにexportするのと、デフォルトの関数を定義しておきます。
(export '(dabbrev-expand dabbrev-popup
   *dabbrevs-case-fold* *dabbrevs-no-undo*
   *dabbrev-search-this-buffer-only*
   *dabbrev-popup-this-buffer-only*
   *dabbrev-matches-hook*))

(defvar *dabbrev-matches-hook* #'(lambda(matches abbrev) matches))
最初はhookと大域変数つかってやろうとしていたので、「hook」という名前が残ってしまっています・・・。

dabbrev.lはコンパイルすることが必要なので、XYZZYでM-x(Alt-x)をおして、

  1. 「byte-compile-file」と入力
  2. コンパイルするファイルを聞かれるので、dabbrev.lを指定する
  3. XYZZYがあるフォルダにある「xyzzy.wxp」ファイルを削除する
を行います。

最後にXTAGSの関数をリストに追加するために「*dabbrev-matches-hook*」を書きかえます。

;; dabbrevに項目(XTAGS)追加
(setq *dabbrev-matches-hook* #'(lambda (method-list abbrev)
                                      ;XTAGSファイルを取得する
                                      (defun find-tags-file(&optional dir)
                                        (or dir
                                            (setq dir (default-directory)))
                                        (let ((file (merge-pathnames "XTAGS" dir)))
                                          (unless (file-exist-p file)
                                            (return-from find-tags-file nil))
                                          (let ((buffer (create-new-buffer " *TAGS*")))
                                            (save-excursion
                                              (set-buffer buffer)
                                              (insert-file-contents file t)
                                              (goto-char (point-min))
                                              (if (looking-at "#USE \\(\\(../\\)+\\)$")
                                                  (setq buffer (find-tags-file (namestring (match-string 1))))
                                              )
                                            )
                                            buffer
                                          )
                                        )
                                      )
                                      ; ------- ここから補完処理 ------
                                      (let ((buffer (find-tags-file)))
                                        (unless (eql nil buffer)
                                          (save-excursion
                                            (set-buffer buffer)
                                            (goto-char (point-min))
                                            (while (not (eql (point) (point-max)))
                                              (if (looking-at " \\([^ ]+\\)")
                                                  (let ((match-str (match-string 1)))
                                                    (if (and (string-match (concat "^" abbrev ".*") match-str)
                                                             (not (find match-str method-list :test #'equal)))
                                                        (push match-str method-list)))
                                             )
                                             (forward-line)
                                            )
                                            (delete-buffer buffer)
                                          )
                                        )
                                      )
                                    method-list
                                  ))

0 件のコメント:

コメントを投稿