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.
This commit is contained in:
Tom Tromey 2017-10-06 14:36:44 -06:00
parent e4905c7464
commit c85fa91b5c
2 changed files with 68 additions and 16 deletions

View File

@ -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.

View File

@ -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)