Function: tramp-adb-handle-make-process
tramp-adb-handle-make-process is a byte-compiled function defined in
tramp-adb.el.gz.
Signature
(tramp-adb-handle-make-process &rest ARGS)
Documentation
Like make-process for Tramp files.
If method parameter tramp-direct-async and connection property
"direct-async-process" are non-nil, an alternative
implementation will be used.
Source Code
;; Defined in /usr/src/emacs/lisp/net/tramp-adb.el.gz
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
;; The complete STDERR buffer is available only when the process has
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
If method parameter `tramp-direct-async' and connection property
\"direct-async-process\" are non-nil, an alternative
implementation will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
(buffer (plist-get args :buffer))
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
(connection-type
(or (plist-get args :connection-type) process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (bufferp buffer) (string-or-null-p buffer))
(signal 'wrong-type-argument (list #'bufferp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
(and (symbolp coding) (memq coding coding-system-list))
(and (consp coding)
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
(when (eq connection-type t)
(setq connection-type 'pty))
(unless (or (and (consp connection-type)
(memq (car connection-type) '(nil pipe pty))
(memq (cdr connection-type) '(nil pipe pty)))
(memq connection-type '(nil pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (eq filter t) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (bufferp stderr) (string-or-null-p stderr))
(signal 'wrong-type-argument (list #'bufferp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(if (and (stringp stderr) (tramp-tramp-file-p stderr))
(tramp-unquote-file-local-name stderr)
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(orig-command command)
(program (car command))
(args (cdr command))
(command
(format "cd %s && exec %s %s"
(tramp-shell-quote-argument localname)
(if tmpstderr (format "2>'%s'" tmpstderr) "")
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))
(tramp-process-connection-type
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0)
p)
(when (string-match-p (tramp-compat-rx multibyte) command)
(tramp-error
v 'file-error "Cannot apply multi-byte command `%s'" command))
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise, `make-process'
;; could be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
;; contents. Clear also the modification
;; time; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(coding-system-for-write
(if (symbolp coding) coding (car coding)))
(coding-system-for-read
(if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection',
;; in order to cleanup the prompt afterwards.
(tramp-adb-maybe-open-connection v)
(delete-region (point-min) (point-max))
;; Send the command.
(setq p (tramp-get-connection-process v))
(tramp-adb-send-command v command nil t) ; nooutput
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
(process-put p 'remote-command orig-command)
(tramp-set-connection-property
p "remote-command" orig-command)
;; Set query flag and process marker for
;; this process. We ignore errors, because
;; the process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point))
;; We must flush them here already;
;; otherwise `rename-file', `delete-file'
;; or `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property
v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Read initial output. Remove the first
;; line, which is the command echo.
(unless (eq filter t)
(while
(progn
(goto-char (point-min))
(not (search-forward "\n" nil t)))
(tramp-accept-process-output p))
(delete-region (point-min) (point)))
;; Provide error buffer. This shows only
;; initial error messages; messages
;; arriving later on will be inserted when
;; the process is deleted. The temporary
;; file will exist until the process is
;; deleted.
(when (bufferp stderr)
(ignore-errors
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit)))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(ignore-errors
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit nil nil 'replace))
(delete-file remote-tmpstderr)))))
;; Return process.
p))))
;; Save exit.
(if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp)))))))))))