Function: ange-ftp-copy-file-internal

ange-ftp-copy-file-internal is a byte-compiled function defined in ange-ftp.el.gz.

Signature

(ange-ftp-copy-file-internal FILENAME NEWNAME OK-IF-ALREADY-EXISTS KEEP-DATE &optional MSG CONT NOWAIT)

Source Code

;; Defined in /usr/src/emacs/lisp/net/ange-ftp.el.gz
;; async local copy commented out for now since I don't seem to get
;; the process sentinel called for some processes.
;;
;; (defun ange-ftp-copy-file-locally (filename newname ok-if-already-exists
;;                                          keep-date cont)
;;   "Kludge to copy a local file and call a continuation when the copy
;; finishes."
;;   ;; check to see if we can overwrite
;;   (if (or (not ok-if-already-exists)
;;        (numberp ok-if-already-exists))
;;       (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
;;                                           (numberp ok-if-already-exists)))
;;   (let ((proc (start-process " *copy*"
;;                           (generate-new-buffer "*copy*")
;;                           "cp"
;;                           filename
;;                           newname))
;;      res)
;;     (set-process-sentinel proc 'ange-ftp-copy-file-locally-sentinel)
;;     (set-process-query-on-exit-flag proc nil)
;;     (with-current-buffer (process-buffer proc)
;;       (setq-local copy-cont cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
;;   (with-current-buffer (process-buffer proc)
;;     (let ((cont copy-cont)
;;        (result (buffer-string)))
;;       (unwind-protect
;;        (if (and (string-equal status "finished\n")
;;                 (zerop (length result)))
;;            (ange-ftp-call-cont cont t nil)
;;          (ange-ftp-call-cont cont
;;                              nil
;;                              (if (zerop (length result))
;;                                  (substring status 0 -1)
;;                                (substring result 0 -1))))
;;      (kill-buffer (current-buffer))))))

;; this is the extended version of ange-ftp-copy-file-internal that works
;; asynchronously if asked nicely.
(defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists
					     keep-date &optional msg cont nowait)
  (setq filename (expand-file-name filename)
	newname (expand-file-name newname))

  (or (file-exists-p filename)
      (signal 'file-missing
	      (list "Copy file" "No such file or directory" filename)))

  (and (not ok-if-already-exists) (file-exists-p newname)
       (signal 'file-already-exists (list newname)))

  (and (file-directory-p newname) (not (directory-name-p newname))
       (signal 'file-error (list "File is a directory %s" newname)))

  ;; canonicalize newname if a directory.
  (if (file-directory-p newname)
      (setq newname (expand-file-name (file-name-nondirectory filename) newname)))

  (let ((f-parsed (ange-ftp-ftp-name filename))
	(t-parsed (ange-ftp-ftp-name newname)))

    ;; local file to local file copy?
    (if (and (not f-parsed) (not t-parsed))
	(progn
	  (ange-ftp-real-copy-file filename newname ok-if-already-exists
				   keep-date)
	  (if cont
	      (ange-ftp-call-cont cont t "Copied locally")))
      ;; one or both files are remote.
      (let* ((f-host (and f-parsed (nth 0 f-parsed)))
	     (f-user (and f-parsed (nth 1 f-parsed)))
	     (f-name (and f-parsed (ange-ftp-quote-string (nth 2 f-parsed))))
	     (f-abbr (ange-ftp-abbreviate-filename filename))
	     (t-host (and t-parsed (nth 0 t-parsed)))
	     (t-user (and t-parsed (nth 1 t-parsed)))
	     (t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
	     (t-abbr (ange-ftp-abbreviate-filename newname filename))
	     (binary (or (ange-ftp-binary-file filename)
			 (ange-ftp-binary-file newname)))
	     temp1
	     ) ;; temp2

	;; check to see if we can overwrite
	(if (or (not ok-if-already-exists)
		(numberp ok-if-already-exists))
	    (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
						   (numberp ok-if-already-exists)))

	;; do the copying.
	(if f-parsed

	    ;; filename was remote.
	    (progn
	      (if (or (ange-ftp-use-gateway-p f-host)
		      t-parsed)
		  ;; have to use intermediate file if we are getting via
		  ;; gateway machine or we are doing a remote to remote copy.
		  (setq temp1 (ange-ftp-make-tmp-name f-host)))

	      (if binary
		  (ange-ftp-set-binary-mode f-host f-user))

	      (ange-ftp-send-cmd
	       f-host
	       f-user
	       (list 'get f-name (or temp1 (ange-ftp-quote-string newname)))
	       (or msg
		   (if (and temp1 t-parsed)
		       (format "Getting %s" f-abbr)
		     (format "Copying %s to %s" f-abbr t-abbr)))
	       (list 'ange-ftp-cf1
		     filename newname binary msg
		     f-parsed f-host f-user f-name f-abbr
		     t-parsed t-host t-user t-name t-abbr
		     temp1 nil cont nowait) ;; temp2
	       nowait))

	  ;; filename wasn't remote.  newname must be remote.  call the
	  ;; function which does the remainder of the copying work.
	  (ange-ftp-cf1 t nil
			filename newname binary msg
			f-parsed f-host f-user f-name f-abbr
			t-parsed t-host t-user t-name t-abbr
			nil nil cont nowait))))))