Company distel

company-distel-frontend.el

@@ -0,0 +1,45 @@
+(require 'company)
+(require 'distel)
+(require 'popup)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Company
+
+(defun erl-company-help ()
+  (interactive)
+    (let* ((selected (nth company-selection company-candidates))
+	   (doc-buffer (or
+			(company-call-backend 'doc-buffer selected)
+			(error "No documentation available"))))
+      (popup-tip doc-buffer :height 30)
+))
+
+(defun company-finish (result)
+  (let* ((isok (string-match ":" result))
+	 (mod (and isok (substring result 0 isok)))
+	 (fun (and isok (substring result (+ isok 1))))
+	 (arg (and fun (erl-company-get-metadoc mod fun)))
+	 (str (company-strip-prefix result)))
+    (insert (or (and (not isok) (concat str ":"))
+		(and (= (length arg) 1) (concat str (erl-format-arglists arg)))
+		str))
+    (when isok (company-cancel result))
+    (setq company-point (or (and (not isok) (+ (point) 1))
+			    (point)))))
+
+(defun company-distel-setup ()
+  (setq company-minimum-prefix-length 1)
+  (setq company-idle-delay .2)
+  (add-to-list 'company-backends 'company-distel)
+  (define-key company-active-map "\C-n" 'company-select-next)
+  (define-key company-active-map "\C-p" 'company-select-previous)
+  (define-key company-active-map [remap company-show-doc-buffer] 'erl-company-help)
+;;  (require 'company-distel-frontend)
+;  (setq company-frontends (list 'company-distel-frontend))
+  (company-mode))
+
+(add-hook 'erlang-mode-hook 'company-distel-setup)
+
+
+
+(provide 'company-distel-frontend)

company-distel-lib.el

@@ -0,0 +1,151 @@
+(require 'distel)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; docs funs         ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun erl-company-get-docs-from-internet-p (mod fun) ;; maybe version?
+  "Download the documentation from internet."
+  (let ((str
+	 (with-current-buffer 
+	     (url-retrieve-synchronously (format "http://www.erlang.org/doc/man/%s.html" mod))
+	   (goto-char (point-min))
+
+	   ;; find <p> containing <a name="module"> then
+	   ;; find <div class="REFBODY">
+
+	   (let* ((m (re-search-forward (or (and fun (format "<p>.*?<a name=\"%s.*?\">" fun))
+					    "<h3>DESCRIPTION</h3>") nil t))
+		  (beg (and m (match-end 0)))
+		  (end (and m (progn (re-search-forward "</p>.*?</div>" nil t)
+				     (match-end 0)))))
+	     (and beg end (buffer-substring beg end))))))
+    (and str
+	 (erl-company-html-to-string str))))
+
+(defun erl-company-html-to-string (string)
+  (let ((replaces '(("</?p>" . "\n")
+		    ("<br>" . "\n")
+		    ("<[^>]*>" . "")
+		    ("[[:space:]|\n]$" . "")
+		    ("^[[:space:]]+" . "")
+		    ("^\n[\n]+" . "")
+		    ("&gt;" . ">")
+		    ("&lt;" . "<"))))
+    (dolist (tagpair replaces string)
+      (setq string (replace-regexp-in-string (car tagpair) (cdr tagpair) string)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Distel funs       ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun erl-company-complete (search-string buf)
+  "Complete search-string as a module or function in current buffer."
+  (let* ((isok (string-match ":" search-string))
+	 (mod (and isok (substring search-string 0 isok)))
+	 (fun (and isok (substring search-string (+ isok 1))))
+	 (node erl-nodename-cache))
+    (if isok (erl-complete-function mod fun)
+      (erl-complete-module search-string))
+    (sleep-for 0.1)
+    (mapcar (lambda (item) (concat mod (when mod ":") item))
+	    try-erl-complete-cache)))
+
+(defvar try-erl-args-cache '())
+(defvar try-erl-desc-cache "")
+(defvar try-erl-complete-cache '())
+
+(defun erl-company-get-metadoc (mod fun)
+  "Get the arguments for a function."
+  (let ((node erl-nodename-cache))
+    (erl-company-args mod fun))
+  (sleep-for 0.1)
+  try-erl-args-cache)
+
+(defun erl-company-local-docs (mod fun)
+  "Get localdocs for a function."
+  (erl-company-get-metadoc mod fun)
+  (let ((node erl-nodename-cache))
+    (setq try-erl-desc-cache "")
+    (dolist (args try-erl-args-cache)
+      (erl-company-describe mod fun args)))
+  (sleep-for 0.1)
+  try-erl-desc-cache)
+
+(defun erl-company-describe (mod fun args)
+  (erl-spawn
+    (erl-send-rpc node 'distel 'describe (list (intern mod)
+					       (intern fun)
+					       (length args)))
+    (&erl-company-receive-describe args)))
+
+(defun &erl-company-receive-describe (args)
+  (erl-receive (args)
+      ((['rex ['ok desc]]
+	(let ((descr (format "%s:%s/%s\n%s\n\n"
+			     (elt (car desc) 0)
+			     (elt (car desc) 1)
+			     (elt (car desc) 2)
+			     (elt (car desc) 3))))
+	(when desc (setq try-erl-desc-cache (concat descr try-erl-desc-cache)))))
+       (else
+	(message "fail: %s" else)))))
+
+(defun erl-company-args (mod fun)
+  (erl-spawn
+    (erl-send-rpc node 'distel 'get_arglists (list mod fun))
+    (&erl-company-receive-args)))
+
+(defun &erl-company-receive-args ()
+  (erl-receive ()
+      ((['rex 'error])
+       (['rex docs]
+	(setq try-erl-args-cache docs))
+       (else
+	(message "fail: %s" else)
+	(setq try-erl-args-cache '())))))
+
+
+(defun erl-complete-module (module)
+  (erl-spawn
+    (erl-send-rpc node 'distel 'modules (list module))
+    (&erl-complete-receive-completions)))
+
+(defun erl-complete-function (module function)
+  (erl-spawn
+    (erl-send-rpc node 'distel 'functions (list module function))
+    (&erl-complete-receive-completions)))
+
+
+(defun &erl-complete-receive-completions ()
+  (erl-receive ()
+      ((['rex ['ok completions]]
+	(setq try-erl-complete-cache completions))
+       (other
+	(message "Unexpected reply: %s" other)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Local buffer funs ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun erl-company-grab-word ()
+  "Grab the current Erlang mod/fun/word."
+  (interactive)
+  (buffer-substring (point) (save-excursion
+			      (skip-chars-backward "a-zA-Z:_")
+			      (point))))
+
+(defun erl-company-is-comment-or-cite-p ()
+  "Returns t if point is inside a comment or a cite."
+  (save-excursion
+    (let ((po (point)))
+      (beginning-of-line)
+      (re-search-forward "[%\|\"|\']" po t)
+      (or (eql (char-before) ?%)
+	  (and (or (eql (char-before) ?\")
+		   (eql (char-before) ?\'))
+	       (not (re-search-forward "[\"\|\']" po t)))))))
+
+
+(provide 'company-distel-lib)

company-distel.el

@@ -0,0 +1,54 @@
+(require 'company-distel-lib)
+
+;;;###autoload
+(defun company-distel (command &optional args &rest ignore)
+  "Backend for Company-mode using Distel."
+  (interactive (list 'interactive))
+  (case command
+    (interactive (company-begin-backend 'company-distel))
+    (prefix ;; nar ska functionen slas pa? returnera ordet man ar pa.
+     (erl-company-find-prefix))
+    (candidates ;; vilka ord returneras
+     (erl-company-complete args (current-buffer)))
+    (meta
+     (let* ((isok (string-match ":" args))
+	    (mod (and isok (substring args 0 isok)))
+	    (fun (and isok (substring args (+ isok 1))))
+	    (met (erl-company-get-metadoc mod fun)))
+       (when isok (concat "Args: " (erl-format-arglists met)))))
+    (doc-buffer
+     (erl-company-get-doc-buffer args))
+
+    (t ;(message "(%s):%s" command args)
+       nil)))
+
+(defun erl-company-find-prefix ()
+  "Get word at point if it is not in a comment or a cite. If it couldn't find any return 'stop."
+  (let ((no-comment (not (erl-company-is-comment-or-cite-p)))
+	(word (erl-company-grab-word)))
+    (and
+     (eq (derived-mode-p 'erlang-mode) 'erlang-mode)
+     (or
+      (and no-comment word)
+      'stop))))
+
+(defun erl-company-get-doc-buffer (args)
+  "Returns a buffer with the documentation for ARGS."
+  (let* ((isok (string-match ":" args))
+	 (mod (or (and isok (substring args 0 isok))
+		  args))
+	 (fun (and isok (substring args (+ isok 1))))
+	 (doc (and fun (erl-company-local-docs mod fun)))
+	 (edocs (when (or (not doc) (string= doc "")) (erl-company-get-docs-from-internet-p mod fun)))
+	 (met (and fun (erl-format-arglists (erl-company-get-metadoc mod fun))))
+	 (to-show (or (and (not (string= doc "")) doc)
+		      (and (not (string= edocs "")) edocs)
+		      (concat mod ":" fun met)
+		      (format "Couldn't find any help for %s" args))))
+
+    (with-current-buffer (company-doc-buffer)
+      (insert to-show)
+      (current-buffer))))
+
+
+(provide 'company-distel)