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

	    (when (string-match-p "[[: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)
	    ;; 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.
			(let* ((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))
			  ;; 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 (re-search-forward "[\n]" nil t)))
			      (tramp-accept-process-output p 0))
			    (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)
			    (with-current-buffer stderr
			      (insert-file-contents-literally
			       remote-tmpstderr 'visit))
			    ;; Delete tmpstderr file.
			    (add-function
			     :after (process-sentinel p)
			     (lambda (_proc _msg)
			       (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 (tramp-get-connection-process v) nil)
		      (kill-buffer (current-buffer)))
		  (set-buffer-modified-p bmp))
		(tramp-flush-connection-property v "process-name")
		(tramp-flush-connection-property v "process-buffer")))))))))