cmd/guru: Emacs: run guru asynchronously using compilation-mode

We define a derived mode of compilation-mode, so that various
names say "guru" instead of "compilation", and use the hooks it
provides to apply our postprocessing incrementally instead of
all at the end.  It's much faster, and works nicely with the
new streaming referrers query.

Compilation mode requires a shell command, not an execve array,
so go-guru--compile-command joins the arguments with spaces.
go-guru--exec has been specialized for JSON mode,
and renamed to go-guru--json.

go-guru--set-scope-if-empty is now done by each mode, to avoid
the NEED-SCOPE parameter to go-guru--exec.

Change-Id: I692b8b28449b7cc17fd6251a152588f9d8b89ebc
Reviewed-on: https://go-review.googlesource.com/21772
Reviewed-by: Dominik Honnef <dominik@honnef.co>
Reviewed-by: Alan Donovan <adonovan@google.com>

cmd/guru/go-guru.el

@@ -117,129 +117,134 @@ matches all encoding packages except encoding/xml."
 	(error "You must specify a non-empty scope for the Go guru"))
     (setq go-guru-scope scope)))
 
-(defun go-guru--run (mode &optional need-scope)
+(defun go-guru--set-scope-if-empty ()
-  "Run the Go guru in the specified MODE, passing it the selected
+  (if (string-equal "" go-guru-scope)
-region of the current buffer.  If NEED-SCOPE, prompt for a scope
+      (go-guru-set-scope)))
-if not already set.  Mark up the output using `compilation-mode`,
-replacing each file name with a small hyperlink, and display the
-result."
-  (let ((output (go-guru--exec mode need-scope))
-	(display (get-buffer-create "*go-guru*"))
-	(dir default-directory))
-    (with-current-buffer display
-      (setq buffer-read-only nil)
-      (setq default-directory dir)
-      (erase-buffer)
-      (insert-buffer-substring output)
-      (go-guru--compilation-markup))))
 
