Mercurial > hg > xemacs-beta
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.