Actually, there was a stupid bug in my code where set-file-modes
was returning the integer return status of the `chmod' rather
than throwing an error if the chmod failed.
In the mean time, I've implemented file-ownership-preserved-p and
cleaned up my current "new VC" patch a little.
Also, I've noticed that jka-compr doesn't seem to work over rcp.el.
Maybe it's just a question of ordering in the file-name-handler-alist,
but in any case, opening /r@ru:foohost:file.gz gave me just the binary
content.
BTW, does any one have a clue as to why I sometimes get errors
where zerop is applied to the symbol `hello' (typically returned
from rcp-run-test) ?
Looking at the *rcp <host>* buffer when the error is raised, it
contains something like
hello
0
//////
Why did Emacs read the `hello' instead of the `0' ?
Stefan
Index: rcp.el
===================================================================
RCS file: /services/emacs-rcp/cvsroot/rcp/lisp/rcp.el,v
retrieving revision 1.276
diff -u -u -r1.276 rcp.el
--- rcp.el 2000/04/23 10:36:14 1.276
+++ rcp.el 2000/04/25 16:33:06
@@ -644,6 +644,7 @@
(integer :tag "Paren pair for host name ")
(integer :tag "Paren pair for file name ")))
+;;;###autoload
(defcustom rcp-file-name-regexp "\\`/r[@:]"
"*Regular expression matching file names handled by rcp.
This regexp should match rcp file names but no other file names.
@@ -856,6 +857,7 @@
(file-regular-p . rcp-handle-file-regular-p)
(file-symlink-p . rcp-handle-file-symlink-p)
(file-writable-p . rcp-handle-file-writable-p)
+ (file-ownership-preserved-p . rcp-handle-file-ownership-preserved-p)
(file-attributes . rcp-handle-file-attributes)
(file-modes . rcp-handle-file-modes)
(file-directory-files . rcp-handle-file-directory-files)
@@ -865,6 +867,7 @@
(add-name-to-file . rcp-handle-add-name-to-file)
(copy-file . rcp-handle-copy-file)
(rename-file . rcp-handle-rename-file)
+ (set-file-modes . rcp-handle-set-file-modes)
(make-directory . rcp-handle-make-directory)
(delete-directory . rcp-handle-delete-directory)
(delete-file . rcp-handle-delete-file)
@@ -1062,6 +1065,26 @@
-1 ;hm?
))))
+(defun rcp-handle-set-file-modes (filename mode)
+ "Like `set-file-modes' for rcp files."
+ (let ((v (rcp-dissect-file-name filename)))
+ (save-excursion
+ (rcp-send-command
+ (rcp-file-name-multi-method v) (rcp-file-name-method v)
+ (rcp-file-name-user v) (rcp-file-name-host v)
+ (format "chmod %s %s ; echo $?"
+ (rcp-decimal-to-octal mode)
+ (rcp-shell-quote-argument (rcp-file-name-path v))))
+ (rcp-wait-for-output)
+ (goto-char (point-max))
+ (forward-line -1)
+ (unless (zerop (read (current-buffer)))
+ (signal 'file-error
+ (list "Doing chmod"
+ ;; FIXME: extract the proper text from chmod's stderr.
+ "error while changing file's mode"
+ filename))))))
+
;; Simple functions using the `test' command.
(defun rcp-handle-file-executable-p (filename)
@@ -1107,7 +1130,12 @@
;; If file doesn't exist, check if directory is writable.
(and (zerop (rcp-run-test "-d" (rcp-handle-file-name-directory filename)))
(zerop (rcp-run-test "-w" (rcp-handle-file-name-directory filename))))))
-
+
+(defun rcp-handle-file-ownership-preserved-p (filename)
+ "Like `file-ownership-preserved-p' for rcp files."
+ (or (not (rcp-handle-file-exists-p filename))
+ ;; Existing files must be writable.
+ (zerop (rcp-run-test "-O" filename))))
;; Other file name ops.
@@ -2050,6 +2078,7 @@
;; Main function.
+;;;###autoload
(defun rcp-file-name-handler (operation &rest args)
"Invoke rcp file name handler.
Falls back to normal file name handler if no rcp file name handler exists."
@@ -2060,12 +2089,10 @@
(rcp-run-real-handler operation args))))
;; Register in file name handler alist
+;;;###autoload
+(add-to-list 'file-name-handler-alist
+ (cons rcp-file-name-regexp 'rcp-file-name-handler))
-(defun rcp-setup-file-name-handler-alist ()
- (add-to-list 'file-name-handler-alist
- (cons rcp-file-name-regexp 'rcp-file-name-handler)))
-(rcp-setup-file-name-handler-alist)
-
;;; Interactions with other packages:
;; -- complete.el --
@@ -2256,6 +2283,8 @@
;; This is needed to handle remote VC correctly - else we test against the
;; local VC system and get things wrong...
;; Daniel Pittman <[EMAIL PROTECTED]>
+(if (fboundp 'vc-call-backend)
+ () ;; This is the new VC for which we don't have an appropriate advice yet
(defadvice vc-do-command
(around rcp-advice-vc-do-command
(buffer okstatus command file last &rest flags)
@@ -2267,7 +2296,7 @@
(setq ad-return-value
(apply 'rcp-vc-do-command buffer okstatus command
(or file (buffer-file-name)) last flags))
- ad-do-it)))
+ ad-do-it))))
;; XEmacs uses this to do some of its work. Like vc-do-command, we
@@ -2324,6 +2353,7 @@
(error "Couldn't find version control information")))
exec-status)))
+;; This function does not exist any more in Emacs-21's VC
(defadvice vc-simple-command
(around rcp-advice-vc-simple-command
(okstatus command file &rest args)
@@ -2350,6 +2380,8 @@
(not want-differences-if-changed))))
(zerop status)))
+(if (not (fboundp 'vc-backend-diff))
+ () ;; our replacement won't work anyway
(defadvice vc-workfile-unchanged-p
(around rcp-advice-vc-workfile-unchanged-p
(filename &optional want-differences-if-changed)
@@ -2358,21 +2390,20 @@
(if (and (stringp filename) (rcp-rcp-file-p filename))
(setq ad-return-value
(rcp-vc-workfile-unchanged-p filename want-differences-if-changed))
- ad-do-it))
+ ad-do-it)))
;; Redefine a function from vc.el -- allow rcp files.
;; `save-match-data' seems not to be required -- it isn't in
;; the original version, either.
+(if (not (fboundp 'vc-backend-checkout))
+ () ;; our replacement won't work and is unnecessary anyway
(defun vc-checkout (filename &optional writable rev)
"Retrieve a copy of the latest version of the given file."
;; If ftp is on this system and the name matches the ange-ftp format
;; for a remote file, the user is trying something that won't work.
- (if (and (not (rcp-rcp-file-p filename))
- (string-match "^/[^/:]+:" filename) (vc-find-binary "ftp"))
- (error "Sorry, you can't check out files over FTP"))
(vc-backend-checkout filename writable rev)
- (vc-resynch-buffer filename t t))
+ (vc-resynch-buffer filename t t)))
;; Do we need to advise the vc-user-login-name function anyway?
@@ -2449,6 +2480,7 @@
(symbol-name (read (current-buffer)))))))
;; Wire ourselves into the VC infrastructure...
+;; This function does not exist any more in Emacs-21's VC
(defadvice vc-file-owner
(around rcp-vc-file-owner activate)
"Support for files on remote machines accessed by RCP."
@@ -2476,11 +2508,7 @@
(when (and (buffer-file-name)
(rcp-rcp-file-p (buffer-file-name)))
(make-local-variable 'vc-rcs-release)
- (make-local-variable 'vc-cvs-release)
- (make-local-variable 'vc-sccs-release)
- (setq vc-rcs-release nil
- vc-cvs-release nil
- vc-sccs-release nil)))
+ (setq vc-rcs-release nil)))
(add-hook 'find-file-hooks 'rcp-vc-setup-for-remote t)
@@ -3832,12 +3860,10 @@
;; file-name-nondirectory -- use primitive?
;; file-name-sans-versions -- use primitive?
;; file-newer-than-file-p
-;; file-ownership-preserved-p
;; find-backup-file-name
;; get-file-buffer -- use primitive
;; load
;; make-symbolic-link
-;; set-file-modes
;; set-visited-file-modtime
;; shell-command
;; unhandled-file-name-directory
