diff options
Diffstat (limited to '.emacs.d/init.el')
| -rw-r--r-- | .emacs.d/init.el | 94 |
1 files changed, 63 insertions, 31 deletions
diff --git a/.emacs.d/init.el b/.emacs.d/init.el index e66dd3ad..2b955f63 100644 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -2274,40 +2274,72 @@ Called by '~/src/dotfiles/bin/emacsclient --spw/update-environment'." (let ((slime-dispatching-connection connection)) (slime-eval cl-form)))))) -(defvar-local spw/gdbmacs-target-emacs nil) - -(defun spw/gdbmacs-attach (pid) - (interactive "nEmacs PID: ") - (when-let ((proc (and (boundp 'gud-comint-buffer) - (get-buffer-process gud-comint-buffer)))) - (if (string= gdb-inferior-status "signal-received") - ;; Avoid wiping out useful info. - (error "Possibly Emacs just crashed; not attaching for now") - (set-process-query-on-exit-flag proc nil) - (kill-buffer gud-comint-buffer))) - (require 'gdb-mi) - (let ((default-directory (expand-file-name "~/src/emacs/"))) - (gdb-reset) - (gdb (format "gdb -i=mi --pid=%d src/emacs" pid)) - (setq spw/gdbmacs-target-emacs pid) - (gud-basic-call "continue"))) - -(defun spw/remote-gdbmacs-attach () - (interactive) - (call-process "emacsclient" nil "*gdbmacs-emacsclient*" nil - "--socket-name=gdbmacs" "--spw/installed" - "-e" (prin1-to-string `(spw/gdbmacs-attach ,(emacs-pid))))) - -(defun spw/maybe-remote-gdbmacs-attach () - (when (and (eq (daemonp) t) - (file-in-directory-p invocation-directory "~/src/emacs/")) - (spw/remote-gdbmacs-attach))) -(add-hook 'after-init-hook #'spw/maybe-remote-gdbmacs-attach) +(defun spw/daemon-pid (&optional name) + ;; We don't use `server-eval-at' because perhaps we are trying to attach gdb + ;; to a wedged Emacs. + (let ((socket (file-name-concat server-socket-dir (or name "server")))) + (and (file-exists-p socket) + (and-let* ((output (car (process-lines "ss" "-Hplx" "src" socket)))) + (and (string-match "pid=\\([[:digit:]]+\\)" output) + (string-to-number (match-string 1 output))))))) + +(defvar-local spw/gdbmacs-target-pid nil) +(defvar-local spw/gdbmacs-target-name nil) + +(defun spw/gdbmacs-attach (&optional name) + (let (pid + (arg (if name (concat "--fg-daemon=" name) "--fg-daemon")) + (proc (and (boundp 'gud-comint-buffer) + (get-buffer-process gud-comint-buffer)))) + (when (and proc (string= gdb-inferior-status "signal-received")) + ;; Avoid wiping out useful info. + (error "Possibly Emacs just crashed; not attaching for now")) + (require 'gdb-mi) + (cl-flet ((run-or-continue () + (gdb-wait-for-pending + (lambda () + (with-current-buffer gud-comint-buffer + (setq spw/gdbmacs-target-pid pid + spw/gdbmacs-target-name name)) + (if pid + (gud-basic-call "continue") + (gud-basic-call "set cwd ~") + (gdb-wait-for-pending + (lambda () (gud-basic-call "run")))))))) + (gdb-wait-for-pending + (if (and proc + ;; Check it looks safe to re-use existing gdb process. + (string-prefix-p "exited" gdb-inferior-status) + (file-in-directory-p + (buffer-local-value 'default-directory gud-comint-buffer) + (expand-file-name "~/src/emacs/"))) + (lambda () + (gud-basic-call (if (setq pid (spw/daemon-pid name)) + (format "attach %d" pid) + (format "set args %s" arg))) + (run-or-continue)) + ;; Start up a new process. + (lambda () + (when (buffer-live-p gud-comint-buffer) + (when proc (set-process-query-on-exit-flag proc nil)) + (kill-buffer gud-comint-buffer)) + (gdb-wait-for-pending + (lambda () + (let ((default-directory (expand-file-name "~/src/emacs/"))) + (gdb (if (setq pid (spw/daemon-pid name)) + (format "gdb -i=mi --pid=%d src/emacs" pid) + (format "gdb -i=mi --args src/emacs %s" arg)))) + (run-or-continue))))))))) ;; C-c C-z to attempt to return control to the debugger. +;; +;; In the --fg-daemon case, AIUI we are here working around this: +;; <https://lwn.net/Articles/909496/>. (defun spw/comint-stop-subjob (orig-fun) - (if spw/gdbmacs-target-emacs - (signal-process spw/gdbmacs-target-emacs 'SIGTSTP) + (if-let ((pid (or spw/gdbmacs-target-pid + (setq spw/gdbmacs-target-pid + (spw/daemon-pid spw/gdbmacs-target-name))))) + (signal-process pid 'SIGTSTP) (funcall orig-fun))) (advice-add 'comint-stop-subjob :around #'spw/comint-stop-subjob) |