auto-import class after completion

Special-Thanks: Dominik Honnef (go-mode author)

Feature description :
After completion with company-phpactor, if the
selected candidate is a class (see "info" key in phpactor's output),
a proper "use" statement is added after the namespace declaration in
case it was absent.

In order to distinguish classes with the same name, fully qualified
names are shown as annotations beside every completion candidate.

What is changed :
- completion candidates are given text properties with additionnal
informations given by phpactor (info and type keys).
- phpactor is called after the completion if the candidate had type
't' (class).
- use of functions from go-mode.el to apply a patch on current buffer
instead of replacing the whole buffer content in order to save the
point.
- also widen the buffer before completion, making completion also work
during narrowing.

Author: kermorgant

company-phpactor.el

@@ -50,14 +50,38 @@ Here we create a temporary syntax table in order to add $ to symbols."
   (let ((response (phpactor--rpc "complete" (phpactor--command-argments :source :offset))))
     (plist-get (plist-get (plist-get response  :parameters) :value) :suggestions)))
 
+(defun company-phpactor--get-candidates ()
+  "Build a list of candidates with text-properties extracted from phpactor's output."
+  (let ((suggestions (company-phpactor--get-suggestions)) candidate)
+    (mapcar
+     (lambda (suggestion)
+       (setq candidate (plist-get suggestion :name))
+       (put-text-property 0 1 'annotation (plist-get suggestion :info) candidate)
+       (put-text-property 0 1 'type (plist-get suggestion :type) candidate)
+       candidate)
+     suggestions)))
+
+(defun company-phpactor--post-completion (arg)
+  "Trigger auto-import of completed item ARG when relevant."
+  (if (string= (get-text-property 0 'type arg) "t")
+      (phpactor-import-class (get-text-property 0 'annotation arg))))
+
+(defun company-phpactor--annotation (arg)
+  "Show additional info (ARG) from phpactor as lateral annotation."
+  (message (concat " " (get-text-property 0 'annotation arg))))
+
 ;;;###autoload
 (defun company-phpactor (command &optional arg &rest ignored)
   "`company-mode' completion backend for Phpactor."
   (interactive (list 'interactive))
-  (cl-case command
-    (interactive (company-begin-backend 'company-phpactor))
-    (prefix (company-phpactor--grab-symbol))
-    (candidates (all-completions (substring-no-properties arg) (mapcar #'(lambda (suggestion) (plist-get suggestion :name)) (company-phpactor--get-suggestions))))))
+  (save-restriction
+    (widen)
+    (cl-case command
+      (post-completion (company-phpactor--post-completion arg))
+      (annotation (company-phpactor--annotation arg))
+      (interactive (company-begin-backend 'company-phpactor))
+      (prefix (company-phpactor--grab-symbol))
+      (candidates (all-completions arg (company-phpactor--get-candidates))))))
 
 (provide 'company-phpactor)
 ;;; company-phpactor.el ends here

phpactor.el

@@ -38,6 +38,11 @@
 ;; See https://phpactor.github.io/phpactor/configuration.html
 ;;
 
+;; The following definitions from go-mode.el have been adapted :
+;; (Author: Dominik Honnef, url: https://github.com/dominikh/go-mode.el)
+;;
+;; go--apply-rcs-patch go--goto-line go--delete-whole-line
+
 ;;; Code:
 (require 'json)
 (require 'php-project)
@@ -265,14 +270,108 @@
   (find-file path)
   (goto-char (1+ offset)))
 
-(cl-defun phpactor-action-replace-file-source (&key path source)
+;; this function was adapted from go-mode
+(defun phpactor--goto-line (line)
+  "Goto line LINE."
+  (goto-char (point-min))
+  (forward-line (1- line)))
+
+;; this function was adapted from go-mode
+(defun phpactor--delete-whole-line (&optional arg)
+  "Delete the current line without putting it in the `kill-ring'.
+Derived from function `kill-whole-line'.  ARG is defined as for that
+function."
+  (setq arg (or arg 1))
+  (if (and (> arg 0)
+           (eobp)
+           (save-excursion (forward-visible-line 0) (eobp)))
+      (signal 'end-of-buffer nil))
+  (if (and (< arg 0)
+           (bobp)
+           (save-excursion (end-of-visible-line) (bobp)))
+      (signal 'beginning-of-buffer nil))
+  (cond ((zerop arg)
+         (delete-region (progn (forward-visible-line 0) (point))
+                        (progn (end-of-visible-line) (point))))
+        ((< arg 0)
+         (delete-region (progn (end-of-visible-line) (point))
+                        (progn (forward-visible-line (1+ arg))
+                               (unless (bobp)
+                                 (backward-char))
+                               (point))))
+        (t
+         (delete-region (progn (forward-visible-line 0) (point))
+                        (progn (forward-visible-line arg) (point))))))
+
+;; this function was adapted from go-mode
+(defun phpactor--apply-rcs-patch (patch-buffer)
+  "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer."
+  (let ((target-buffer (current-buffer))
+        ;; Relative offset between buffer line numbers and line numbers
+        ;; in patch.
+        ;;
+        ;; Line numbers in the patch are based on the source file, so
+        ;; we have to keep an offset when making changes to the
+        ;; buffer.
+        ;;
+        ;; Appending lines decrements the offset (possibly making it
+        ;; negative), deleting lines increments it. This order
+        ;; simplifies the forward-line invocations.
+        (line-offset 0)
+        (column (current-column)))
+    (save-excursion
+      (with-current-buffer patch-buffer
+        (goto-char (point-min))
+        (while (not (eobp))
+          (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)")
+            (error "Invalid rcs patch or internal error in go--apply-rcs-patch"))
+          (forward-line)
+          (let ((action (match-string 1))
+                (from (string-to-number (match-string 2)))
+                (len  (string-to-number (match-string 3))))
+            (cond
+             ((equal action "a")
+              (let ((start (point)))
+                (forward-line len)
+                (let ((text (buffer-substring start (point))))
+                  (with-current-buffer target-buffer
+                    (cl-decf line-offset len)
+                    (goto-char (point-min))
+                    (forward-line (- from len line-offset))
+                    (insert text)))))
+             ((equal action "d")
+              (with-current-buffer target-buffer
+                (phpactor--goto-line (- from line-offset))
+                (cl-incf line-offset len)
+                (phpactor--delete-whole-line len)))
+             (t
+              (error "Invalid rcs patch or internal error in phpactor--apply-rcs-patch")))))))
+    (move-to-column column)))
+
+(cl-defun  phpactor-action-replace-file-source (&key path source)
   "Replace the source code in the current file."
-  (save-window-excursion
-    (with-current-buffer (find-file-noselect path)
-      ;; This is a simple implementation, so points will not be saved.
-      ;; Should I copy the implementation of gofmt?  Umm...
-      (erase-buffer)
-      (insert source))))
+  (interactive)
+  (let ((tmpfile (make-temp-file "phpactor" nil ".php"))
+        (patchbuf (get-buffer-create "*Phpactor patch*"))
+        (coding-system-for-read 'utf-8)
+        (coding-system-for-write 'utf-8))
+
+    (unwind-protect
+        (save-restriction
+          (widen)
+          (with-current-buffer patchbuf
+            (erase-buffer))
+
+          (with-temp-file tmpfile
+            (insert source))
+
+          (if (zerop (call-process-region (point-min) (point-max) "diff" nil patchbuf nil "-n" "-" tmpfile))
+              (message "Buffer was unchanged by phpactor")
+            (phpactor--apply-rcs-patch patchbuf)
+            (message "Buffer modified by phpactor")))
+
+      (kill-buffer patchbuf)
+      (delete-file tmpfile))))
 
 ;; Dispatcher:
 (cl-defun phpactor-action-dispatch (&key action parameters)
@@ -369,5 +468,12 @@
   (let ((arguments (phpactor--command-argments :source :offset :path)))
     (apply #'phpactor-action-dispatch (phpactor--rpc "goto_definition" arguments))))
 
+;;;###autoload
+(defun phpactor-import-class (name)
+  "Execute Phpactor PRC import_class command for class NAME."
+  (interactive)
+  (let ((arguments (phpactor--command-argments :source :offset :path)))
+    (apply #'phpactor-action-dispatch (phpactor--rpc "import_class" (append arguments (list :name name))))))
+
 (provide 'phpactor)
 ;;; phpactor.el ends here