ocamlの関数の補完をするelisp
まだ完成していないけど、途中経過をUpしてみます。
長いので、別のところにupした方が良かったかもしれません。
使用方法
- ファイルの冒頭にあるコメントの部分を.emacsに貼り付ける
- (好きなキーにbindする）
open
- anything-ocaml-reference--delete-memoryで生成したファイルを削除できます。
問題
- 最初の起動に時間がかかる（一度ファイルを作成してからだとそれほどでもないです）
- helpの表示がしょぼい
- (定義元へのlinkとか貼れたらいいなとは思う）
- すべての関数を適切に読み取れているか分からない
コード
(require 'anything) (require 'tuareg) ;; .emacsに ;; (require 'anything-ocaml-reference ;; (add-hook 'tuareg-mode-hook ;; (lambda () ;; (anything-ocaml-reference-setup) ;; (define-key tuareg-mode-map "\C-ci" 'anything-ocaml-reference) ;; (define-key tuareg-mode-map "\C-co" 'anything-ocaml-reference-module-insert) ;; define-key tuareg-mode-map "\C-c\C-i" 'anything-ocaml-reference-completions) ;; ) ;; ;;debug用 ;; (defun d (e) ;; (with-output-to-temp-buffer "*debug*" ;; (print e))) (defvar ocaml-reference-base "~/.emacs.d/ocaml-reference/") (defvar ocaml-functions-list-path (concat ocaml-reference-base "ocaml-functions-list")) (defvar ocaml-module->mli-file-alist-path (concat ocaml-reference-base "relation-between-module-and-mli")) (defvar anything-ocaml-reference-save-p t) ;;無かったらdirectoryを作成 (let ((dir (file-name-directory ocaml-functions-list-path))) (unless (file-exists-p dir) (unless (file-exists-p (file-name-directory dir)) (make-directory (file-name-directory dir))) (make-directory dir))) (defvar ocaml-library-pathes '("/usr/local/lib/ocaml" "/usr/lib/ocaml")) (defvar ocaml-mli-file-list nil) (defun directory-files2 (file) ".と..をなくしたファイルを返す.絶対pathで" (mapcar #'(lambda (f) (expand-file-name f file)) (cddr (directory-files file)))) (defun set-all-mli-files (files) (dolist (f files) (cond ((file-directory-p f) (set-all-mli-files (directory-files2 f))) ((equal (file-name-extension f) "mli") (push f ocaml-mli-file-list))))) (defvar ocaml-functions-list nil) (defvar ocaml-reference-search-functoin-regexp "^[ \t]*\\(val\\|exception\\|type\\|external\\) *\\([^ \n\t]+\\) *[ :\n]") (defun get-ocaml-functions-lists-from-mli-file (file) "return list. such as (<module1> ((<func1> <s-point> <e-point>) (<func2> <s-point> <e-point>) ...)) OR, when module definition is nested, then return list of such as it. " (let ((result '())) (save-excursion (set-buffer (find-file-noselect file)) (goto-char (point-min)) (while (re-search-forward ocaml-reference-search-functoin-regexp (point-max) t 1) (let ((start (match-beginning 1)) (name (substring-no-properties (match-string 2)))) (push (cons name start) result))) (push (cons "*END*" (point-max)) result)) (let ((module (get-ocaml-module-from-mli-file file)) (functions (mapcar* #'(lambda (next this) (let ((func (car this)) (s-point (cdr this)) (e-point (cdr next))) (list func s-point e-point))) result (cdr result)))) (let ((buf (file-name-nondirectory file))) ;;開いたbufferを閉じる (when (get-buffer buf) (kill-buffer buf))) (if (stringp module) ;file内にmodule定義が無かった場合 (cons module functions) (let ((alist (mapcar #'(lambda (e) (list e '())) module))) ;alist = (module (func-list ...) (dolist (f-list functions) (let ((f-s-point (s-point f-list)) (f-e-point (e-point f-list))) (dolist (a alist) (let ((m (car a))) (cond ((and (< (s-point m) f-s-point) (> (e-point m) f-e-point)) (push f-list (cadr a)))))))) alist))))) (defun s-point (l) (cadr l)) (defun e-point (l) (caddr l)) ;; (d (get-ocaml-functions-lists-from-mli-file ;; "/usr/lib/ocaml/3.10.0/weak.mli")) (defun get-ocaml-module-from-mli-file (file) (let ((result '())) (set-buffer (find-file-noselect file)) (goto-char (point-min)) (push (cons nil (point-min)) result) ;はじめの部分 (while (re-search-forward "module[ \t]+\\([^ ]+\\)[ \t]:" (point-max) t 1) (push (cons (match-string-no-properties 1) (match-beginning 1)) result)) (let ((base-module (get-ocaml-module-name file))) (if (null (caar result)) ;module定義がファイル内にみつかなかったら base-module (progn (push (cons "*END*" (point-max)) result) (mapcar* #'(lambda (next this) (let ((module (if (null (car this)) ;;nestされたmoduleじゃないもののための分岐 base-module (concat base-module "." (car this)))) (s-point (cdr this)) (e-point (cdr next))) (list module s-point e-point))) result (cdr result))))))) ;(d (get-ocaml-module-from-mli-file "/usr/lib/ocaml/3.10.0/weak.mli")) ;(get-ocaml-module-from-mli-file "~/test/ocaml-all.mli") (defun get-ocaml-module-name (file-name) "(get-ocaml-module-name \"enum.mli\") => \"Enum\"" (let ((module (car (split-string (file-name-nondirectory file-name) "\\.")))) (concat (capitalize (substring module 0 1)) (substring module 1)))) (defun get-ocaml-mli-name (module) "(get-ocaml-mli-name \"Enum\") => \"enum.mli\"" (cadr (assoc module module->mli-file-alist))) (defun get-ocaml-function-search (function lst) "e.g. function = \"Array.map\" lst = (<module> '((<func1> <s-point> <e-point>) (<func2> <s-point> <e-point>) ...))" (when (string-match "\\([^ ]+\\)\\\.\\([^ ]+\\)$" function) (let ((module (match-string 1 function)) (func (match-string 2 function))) (let ((func-list (cdr (assoc module lst)))) (when func-list (let ((module (car (split-string module "\\.")))) (cons module (assoc func func-list)))))))) (defun get-ocaml-function-info (module func from to) (let ((file (get-ocaml-mli-name module)) (buf "*ocaml info*")) (when (get-buffer buf) (kill-buffer buf)) (set-buffer (find-file-noselect file)) (let ((content (buffer-substring from to))) (anything-ocaml-reference--view content)))) (defun anything-ocaml-reference--view (content) (set-buffer (get-buffer-create buf)) (insert content) ; (insert "\n from:`" file "'") (insert (concat "\nmodule:" module "\n")) (insert (concat "\n from:(find-file\"" file "\")")) (tuareg-mode) (view-buffer-other-window buf t) (other-window 1)) (defun make-module->mli-file-alist (files) (setq module->mli-file-alist (mapcar #'(lambda (f) (list (get-ocaml-module-name f) f)) files))) (defun read-from-file (file) (set-buffer (find-file-noselect file)) (goto-char (point-min)) (read (current-buffer))) (defun delete-file&buffer (file) (when (file-exists-p file) (delete-file file)) (let ((buf (file-name-nondirectory file))) (when (get-buffer buf) (kill-buffer buf)))) (defun anything-ocaml-reference--delete-memory () (interactive) (setq anything-ocaml-reference-setup-p nil ocaml-mli-file-list nil ocaml-functions-list nil module->mli-file-alist nil ocaml-mli-file-list nil anything-ocaml-reference-source nil anything-ocaml-module-source nil) (dolist (file (list ocaml-functions-list-path ocaml-module->mli-file-alist-path)) (delete-file&buffer file))) (defun set-ocaml-mli-file-list () (dolist (d (mapcar #'directory-files2 ocaml-library-pathes)) (set-all-mli-files d))) (defun set-ocaml-relation-between-module&file () (if (and anything-ocaml-reference-save-p (file-exists-p ocaml-module->mli-file-alist-path)) (setq module->mli-file-alist (read-from-file ocaml-module->mli-file-alist-path)) (progn (unless ocaml-mli-file-list (set-ocaml-mli-file-list)) (make-module->mli-file-alist ocaml-mli-file-list) (when anything-ocaml-reference-save-p (save-value-of-variable module->mli-file-alist ocaml-module->mli-file-alist-path))))) (defun set-ocaml-function-list () (if (and anything-ocaml-reference-save-p (file-exists-p ocaml-functions-list-path)) (setq ocaml-functions-list (read-from-file ocaml-functions-list-path)) (progn (unless ocaml-mli-file-list (set-ocaml-mli-file-list)) (dolist (mli ocaml-mli-file-list) (let ((function-list (get-ocaml-functions-lists-from-mli-file mli))) (if (stringp (car function-list)) (push function-list ocaml-functions-list) (dolist (f-list function-list) (push (cons (caar f-list) (cadr f-list)) ocaml-functions-list))))) (when anything-ocaml-reference-save-p (save-value-of-variable ocaml-functions-list ocaml-functions-list-path))))) (defun save-value-of-variable (variable file) (delete-file&buffer file) (set-buffer (find-file-noselect file)) (goto-char (point-min)) (print variable #'insert)) (defvar anything-ocaml-reference-setup-p nil) (defun anything-ocaml-reference-setup () (or anything-ocaml-reference-setup-p (progn (setq anything-ocaml-reference-setup-p t) (set-ocaml-function-list) (set-ocaml-relation-between-module&file) (anything-ocaml-reference-source) (anything-ocaml-reference-module-source) ))) (defvar anything-ocaml-reference-source nil) (defun anything-ocaml-reference-source () (or anything-ocaml-reference-source (dolist (e ocaml-functions-list) (let ((module (car e))) (dolist (func-list (cdr e)) (let ((word (concat module "." (car func-list)))) (push word anything-ocaml-reference-source))))) anything-ocaml-reference-source)) (defvar anything-c-source-ocaml-reference '((name . "Function") (requires-pattern . 2) ; (delayed) (candidates . (lambda () (anything-ocaml-reference-source))) (action . (("view" . (lambda (candidate) (apply #'get-ocaml-function-info (get-ocaml-function-search candidate ocaml-functions-list)))) )))) (defvar anything-ocaml-reference-module-source nil) (defun anything-ocaml-reference-module-source () (or anything-ocaml-reference-module-source (progn (setq anything-ocaml-reference-module-source (mapcar #'car module->mli-file-alist)) anything-ocaml-reference-module-source))) (defvar anything-c-source-ocaml-module '((name . "Module") (candidates . (lambda () (anything-ocaml-reference-module-source))) (action . (("view" . (lambda (c) (find-file (get-ocaml-mli-name c))))) ))) (defvar anything-c-source-ocaml-module--insert '((name . "Module") (candidates . (lambda () (anything-ocaml-reference-module-source))) (action . (("Insert" . (lambda (c) (delete-backward-char (length anything-initial-input)) (insert c))) ("Open Module" . (lambda (c) (insert (concat "open " c ";;")))) ("View" . (lambda (c) (find-file (get-ocaml-mli-name c))))) ))) (defmacro defun-anything-caller (name sources) `(defun ,name () (interactive) (let ((anything-sources ,sources) (anything-initial-input (ocaml-reference-current-function))) (anything)))) (defun-anything-caller anything-ocaml-reference-module-insert (list anything-c-source-ocaml-module--insert)) (defun-anything-caller anything-ocaml-reference (list anything-c-source-ocaml-module anything-c-source-ocaml-reference)) (provide 'anything-ocaml-reference) (defun ocaml-reference-current-function () (interactive) (let ((end (point)) (start (save-excursion (+ 1 (re-search-backward "[\n\t )(]" (point-at-bol -1) t 1) )))) (buffer-substring-no-properties start end))) (defun anything-ocaml-reference-function--insert (candidate) (delete-backward-char (length anything-initial-input)) ; (insert (car (reverse (split-string candidate "\\."))))) (insert candidate)) (defun ocaml-completions-c-sources-maker (module function-list) `((name . ,module) (candidates . ,function-list) (action . (("insert" . anything-ocaml-reference-function--insert) ("view" . (lambda (c) (let ((function (concat ,module "." c))) (apply #'get-ocaml-function-info (get-ocaml-function-search function ocaml-functions-list)))))) ))) (defun anything-ocaml-reference-completions () (interactive) (let ((function&module (reverse (split-string (ocaml-reference-current-function) "\\.")))) (let* ((function (car function&module)) (anything-initial-input function) (current_module_p (null (cdr function&module))) (modules (if current_module_p (ocaml-reference--search-open) (let ((ms (delete function function&module))) (revappend ms (mapcar* (lambda (x y) (concat x "." y)) (ocaml-reference--search-open) ms)))))) (let ((anything-sources (mapcar (lambda (module) (ocaml-completions-c-sources-maker module (mapcar #'car (cdr (assoc module ocaml-functions-list))))) modules))) (if current_module_p (let ((anything-sources (cons anything-c-source-ocaml-module--insert anything-sources))) (anything)) (anything)))))) (defun ocaml-reference--search-open () (let ((end (point)) (re " *open +\\([^ ]+\\) *;;") (result '())) (save-excursion (goto-char (point-min)) (while (re-search-forward re end t) (push (match-string-no-properties 1) result)) result)))
