diff lisp/efs/efs.el @ 118:7d55a9ba150c r20-1b11

Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 9f59509498e1
children 6608ceec7cf8
line wrap: on
line diff
--- a/lisp/efs/efs.el	Mon Aug 13 09:23:08 2007 +0200
+++ b/lisp/efs/efs.el	Mon Aug 13 09:24:17 2007 +0200
@@ -6,7 +6,7 @@
 ;; Version:      #Revision: 1.56 $
 ;; RCS:          
 ;; Description:  Transparent FTP support for the original GNU Emacs
-;;               from FSF and Lucid Emacs
+;;               from FSF and XEmacs
 ;; Authors:      Andy Norman <ange@hplb.hpl.hp.com>,
 ;;               Sandy Rutherford <sandy@ibm550.sissa.it>
 ;; Created:      Thu Oct 12 14:00:05 1989 (as ange-ftp)
@@ -902,7 +902,7 @@
 ;;;    efs|Andy Norman and Sandy Rutherford
 ;;;    |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it
 ;;;    |transparent FTP Support for GNU Emacs
-;;;    |$Date: 1997/03/28 02:28:27 $|$efs release: 1.15 beta $|
+;;;    |$Date: 1997/04/05 18:07:24 $|$efs release: 1.15 beta $|
 
 ;;; Host and listing type notation:
 ;;;
@@ -1388,6 +1388,18 @@
 If you set this to nil, efs will wait an arbitrary amount of time to get
 output.")
 
+(defvar efs-remote-shell-file-name
+  (if (memq system-type '(hpux usg-unix-v)) ; hope that's right
+      "remsh"
+    "rsh")
+  "Remote shell used by efs.")
+
+(defvar efs-remote-shell-takes-user
+  (null (null (memq system-type '(aix aix-v3 hpux silicon-graphics-unix
+				      berkeley-unix))))
+  ;; Complete? Doubt it.
+  "Set to non-nil if your remote shell command takes \"-l USER\".")
+
 (defvar efs-make-backup-files efs-unix-host-types
   "*A list of operating systems for which efs will make Emacs backup files.
 The backup files are made on the remote host.
@@ -8089,6 +8101,37 @@
 	    (efs-build-mode-string-element group-int sgid nil)
 	    (efs-build-mode-string-element other-int nil sticky))))
   
+(defun efs-shell-call-process (command dir &optional in-background)
+  ;; Runs shell process on remote hosts.
+  (let* ((parsed (efs-ftp-path dir))
+	 (host (car parsed))
+	 (user (nth 1 parsed))
+	 (rdir (nth 2 parsed))
+	 (file-name-handler-alist nil))
+    (or (string-equal (efs-internal-directory-file-name dir)
+		      (efs-expand-tilde "~" (efs-host-type host) host user))
+	(string-match "^cd " command)
+	(setq command (concat "cd " rdir "; " command)))
+    (setq command
+	  (format  "%s %s%s \"%s\""	; remsh -l USER does not work well
+					; on a hp-ux machine I tried
+		   efs-remote-shell-file-name host
+		   (if efs-remote-shell-takes-user
+		       (concat " -l " user)
+		     "")
+		   command))
+    (message "Doing shell command on %s..." host)
+    ;; do it
+    (let ((process-connection-type ; don't waste pty's
+	     (null (null in-background))))
+	(setq default-directory (file-name-directory efs-tmp-name-template))
+	(if in-background
+	    (progn
+	      (setq mode-line-process '(": %s"))
+	      (start-process "Shell" (current-buffer)
+			     shell-file-name "-c" command))
+	  (call-process shell-file-name nil t nil "-c" command)))))
+
 (defun efs-set-file-modes (file mode)
   ;; set-file-modes for remote files.
   ;; For remote files, if mode is nil, does nothing.
@@ -8111,11 +8154,16 @@
 	    nil nil
 	    (efs-cont (result line cont-lines) (host file r-file omode)
 	      (if result
-		  (progn
-		    (efs-set-host-property host 'chmod-failed t)
-		    (message "CHMOD %s failed for %s on %s." omode r-file host)
-		    (if efs-ding-on-chmod-failure
-			(progn (ding) (sit-for 1))))
+		  (let ((exit-code
+			 (efs-shell-call-process
+			  (concat "chmod " mode " " (file-name-nondirectory file))
+			  (file-name-directory file))))
+		    (if (not (equal 0 exit-code))
+			(progn
+			  (efs-set-host-property host 'chmod-failed t)
+			  (message "CHMOD %s failed for %s on %s." omode r-file host)
+			  (if efs-ding-on-chmod-failure
+			      (progn (ding) (sit-for 1))))))
 		(let ((ent (efs-get-file-entry file)))
 		  (if ent
 		      (let* ((type
@@ -8861,7 +8909,7 @@
 	(format efs-path-format-without-user host path)
       (format efs-path-format-string user host path))))
 
-(efs-define-fun efs-abbreviate-file-name (filename)
+(efs-define-fun efs-abbreviate-file-name (filename &optional ignored-for-now)
   ;; Version of abbreviate-file-name for remote files.
   (efs-save-match-data
     (let ((tail directory-abbrev-alist))
@@ -10761,10 +10809,14 @@
 ;; Yes, this is what it looks like.  I'm defining the handler to run our
 ;; version whenever there is an environment variable.
 
-(nconc file-name-handler-alist
-       (list
-	(cons "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
-	      'efs-sifn-handler-function)))
+(defvar efs-path-sifn-regexp "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
+  "Regexp to match environment variables in file names.")
+
+(or (assoc efs-path-sifn-regexp file-name-handler-alist)
+    (nconc file-name-handler-alist
+	   (list
+	    (cons efs-path-sifn-regexp
+		  'efs-sifn-handler-function))))
 
 ;;;; ------------------------------------------------------------
 ;;;; Necessary overloads.