xemacs-beta: lisp/efs/efs.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:578fd4947a72
+:7d55a9ba150c
 ;; File:         efs.el
 ;; Release:      $efs release: 1.15 $
 ;; 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)
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;;    LCD Archive Entry:
 ;;;    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:
 ;;;
 ;;; The functions efs-host-type and efs-listing-type, and the
 ;;; variable efs-dired-host-type follow the following conventions
 "How many iterations efs waits on the nslookup program.
 Applies when nslookup is used to compute a fully qualified domain name
 for the local host, in the case when `system-name' does not return one.
 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.
 	 (sticky (memq int '(1 3 5 7))))
 (concat (efs-build-mode-string-element owner-int suid nil)
 	    (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.
 ;; This is because efs-file-modes returns nil if the modes
 ;; of a remote file couldn't be determined, even if the file exists.
 	    host user
 	    (list 'quote 'site 'chmod omode r-file)
 	    nil nil
 	    (efs-cont (result line cont-lines) (host file r-file omode)
 	      (if result
-		  (progn
+		  (let ((exit-code
-		    (efs-set-host-property host 'chmod-failed t)
+			 (efs-shell-call-process
-		    (message "CHMOD %s failed for %s on %s." omode r-file host)
+			  (concat "chmod " mode " " (file-name-nondirectory file))
-		    (if efs-ding-on-chmod-failure
+			  (file-name-directory file))))
-			(progn (ding) (sit-for 1))))
+		    (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
 			      (cond
 			       ((null (car ent)) "-")
 				      (downcase def-user))
 	  (string-equal user def-user))
 	(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))
 (while tail
 	(if (string-match (car (car tail)) filename)
 (apply operation args))))
 ;; 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
+(defvar efs-path-sifn-regexp "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
-(list
+"Regexp to match environment variables in file names.")
-	(cons "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
-	      'efs-sifn-handler-function)))
+(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.
 ;;;; ------------------------------------------------------------

Mercurial > hg > xemacs-beta

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