Function: dape--create-connection
dape--create-connection is a natively compiled function defined in
dape.el.
Signature
(dape--create-connection CONFIG &optional PARENT)
Documentation
Create symbol dape-connection(var)/dape-connection(fun) instance from CONFIG.
If started by an startDebugging request expects PARENT to
symbol dape-connection(var)/dape-connection(fun).
Source Code
;; Defined in /nix/store/1fiaif8pifqj2jh65rbg3fkhg3i56q42-emacs-packages-deps/share/emacs/site-lisp/elpa/dape-0.27.1/dape.el
(defun dape--create-connection (config &optional parent)
"Create symbol `dape-connection' instance from CONFIG.
If started by an startDebugging request expects PARENT to
symbol `dape-connection'."
(unless (plist-get config 'command-cwd)
(plist-put config 'command-cwd (dape--guess-root config)))
(let ((default-directory (plist-get config 'command-cwd))
(process-environment (cl-copy-list process-environment))
(command (cons (plist-get config 'command)
(cl-map 'list 'identity
(plist-get config 'command-args))))
process server-process stderr-buffer)
;; Initialize `process-environment' from `command-env'
(cl-loop for (key value) on (plist-get config 'command-env) by 'cddr do
(setenv (pcase key
((pred keywordp) (substring (format "%s" key) 1))
((or (pred symbolp) (pred stringp)) (format "%s" key))
(_ (user-error "Bad type for `command-env' key %S" key)))
(format "%s" value)))
(cond
(;; Socket connection
(plist-get config 'port)
;; 1. Start server
(when (plist-get config 'command)
(setq stderr-buffer
(with-current-buffer
(generate-new-buffer " *dape-adapter stderr*")
(when (plist-get config 'command-insert-stderr)
(add-hook 'after-change-functions
(lambda (beg end _pre-change-len)
(dape--repl-insert-error
(buffer-substring beg end)))
nil t))
(current-buffer))
server-process
(make-process :name "dape adapter"
:command command
:filter (lambda (_process string)
(dape--repl-insert string))
:file-handler t
:buffer nil
:stderr stderr-buffer))
(process-put server-process 'stderr-pipe stderr-buffer)
;; XXX Tramp does not allow `make-pipe-process' as :stderr,
;; `make-process' creates one for us with an unwanted
;; sentinel (`internal-default-process-sentinel').
(when-let* ((pipe-process (get-buffer-process stderr-buffer)))
(set-process-sentinel pipe-process #'ignore))
(when dape-debug
(dape--message "Adapter server started with %S"
(mapconcat #'identity command " "))))
;; FIXME Why do I need this?
(when (file-remote-p default-directory)
(sleep-for 0.300))
;; 2. Connect to server
(let ((host (or (plist-get config 'host) "localhost"))
(retries 30))
(while (and (not process) (> retries 0))
(ignore-errors
(setq process
(make-network-process :name
(format "dape adapter%s connection"
(if parent " child" ""))
:host host
:coding 'utf-8-emacs-unix
:service (plist-get config 'port)
:noquery t)))
(sleep-for 0.100)
(setq retries (1- retries)))
(if (zerop retries)
(progn
(dape--warn "Unable to connect to dap server at %s:%d"
host (plist-get config 'port))
(dape--message "Connection is configurable by `host' and `port' keys")
;; Barf server stderr
(when-let* (server-process
(buffer (process-get server-process 'stderr-pipe))
(content (with-current-buffer buffer (buffer-string)))
((not (string-empty-p content))))
(dape--repl-insert-error (concat content "\n")))
(delete-process server-process)
(user-error "Unable to connect to server"))
(when dape-debug
(dape--message "%s to adapter established at %s:%s"
(if parent "Child connection" "Connection")
host (plist-get config 'port))))))
(;; Pipe connection
t
(let ((command
(cons (plist-get config 'command)
(cl-map 'list 'identity
(plist-get config 'command-args)))))
(setq process
(make-process :name "dape adapter"
:command command
:connection-type 'pipe
:coding 'utf-8-emacs-unix
:stderr
(setq stderr-buffer
(generate-new-buffer "*dape-connection stderr*"))
:file-handler t))
(when dape-debug
(dape--message "Adapter started with %S"
(mapconcat #'identity command " "))))))
(dape-connection
:name (format "dape-%s<%d>"
(or (and (car command) command)
(when-let* ((port (plist-get config 'port)))
(format "%s:%s"
(or (plist-get config 'host) "localhost")
port)))
(cl-incf dape--connection-counter))
:config config
:parent parent
:server-process server-process
:events-buffer-config `(:size ,(if dape-debug nil 0) :format full)
:on-shutdown
(lambda (conn)
(unless (dape--initialized-p conn)
(dape--warn "Adapter %sconnection shutdown without successfully initializing"
(if (dape--parent conn) "child " "")))
;; Is this a complete shutdown?
(unless (dape--parent conn)
;; Clean source buffer
(dape--stack-frame-cleanup)
;; Kill server process and its stderr buffer
(when-let* ((server-process (dape--server-process conn)))
(delete-process server-process)
(while (process-live-p server-process)
(accept-process-output nil nil 0.1)))
(when-let* ((buf (dape--stderr-buffer conn))
((buffer-live-p buf)))
(when-let* ((pipe (get-buffer-process buf)))
(delete-process pipe))
(kill-buffer buf))
;; Remove from session list and update selection
(setq dape--connections (delq conn dape--connections))
(when (eq dape--connection-selected conn)
(when-let* ((next (car (dape--live-connections-root))))
(dape-select-session next)))
;; Run hooks and update mode line only when last session ends
(unless dape--connections
(dape-active-mode -1)
(force-mode-line-update t))))
:request-dispatcher #'dape-handle-request
:notification-dispatcher #'dape-handle-event
:process process
:stderr-buffer stderr-buffer)))