-(defun go-guru--exec (mode &optional need-scope flags allow-unnamed)
+(defun go-guru--json (mode)
   "Execute the Go guru in the specified MODE, passing it the
-selected region of the current buffer. If NEED-SCOPE, prompt for
+selected region of the current buffer, requesting JSON output.
-a scope if not already set. If ALLOW-UNNAMED is non-nil, a
+Parse and return the resulting JSON object."
-synthetic file for the unnamed buffer will be created. This
+  ;; A "what" query works even in a buffer without a file name.
-should only be used with queries that work on single files
+  (let* ((filename (file-truename (or buffer-file-name "synthetic.go")))
-only (e.g. 'what'). If ALLOW-UNNAMED is nil and the buffer has no
+	 (cmd (go-guru--command mode filename '("-json")))
-associated name, an error will be signaled.
+	 (buf (current-buffer))
+	 ;; Use temporary buffers to avoid conflict with go-guru--start.
+	 (json-buffer (generate-new-buffer "*go-guru-json-output*"))
+	 (input-buffer (generate-new-buffer "*go-guru-json-input*")))
+    (unwind-protect
+	;; Run guru, feeding it the input buffer (modified files).
+	(with-current-buffer input-buffer
+	  (go-guru--insert-modified-files)
+	  (unless (buffer-file-name buf)
+	    (go-guru--insert-modified-file filename buf))
+	  (let ((exitcode (apply #'call-process-region
+				 (append (list (point-min)
+					       (point-max)
+					       (car cmd) ; guru
+					       nil ; delete
+					       json-buffer ; output
+					       nil) ; display
+					 (cdr cmd))))) ; args
+	    (with-current-buffer json-buffer
+	      (unless (zerop exitcode)
+		;; Failed: use buffer contents (sans final \n) as an error.
+		(error "%s" (buffer-substring (point-min) (1- (point-max)))))
+	      ;; Success: parse JSON.
+	      (goto-char (point-min))
+	      (json-read))))
+      ;; Clean up temporary buffers.
+      (kill-buffer json-buffer)
+      (kill-buffer input-buffer))))
 
-Return the output buffer."
+(define-compilation-mode go-guru-output-mode "Go guru"
-  (or
+  "Go guru output mode is a variant of `compilation-mode' for the
-   buffer-file-name
+output of the Go guru tool."
-   allow-unnamed
+  (set (make-local-variable 'compilation-error-screen-columns) nil)
+  (set (make-local-variable 'compilation-filter-hook) #'go-guru--compilation-filter-hook)
+  (set (make-local-variable 'compilation-start-hook) #'go-guru--compilation-start-hook))
+
+(defun go-guru--compilation-filter-hook ()
+  "Post-process a blob of input to the go-guru-output buffer."
+  ;; For readability, truncate each "file:line:col:" prefix to a fixed width.
+  ;; If the prefix is longer than 20, show "…/last/19chars.go".
+  ;; This usually includes the last segment of the package name.
+  ;; Hide the line and column numbers.
+  (let ((start compilation-filter-start)
+	(end (point)))
+    (goto-char start)
+    (unless (bolp)
+      ;; TODO(adonovan): not quite right: the filter may be called
+      ;; with chunks of output containing incomplete lines.  Moving to
+      ;; beginning-of-line may cause duplicate post-processing.
+      (beginning-of-line))
+    (setq start (point))
+    (while (< start end)
+      (let ((p (search-forward ": " end t)))
+	(if (null p)
+	    (setq start end) ; break out of loop
+	  (setq p (1- p)) ; exclude final space
+	  (let* ((posn (buffer-substring-no-properties start p))
+		 (flen (search ":" posn)) ; length of filename
+		 (filename (if (< flen 19)
+			       (substring posn 0 flen)
+			     (concat "…" (substring posn (- flen 19) flen)))))
+	    (put-text-property start p 'display filename)
+	    (forward-line 1)
+	    (setq start (point))))))))
+
+(defun go-guru--compilation-start-hook (proc)
+  "Erase default output header inserted by `compilation-mode'."
+  (with-current-buffer (process-buffer proc)
+    (let ((inhibit-read-only t))
+      (beginning-of-buffer)
+      (delete-region (point) (point-max)))))
+
+(defun go-guru--start (mode)
+  "Start an asynchronous Go guru process for the specified query
+MODE, passing it the selected region of the current buffer, and
+feeding its standard input with the contents of all modified Go
+buffers.  Its output is handled by `go-guru-output-mode', a
+variant of `compilation-mode'."
+  (or buffer-file-name
       (error "Cannot use guru on a buffer without a file name"))
-  (and need-scope
+  (let* ((filename (file-truename buffer-file-name))
-       (string-equal "" go-guru-scope)
+	 (cmd (combine-and-quote-strings (go-guru--command mode filename)))
-       (go-guru-set-scope))
+	 (process-connection-type nil) ; use pipe (not pty) so EOF closes stdin
-  (let* ((is-unnamed (not buffer-file-name))
+	 (procbuf (compilation-start cmd 'go-guru-output-mode)))
-	 (filename (file-truename (or buffer-file-name "synthetic.go")))
+    (with-current-buffer procbuf
-         (posn (if (use-region-p)
+      (setq truncate-lines t)) ; the output is neater without line wrapping
+    (with-current-buffer (get-buffer-create "*go-guru-input*")
+      (erase-buffer)
+      (go-guru--insert-modified-files)
+      (process-send-region procbuf (point-min) (point-max))
+      (process-send-eof procbuf))
+    procbuf))
+
+(defun go-guru--command (mode filename &optional flags)
+  "Return a command and argument list for a Go guru query of MODE, passing it
+the selected region of the current buffer.  FILENAME is the
+effective name of the current buffer."
+  (let* ((posn (if (use-region-p)
 		   (format "%s:#%d,#%d"
 			   filename
 			   (1- (go--position-bytes (region-beginning)))
 			   (1- (go--position-bytes (region-end))))
 		 (format "%s:#%d"
 			 filename
-			 (1- (position-bytes (point))))))
+			 (1- (go--position-bytes (point))))))
-         (env-vars (go-root-and-paths))
+	 (cmd (append (list go-guru-command
-         (goroot-env (concat "GOROOT=" (car env-vars)))
+			    "-modified"
-         (gopath-env (concat "GOPATH=" (mapconcat #'identity (cdr env-vars) ":")))
-         (output-buffer (get-buffer-create "*go-guru-output*"))
-         (buf (current-buffer)))
-    (with-current-buffer output-buffer
-      (setq buffer-read-only nil)
-      (erase-buffer))
-    (with-current-buffer (get-buffer-create "*go-guru-input*")
-      (setq buffer-read-only nil)
-      (erase-buffer)
-      (if is-unnamed
-	  (go-guru--insert-modified-file filename buf)
-        (go-guru--insert-modified-files))
-      (let* ((args (append (list "-modified"
 			    "-scope" go-guru-scope
-                                 "-tags" go-guru-build-tags)
+			    (format "-tags=%s" (mapconcat 'identity go-guru-build-tags ",")))
 		      flags
-			   (list mode posn))))
+		      (list mode
+			    posn))))
     ;; Log the command to *Messages*, for debugging.
     (when go-guru-debug
-	  (message "Command: %s:" args)
+      (message "go-guru--command: %s" cmd)
-	  (message nil) ; clears/shrinks minibuffer
+      (message nil)) ; clear/shrink minibuffer
-	  (message "Running guru %s..." mode))
+    cmd))
-	;; Use dynamic binding to modify/restore the environment
-	(let* ((process-environment (list* goroot-env gopath-env process-environment))
-	       (c-p-args (append (list (point-min)
-				       (point-max)
-				       go-guru-command
-				       nil ; delete
-				       output-buffer
-				       t)
-				 args))
-	       (exitcode (apply #'call-process-region c-p-args)))
-	  ;; If the command fails, don't show the output buffer,
-	  ;; but use its contents (sans final \n) as an error.
-	  (unless (zerop exitcode)
-	    (with-current-buffer output-buffer
-	      (bury-buffer)
-	      (error "%s" (buffer-substring (point-min) (1- (point-max)))))))))
-    output-buffer))
-
-(defun go-guru--compilation-markup ()
-  "Present guru output in the current buffer using `compilation-mode'."
-  (goto-char (point-max))
-  (insert "\n")
-  (compilation-mode)
-  (setq compilation-error-screen-columns nil)
-
-  ;; Hide the file/line info to save space.
-  ;; Replace each with a little widget.
-  ;; compilation-mode + this loop = slooow.
-  ;; TODO(adonovan): have guru give us JSON
-  ;; and we'll do the markup directly.
-  (let ((buffer-read-only nil)
-	(p 1))
-    (while (not (null p))
-      (let ((np (compilation-next-single-property-change p 'compilation-message)))
-	(if np
-	    (when (equal (line-number-at-pos p) (line-number-at-pos np))
-	      ;; Using a fixed width greatly improves readability, so
-	      ;; if the filename is longer than 20, show ".../last/17chars.go".
-	      ;; This usually includes the last segment of the package name.
-	      ;; Don't show the line or column number.
-	      (let* ((loc (buffer-substring p np)) ; "/home/foo/go/pkg/file.go:1:2-3:4"
-		     (i (search ":" loc)))
-		(setq loc (cond
-			   ((null i)  "...")
-			   ((>= i 17) (concat "..." (substring loc (- i 17) i)))
-			   (t         (substring loc 0 i))))
-		;; np is (typically) the space following ":"; consume it too.
-		(put-text-property p np 'display (concat loc ":")))
-	      (goto-char np)
-	      (insert " ")
-	      (incf np))) ; so we don't get stuck (e.g. on a panic stack dump)
-	(setq p np)))
-    (message nil))
-
-  (let ((w (display-buffer (current-buffer))))
-    (set-window-point w (point-min))))
 
 (defun go-guru--insert-modified-files ()
   "Insert the contents of each modified Go buffer into the
@@ -291,28 +296,31 @@ component will be ignored."
 (defun go-guru-callees ()
   "Show possible callees of the function call at the current point."
   (interactive)
-  (go-guru--run "callees" t))
+  (go-guru--set-scope-if-empty)
+  (go-guru--start "callees"))
 
 ;;;###autoload
 (defun go-guru-callers ()
   "Show the set of callers of the function containing the current point."
   (interactive)
-  (go-guru--run "callers" t))
+  (go-guru--set-scope-if-empty)
+  (go-guru--start "callers"))
 
 ;;;###autoload
 (defun go-guru-callstack ()
   "Show an arbitrary path from a root of the call graph to the
 function containing the current point."
   (interactive)
-  (go-guru--run "callstack" t))
+  (go-guru--set-scope-if-empty)
+  (go-guru--start "callstack"))
 
 ;;;###autoload
 (defun go-guru-definition ()
   "Jump to the definition of the selected identifier."
   (interactive)
-  (let* ((res (with-current-buffer (go-guru--exec "definition" nil '("-json"))
+  (or buffer-file-name
-		(goto-char (point-min))
+      (error "Cannot use guru on a buffer without a file name"))
-		(json-read)))
+  (let* ((res (go-guru--json "definition"))
 	 (desc (cdr (assoc 'desc res))))
     (push-mark)
     (ring-insert find-tag-marker-ring (point-marker))
@@ -323,54 +331,55 @@ function containing the current point."
 (defun go-guru-describe ()
   "Describe the selected syntax, its kind, type and methods."
   (interactive)
-  (go-guru--run "describe"))
+  (go-guru--start "describe"))
 
 ;;;###autoload
 (defun go-guru-pointsto ()
   "Show what the selected expression points to."
   (interactive)
-  (go-guru--run "pointsto" t))
+  (go-guru--set-scope-if-empty)
+  (go-guru--start "pointsto"))
 
 ;;;###autoload
 (defun go-guru-implements ()
   "Describe the 'implements' relation for types in the package
 containing the current point."
   (interactive)
-  (go-guru--run "implements"))
+  (go-guru--start "implements"))
 
 ;;;###autoload
 (defun go-guru-freevars ()
   "Enumerate the free variables of the current selection."
   (interactive)
-  (go-guru--run "freevars"))
+  (go-guru--start "freevars"))
 
 ;;;###autoload
 (defun go-guru-peers ()
   "Enumerate the set of possible corresponding sends/receives for
 this channel receive/send operation."
   (interactive)
-  (go-guru--run "peers" t))
+  (go-guru--set-scope-if-empty)
+  (go-guru--start "peers"))
 
 ;;;###autoload
 (defun go-guru-referrers ()
   "Enumerate all references to the object denoted by the selected
 identifier."
   (interactive)
-  (go-guru--run "referrers"))
+  (go-guru--start "referrers"))
 
 ;;;###autoload
 (defun go-guru-whicherrs ()
   "Show globals, constants and types to which the selected
 expression (of type 'error') may refer."
   (interactive)
-  (go-guru--run "whicherrs" t))
+  (go-guru--set-scope-if-empty)
+  (go-guru--start "whicherrs"))
 
 (defun go-guru-what ()
   "Run a 'what' query and return the parsed JSON response as an
 association list."
-  (with-current-buffer (go-guru--exec "what" nil '("-json") t)
+  (go-guru--json "what"))
-    (goto-char (point-min))
-    (json-read)))
 
 (defun go-guru--hl-symbols (posn face id)
   "Highlight the symbols at the positions POSN by creating
@@ -490,4 +499,9 @@ end point."
 
 (provide 'go-guru)
 
+;; Local variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End
+
 ;;; go-guru.el ends here