Function: cvs-run-process

cvs-run-process is a byte-compiled function defined in pcvs.el.gz.

Signature

(cvs-run-process ARGS FIS POSTPROCESS &optional SINGLE-DIR)

Source Code

;; Defined in /usr/src/emacs/lisp/vc/pcvs.el.gz
;;      (funcall (if (and (boundp 'pop-up-frames) pop-up-frames)
;;		   'pop-to-buffer 'switch-to-buffer)
;;	       cvsbuf))))

(defun cvs-run-process (args fis postprocess &optional single-dir)
  (cl-assert (cvs-buffer-p cvs-buffer))
  (save-current-buffer
    (let ((procbuf (current-buffer))
	  (cvsbuf cvs-buffer)
	  (single-dir (or single-dir (eq cvs-execute-single-dir t))))

      (set-buffer procbuf)
      (goto-char (point-max))
      (unless (bolp) (let ((inhibit-read-only t)) (insert "\n")))
      ;; find the set of files we'll process in this round
      (let* ((dir+files+rest
	      (if (or (null fis) (not single-dir))
		  ;; not single-dir mode: just process the whole thing
		  (list "" (mapcar #'cvs-fileinfo->full-name fis) nil)
		;; single-dir mode: extract the same-dir-elements
		(let ((dir (cvs-fileinfo->dir (car fis))))
		  ;; output the concerned dir so the parser can translate paths
		  (let ((inhibit-read-only t))
		    (insert "pcl-cvs: descending directory " dir "\n"))
		  ;; loop to find the same-dir-elems
		  (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
                           (fis fis (cdr fis))
                           (fi (car fis) (car fis)))
		      ((not (and fis (string= dir (cvs-fileinfo->dir fi))))
		       (list dir files fis))))))
	     (dir (nth 0 dir+files+rest))
	     (files (nth 1 dir+files+rest))
	     (rest (nth 2 dir+files+rest)))

	(add-hook 'kill-buffer-hook
		  (lambda ()
		    (let ((proc (get-buffer-process (current-buffer))))
		      (when (processp proc)
			(set-process-filter proc nil)
			;; Abort postprocessing but leave the sentinel so it
			;; will update the list of running procs.
			(process-put proc 'cvs-postprocess nil)
			(interrupt-process proc))))
		  nil t)

	;; create the new process and setup the procbuffer correspondingly
	(let* ((msg (cvs-header-msg args fis))
	       (args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
			     (if cvs-cvsroot (list "-d" cvs-cvsroot))
			     args
			     files))
	       ;; If process-connection-type is nil and the repository
	       ;; is accessed via SSH, a bad interaction between libc,
	       ;; CVS and SSH can lead to garbled output.
	       ;; It might be a glibc-specific problem (but it can also happens
	       ;; under macOS, it seems).
	       ;; It seems that using a pty can help circumvent the problem,
	       ;; but at the cost of screwing up when the process thinks it
	       ;; can ask for user input (such as password or host-key
	       ;; confirmation).  A better workaround is to set CVS_RSH to
	       ;; an appropriate script, or to use a later version of CVS.
	       (process-connection-type nil) ; Use a pipe, not a pty.
	       (process
		;; the process will be run in the selected dir
		(let ((default-directory (cvs-expand-dir-name dir)))
		  (apply 'start-file-process "cvs" procbuf cvs-program args))))
	  ;; setup the process.
	  (process-put process 'cvs-buffer cvs-buffer)
	  (with-current-buffer cvs-buffer (cvs-update-header msg 'add))
	  (process-put process 'cvs-header msg)
	  (process-put
	   process 'cvs-postprocess
	   (if (null rest)
	       ;; this is the last invocation
               postprocess
	     ;; else, we have to register ourselves to be rerun on the rest
	     (lambda () (cvs-run-process args rest postprocess single-dir))))
	  (set-process-sentinel process 'cvs-sentinel)
	  (set-process-filter process 'cvs-update-filter)
	  (set-marker (process-mark process) (point-max))
	  (ignore-errors (process-send-eof process)) ;close its stdin to avoid hangs

	  ;; now finish setting up the cvs-buffer
	  (set-buffer cvsbuf)
	  (setq cvs-mode-line-process (symbol-name (process-status process)))
	  (force-mode-line-update)))))

  ;; The following line is said to improve display updates on some
  ;; emacsen. It shouldn't be needed, but it does no harm.
  (sit-for 0))