From: Tom Tromey <tom@tromey.com>
Date: Fri, 6 Oct 2017 20:36:44 +0000 (-0600)
Subject: Asynchronous insertion for dwarf-mode.el
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c85fa91b5c0dc70641d75d6ab9315ad547487c1f;p=binutils-gdb.git

Asynchronous insertion for dwarf-mode.el

I was recently examining a very large .debug file.  I tried to use
dwarf-mode, but it blocked Emacs for a very long time while reading
output.

This patch changes dwarf-mode to run the objdump process asynchronously.
This way, I can still do other things in Emacs while waiting for the
dumping to finish.

2017-10-10  Tom Tromey  <tom@tromey.com>

	* dwarf-mode.el (dwarf--process, dwarf--deletion-region): New
	defvar.
	(dwarf--check-running, dwarf--sentinel, dwarf--invoke)
	(dwarf--filter): New functions.
	(dwarf-do-insert-substructure, dwarf-do-refresh): Call
	dwarf--check-running, dwarf--invoke.
	(dwarf-browse): Initialize new variables.
---

diff --git a/binutils/ChangeLog b/binutils/ChangeLog
index 47e5fa85db6..90d1996b6a4 100644
--- a/binutils/ChangeLog
+++ b/binutils/ChangeLog
@@ -1,3 +1,13 @@
+2017-10-10  Tom Tromey  <tom@tromey.com>
+
+	* dwarf-mode.el (dwarf--process, dwarf--deletion-region): New
+	defvar.
+	(dwarf--check-running, dwarf--sentinel, dwarf--invoke)
+	(dwarf--filter): New functions.
+	(dwarf-do-insert-substructure, dwarf-do-refresh): Call
+	dwarf--check-running, dwarf--invoke.
+	(dwarf-browse): Initialize new variables.
+
 2017-10-10  Tom Tromey  <tom@tromey.com>
 
 	* dwarf-mode.el: Set lexical-binding.
diff --git a/binutils/dwarf-mode.el b/binutils/dwarf-mode.el
index dc6834826e4..625e30d4e87 100644
--- a/binutils/dwarf-mode.el
+++ b/binutils/dwarf-mode.el
@@ -37,21 +37,63 @@
 (defvar dwarf-file nil
   "Buffer-local variable holding the file name passed to objdump.")
 
+(defvar dwarf--process nil
+  "Running objdump process, or nil.")
+
+(defvar dwarf--deletion-region nil
+  "Region to delete before inserting text in `dwarf--filter'.")
+
+(defun dwarf--check-running ()
+  "Throw an exception if an objdump process is already running."
+  (when dwarf--process
+    (error "An objdump process is still running in this buffer")))
+
+(defun dwarf--filter (proc string)
+  "Filter function for objdump processes."
+  (when (buffer-live-p (process-buffer proc))
+    (with-current-buffer (process-buffer proc)
+      (save-excursion
+	(let ((inhibit-read-only t))
+	  (when dwarf--deletion-region
+	    (apply #'delete-region dwarf--deletion-region)
+	    (setq dwarf--deletion-region nil))
+          (goto-char (process-mark proc))
+          (insert string)
+          (set-marker (process-mark proc) (point))
+	  (set-buffer-modified-p nil))))))
+
+(defun dwarf--sentinel (_proc _status)
+  (setq mode-line-process nil)
+  (setq dwarf--process nil))
+
+(defun dwarf--invoke (start end &rest command)
+  "Invoke a command and arrange to insert output into the current buffer."
+  (setq mode-line-process "[Running]")
+  (setq dwarf--deletion-region (list start end))
+  (setq dwarf--process (make-process :name "objdump"
+				     :buffer (current-buffer)
+				     :command command
+				     :connection-type 'pipe
+				     :noquery t
+				     :filter #'dwarf--filter
+				     :sentinel #'dwarf--sentinel))
+  (set-marker (process-mark dwarf--process) (point)))
+
 ;; Expand a "..." to show all the child DIES.  NEW-DEPTH controls how
 ;; deep to display the new dies; `nil' means display all of them.
 (defun dwarf-do-insert-substructure (new-depth die)
+  (dwarf--check-running)
   (let ((inhibit-read-only t))
     (beginning-of-line)
-    (delete-region (point) (progn
-			     (end-of-line)
-			     (forward-char)
-			     (point)))
-    (save-excursion
-      (apply #'call-process dwarf-objdump-program nil (current-buffer) nil
-	     "-Wi" (concat "--dwarf-start=0x" die)
-	     (expand-file-name dwarf-file)
-	     (if new-depth (list (concat "--dwarf-depth="
-					 (int-to-string new-depth))))))
+    (apply #'dwarf--invoke
+	   (point) (save-excursion
+		     (end-of-line)
+		     (forward-char)
+		     (point))
+	   dwarf-objdump-program "-Wi" (concat "--dwarf-start=0x" die)
+	   (expand-file-name dwarf-file)
+	   (if new-depth (list (concat "--dwarf-depth="
+				       (int-to-string new-depth)))))
     (set-buffer-modified-p nil)))
 
 (defun dwarf-insert-substructure-button (die)
@@ -132,13 +174,11 @@ A prefix argument means expand all children."
 ;; are the way they are because this is also called as a
 ;; revert-buffer-function.
 (defun dwarf-do-refresh (&rest ignore)
+  (dwarf--check-running)
   (let ((inhibit-read-only t))
-    (erase-buffer)
-    (save-excursion
-      (call-process dwarf-objdump-program
-		    nil (current-buffer) nil
-		    "-Wi" "--dwarf-depth=1"
-		    (expand-file-name dwarf-file)))
+    (dwarf--invoke (point-min) (point-max)
+		   dwarf-objdump-program "-Wi" "--dwarf-depth=1"
+		   (expand-file-name dwarf-file))
     (set-buffer-modified-p nil)))
 
 (defvar dwarf-mode-map
@@ -169,6 +209,8 @@ This is the main interface to `dwarf-mode'."
     (dwarf-mode)
     (setq default-directory (file-name-directory file))
     (set (make-local-variable 'dwarf-file) file)
+    (set (make-local-variable 'dwarf--process) nil)
+    (set (make-local-variable 'dwarf--deletion-region) nil)
     (dwarf-do-refresh)))
 
 (provide 'dwarf-mode)