mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-03 08:30:09 +00:00
Code Issues Releases Activity

Remove XEmacs compatibility in Tramp

Browse Source 
* doc/misc/tramp.texi: Replace flags by their hard coded name.
Remove unused flags and the enclosed alternative text for XEmacs.

* doc/misc/trampver.texi: Use "Tramp" CamelCase.  Rename "emacs"
and "xemacs" flags to "unified" and "separate".  Remove flags
"emacsgw", "emacsname", "emacsdir", "ftppackagename",
"emacsothername", "emacsotherdir" and "emacsotherfilename".
(trampver):
* lisp/net/trampver.el (tramp-version): Set to "2.3.0-pre".

* lisp/net/tramp.el (bkup-backup-directory-info)
(directory-sep-char, ls-lisp-use-insert-directory-program)
(outline-regexp, tramp-backup-directory-alist)
(tramp-default-method, tramp-shell-prompt-pattern, tramp-syntax)
(tramp-file-name-regexp-unified)
(tramp-file-name-regexp-separate)
(tramp-completion-file-name-regexp-unified)
(tramp-completion-file-name-regexp-separate, tramp-chunksize)
(tramp-get-method-parameter, tramp-find-method, tramp-find-user)
(tramp-debug-message, tramp-progress-reporter-update)
(with-tramp-progress-reporter)
(tramp-rfn-eshadow-setup-minibuffer)
(rfn-eshadow-setup-minibuffer-hook, tramp-unload-hook)
(tramp-rfn-eshadow-update-overlay)
(rfn-eshadow-update-overlay-hook, tramp-default-file-modes)
(tramp-file-name-for-operation)
(tramp-completion-file-name-handler)
(tramp-autoload-file-name-handler, tramp-completion-mode-p)
(tramp-handle-directory-files)
(tramp-handle-directory-files-and-attributes)
(tramp-handle-dired-uncache, tramp-handle-find-backup-file-name)
(tramp-handle-insert-file-contents, tramp-handle-load)
(tramp-handle-shell-command)
(tramp-handle-verify-visited-file-modtime)
(tramp-handle-file-notify-valid-p, tramp-accept-process-output)
(tramp-check-for-regexp, tramp-wait-for-regexp)
(tramp-send-string, tramp-mode-string-to-int)
(tramp-get-local-gid, tramp-check-cached-permissions)
(tramp-get-remote-tmpdir, tramp-make-tramp-temp-file)
(auto-save-file-name-transforms)
(tramp-handle-make-auto-save-file-name, tramp-read-passwd)
(tramp-clear-passwd, tramp-time-diff):
* lisp/net/tramp-adb.el (directory-listing-before-filename-regexp)
(directory-sep-char, tramp-adb-file-name-handler-alist)
(tramp-adb-parse-device-names)
(tramp-adb-handle-expand-file-name)
(tramp-adb-handle-file-truename, tramp-adb--gnu-switches-to-ash)
(tramp-adb-handle-file-local-copy)
(tramp-adb-handle-write-region, tramp-adb-handle-set-file-modes)
(tramp-adb-handle-rename-file, tramp-adb-handle-process-file)
(tramp-adb-handle-shell-command)
(tramp-adb-handle-start-file-process, tramp-adb-get-device)
(tramp-adb-maybe-open-connection):
* lisp/net/tramp-cache.el (tramp-persistency-file-name)
(tramp-cache-print):
* lisp/net/tramp-cmds.el (tramp-cleanup-all-connections)
(tramp-bug, tramp-reporter-dump-variable)
(tramp-load-report-modules, tramp-append-tramp-buffers):
* lisp/net/tramp-compat.el (tramp-compat-funcall)
(tramp-advice-file-expand-wildcards)
(tramp-compat-temporary-file-directory)
(tramp-compat-make-temp-file, tramp-compat-copy-file)
(tramp-compat-delete-directory, )
(tramp-compat-process-running-p):
* lisp/net/tramp-ftp.el (tramp-methods) <ftp>:
(tramp-default-method-alist, tramp-foreign-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist)
(tramp-gvfs-do-copy-or-rename-file, tramp-gvfs-handle-copy-file)
(tramp-gvfs-handle-file-local-copy)
(tramp-gvfs-handle-file-name-all-completions)
(tramp-gvfs-handle-file-notify-add-watch)
(tramp-gvfs-monitor-file-process-filter)
(tramp-gvfs-handle-file-readable-p)
(tramp-gvfs-handle-rename-file, tramp-gvfs-handle-write-region)
(tramp-gvfs-file-name, tramp-gvfs-handler-askquestion)
(tramp-gvfs-maybe-open-connection)
(tramp-gvfs-parse-device-names):
* lisp/net/tramp-gw.el (tramp-gw-aux-proc-sentinel)
(tramp-gw-open-connection, tramp-gw-open-network-stream):
* lisp/net/tramp-sh.el (directory-sep-char)
(tramp-sh-file-name-handler-alist)
(tramp-sh-handle-file-truename)
(tramp-sh-handle-set-visited-file-modtime)
(tramp-sh-handle-verify-visited-file-modtime)
(tramp-sh-handle-set-file-modes, tramp-sh-handle-set-file-times)
(tramp-sh-handle-file-acl)
(tramp-sh-handle-file-name-all-completions)
(tramp-sh-handle-copy-file, tramp-sh-handle-rename-file)
(tramp-do-copy-or-rename-file-directly)
(tramp-do-copy-or-rename-file-out-of-band)
(dired-compress-file-suffixes, dired-remove-file)
(tramp-sh-handle-dired-compress-file)
(tramp-sh-handle-insert-directory)
(tramp-sh-handle-expand-file-name)
(tramp-sh-handle-start-file-process)
(tramp-sh-handle-process-file, tramp-sh-handle-file-local-copy)
(tramp-sh-handle-write-region, tramp-sh-handle-vc-registered)
(tramp-sh-handle-file-notify-add-watch)
(tramp-sh-gvfs-monitor-dir-process-filter)
(tramp-sh-inotifywait-process-filter, tramp-maybe-send-script)
(tramp-find-executable)
(tramp-open-connection-setup-interactive-shell)
(tramp-find-inline-encoding, tramp-compute-multi-hops)
(tramp-maybe-open-connection, tramp-convert-file-attributes)
(tramp-get-remote-path, tramp-get-remote-touch):
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist)
(tramp-smb-handle-copy-directory, tramp-smb-handle-copy-file)
(tramp-smb-handle-delete-directory)
(tramp-smb-handle-directory-files, tramp-smb-handle-file-acl)
(tramp-smb-handle-make-directory-internal)
(tramp-smb-handle-process-file, tramp-smb-handle-rename-file)
(tramp-smb-handle-set-file-acl, tramp-smb-handle-set-file-modes)
(tramp-smb-handle-write-region, tramp-smb-get-file-entries)
(tramp-smb-get-cifs-capabilities)
(tramp-smb-maybe-open-connection):
* lisp/net/trampver.el (tramp-repository-get-version):
Remove XEmacs compat code.

* lisp/net/tramp-cmds.el (mml-mode, mml-insert-empty-tag)
(reporter-dump-variable): Declare functions.

* lisp/net/tramp.el (tramp-bkup-backup-directory-info)
(tramp-advice-minibuffer-electric-separator)
(tramp-advice-minibuffer-electric-tilde)
(tramp-handle-unhandled-file-name-directory):
* lisp/net/tramp-compat.el (tramp-compat-with-temp-message)
(tramp-compat-font-lock-add-keywords)
(tramp-compat-load, tramp-compat-number-sequence)
(tramp-compat-split-string, tramp-compat-delete-dups):
* lisp/net/tramp-sh.el (tramp-sh-handle-insert-file-contents-literally):
Remove.

* lisp/net/tramp-sh.el (tramp-methods) <psftp>: This does not work
recursively.
This commit is contained in:
Michael Albinus 2016-01-14 14:12:17 +01:00
parent 641a3472ef
commit de8c5f9db5
13 changed files with 655 additions and 1838 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

635
doc/misc/tramp.texi
View File

File diff suppressed because it is too large Load Diff

36
doc/misc/trampver.texi
View File

@ -8,7 +8,7 @@
@c In the Tramp GIT, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
@set trampver 2.2.13.25.1
@set trampver 2.3.0-pre
@c Other flags from configuration
@set instprefix /usr/local
@ -16,54 +16,34 @@
@set infodir /usr/local/share/info
@c Formatting of the tramp program name consistent.
@set tramp @sc{tramp}
@set tramp @sc{Tramp}
@c Whether or not describe GVFS integration.
@ifclear noemacsgvfs
@set emacsgvfs
@end ifclear
@c Whether or not describe gateway methods.
@ifclear noemacsgw
@set emacsgw
@end ifclear
@c Some flags which make the text independent on the (X)Emacs flavor.
@c "emacs" resp "xemacs" are set in the Makefile. Default is "emacs".
@ifclear emacs
@ifclear xemacs
@set emacs
@c Some flags which define the remote file name syntax.
@ifclear unified
@ifclear separate
@set unified
@end ifclear
@end ifclear
@c Emacs values.
@ifset emacs
@set emacsname Emacs
@set emacsdir emacs
@set ftppackagename Ange-FTP
@ifset unified
@set prefix /
@set prefixhop
@set postfix :
@set postfixhop :
@set ipv6prefix [
@set ipv6postfix ]
@set emacsothername XEmacs
@set emacsotherdir xemacs
@set emacsotherfilename tramp-xemacs.html
@end ifset
@c XEmacs counterparts.
@ifset xemacs
@set emacsname XEmacs
@set emacsdir xemacs
@set ftppackagename EFS
@ifset separate
@set prefix /[
@set prefixhop [
@set postfix ]
@set postfixhop /
@set ipv6prefix
@set ipv6postfix
@set emacsothername Emacs
@set emacsotherdir emacs
@set emacsotherfilename tramp-emacs.html
@end ifset

70
lisp/net/tramp-adb.el
View File

@ -35,10 +35,6 @@
(require 'tramp)
;; Pacify byte-compiler.
(defvar directory-listing-before-filename-regexp)
(defvar directory-sep-char)
;;;###tramp-autoload
(defcustom tramp-adb-program "adb"
"Name of the Android Debug Bridge program."
@ -109,7 +105,6 @@ It is used for TCP/IP devices."
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-adb-handle-directory-files-and-attributes)
(dired-call-process . ignore)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
(expand-file-name . tramp-adb-handle-expand-file-name)
@ -162,7 +157,7 @@ It is used for TCP/IP devices."
(shell-command . tramp-adb-handle-shell-command)
(start-file-process . tramp-adb-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-adb-handle-write-region))
@ -199,7 +194,7 @@ pass to the OPERATION."
tramp-current-host nil nil))
result)
(tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
(while (eq 'run (process-status p))
(accept-process-output p 0.1))
(accept-process-output p 0.1)
@ -213,7 +208,7 @@ pass to the OPERATION."
(lambda (elt)
(setcar
(cdr elt)
(tramp-compat-replace-regexp-in-string
(replace-regexp-in-string
":" tramp-prefix-port-format (car (cdr elt)))))
result)
result))))
@ -233,12 +228,9 @@ pass to the OPERATION."
(unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; Do normal `expand-file-name' (this does "/./" and "/../").
;; We bind `directory-sep-char' here for XEmacs on Windows,
;; which would otherwise use backslash. `default-directory' is
;; bound, because on Windows there would be problems with UNC
;; shares or Cygwin mounts.
(let ((directory-sep-char ?/)
(default-directory (tramp-compat-temporary-file-directory)))
;; `default-directory' is bound, because on Windows there would
;; be problems with UNC shares or Cygwin mounts.
(let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name
method user host
(tramp-drop-volume-letter
@ -261,8 +253,7 @@ pass to the OPERATION."
(with-tramp-file-property v localname "file-truename"
(let ((result nil)) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
(let* ((directory-sep-char ?/)
(steps (tramp-compat-split-string localname "/"))
(let* ((steps (split-string localname "/" 'omit))
(localnamedir (tramp-run-real-handler
'file-name-as-directory (list localname)))
(is-dir (string= localname localnamedir))
@ -312,8 +303,7 @@ pass to the OPERATION."
"Symlink target `%s' on wrong host" symlink-target))
(setq symlink-target localname))
(setq steps
(append (tramp-compat-split-string
symlink-target "/")
(append (split-string symlink-target "/" 'omit)
steps)))
(t
;; It's a file.
@ -450,9 +440,8 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
(split-string
(apply 'concat
(mapcar (lambda (s)
(tramp-compat-replace-regexp-in-string
"\\(.\\)" " -\\1"
(tramp-compat-replace-regexp-in-string "^-" "" s)))
(replace-regexp-in-string
"\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s)))
;; FIXME: Warning about removed switches (long and non-dash).
(delq nil
(mapcar
@ -585,8 +574,7 @@ Emacs dired can't find files."
v 'file-error "Cannot make local copy of file `%s'" filename))
(set-file-modes
tmpfile
(logior (or (file-modes filename) 0)
(tramp-compat-octal-to-decimal "0400"))))
(logior (or (file-modes filename) 0) (string-to-number "0400" 8))))
tmpfile)))
(defun tramp-adb-handle-file-writable-p (filename)
@ -631,8 +619,7 @@ But handle the case, if the \"test\" command is not available."
(copy-file filename tmpfile 'ok)
(set-file-modes
tmpfile
(logior (or (file-modes tmpfile) 0)
(tramp-compat-octal-to-decimal "0600"))))
(logior (or (file-modes tmpfile) 0) (string-to-number "0600" 8))))
(tramp-run-real-handler
'write-region
(list start end tmpfile append 'no-message lockname confirm))
@ -657,8 +644,7 @@ But handle the case, if the \"test\" command is not available."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(tramp-adb-send-command-and-check
v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname))))
(tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname))))
(defun tramp-adb-handle-set-file-times (filename &optional time)
"Like `set-file-times' for Tramp files."
@ -736,10 +722,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(if (and t1 t2
(tramp-equal-remote filename newname)
(not (file-directory-p filename)))
(let ((l1 (tramp-file-name-handler
'file-remote-p filename 'localname))
(l2 (tramp-file-name-handler
'file-remote-p newname 'localname)))
(let ((l1 (file-remote-p filename 'localname))
(l2 (file-remote-p newname 'localname)))
(when (and (not ok-if-already-exists)
(file-exists-p newname))
(tramp-error v 'file-already-exists newname))
@ -755,7 +739,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Error renaming %s to %s" filename newname))
;; Rename by copy.
(copy-file filename newname ok-if-already-exists t t)
(copy-file
filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
(delete-file filename))))))
(defun tramp-adb-handle-process-file
@ -856,12 +841,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
;; `process-file-side-effects' has been introduced with GNU
;; Emacs 23.2. If set to nil, no remote file will be changed
;; by `program'. If it doesn't exist, we assume its default
;; value t.
(unless (and (boundp 'process-file-side-effects)
(not (symbol-value 'process-file-side-effects)))
(unless process-file-side-effects
(tramp-flush-directory-property v ""))
;; Return exit status.
@ -941,9 +921,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(current-buffer))))
;; There's some output, display it.
(when (with-current-buffer output-buffer (> (point-max) (point-min)))
(if (functionp 'display-message-or-buffer)
(tramp-compat-funcall 'display-message-or-buffer output-buffer)
(pop-to-buffer output-buffer))))))))
(display-message-or-buffer output-buffer)))))))
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
@ -1008,7 +986,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; process. We ignore errors, because the process
;; could have finished already.
(ignore-errors
(tramp-compat-set-process-query-on-exit-flag p t)
(set-process-query-on-exit-flag p t)
(set-marker (process-mark p) (point)))
;; Return process.
p))))
@ -1035,7 +1013,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
(host (tramp-file-name-host vec))
(port (tramp-file-name-port vec))
(devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
(tramp-compat-replace-regexp-in-string
(replace-regexp-in-string
tramp-prefix-port-format ":"
(cond ((member host devices) host)
;; This is the case when the host is connected to the default port.
@ -1051,7 +1029,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
(not (zerop (length host)))
(not (tramp-adb-execute-adb-command
vec "connect"
(tramp-compat-replace-regexp-in-string
(replace-regexp-in-string
tramp-prefix-port-format ":" host))))
;; When new device connected, running other adb command (e.g.
;; adb shell) immediately will fail. To get around this
@ -1205,7 +1183,7 @@ connection if a previous connection has died for some reason."
(unless (eq 'run (process-status p))
(tramp-error vec 'file-error "Terminated!"))
(tramp-set-connection-property p "vector" vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
;; Check whether the properties have been changed. If
;; yes, this is a strong indication that we must expire all
@ -1250,7 +1228,7 @@ connection if a previous connection has died for some reason."
;; Read the expression.
(goto-char (point-min))
(read (current-buffer)))
":" 'omit-nulls))))))))
":" 'omit))))))))
(add-hook 'tramp-unload-hook
(lambda ()

45
lisp/net/tramp-cache.el
View File

@ -75,25 +75,7 @@ details see the info pages."
(choice :tag " Value" sexp))))
(defcustom tramp-persistency-file-name
(cond
;; GNU Emacs.
((and (fboundp 'locate-user-emacs-file))
(expand-file-name (tramp-compat-funcall 'locate-user-emacs-file "tramp")))
((and (boundp 'user-emacs-directory)
(stringp (symbol-value 'user-emacs-directory))
(file-directory-p (symbol-value 'user-emacs-directory)))
(expand-file-name "tramp" (symbol-value 'user-emacs-directory)))
((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/"))
"~/.emacs.d/tramp")
;; XEmacs.
((and (boundp 'user-init-directory)
(stringp (symbol-value 'user-init-directory))
(file-directory-p (symbol-value 'user-init-directory)))
(expand-file-name "tramp" (symbol-value 'user-init-directory)))
((and (featurep 'xemacs) (file-directory-p "~/.xemacs/"))
"~/.xemacs/tramp")
;; For users without `~/.emacs.d/' or `~/.xemacs/'.
(t "~/.tramp"))
(expand-file-name (locate-user-emacs-file "tramp"))
"File which keeps connection history for Tramp connections."
:group 'tramp
:type 'file)
@ -307,19 +289,14 @@ KEY identifies the connection, it is either a process or a vector."
(maphash
(lambda (key value)
;; Remove text properties from KEY and VALUE.
;; `substring-no-properties' does not exist in XEmacs.
(when (functionp 'substring-no-properties)
(when (vectorp key)
(dotimes (i (length key))
(when (stringp (aref key i))
(aset key i
(tramp-compat-funcall
'substring-no-properties (aref key i))))))
(when (stringp key)
(setq key (tramp-compat-funcall 'substring-no-properties key)))
(when (stringp value)
(setq value
(tramp-compat-funcall 'substring-no-properties value))))
(when (vectorp key)
(dotimes (i (length key))
(when (stringp (aref key i))
(aset key i (substring-no-properties (aref key i))))))
(when (stringp key)
(setq key (substring-no-properties key)))
(when (stringp value)
(setq value (substring-no-properties value)))
;; Dump.
(let ((tmp (format
"(%s %s)"
@ -418,8 +395,8 @@ for all methods. Resulting data are derived from connection history."
;; When "emacs -Q" has been called, both variables are nil.
;; We do not load the persistency file then, in order to
;; have a clean test environment.
(or (and (boundp 'init-file-user) (symbol-value 'init-file-user))
(and (boundp 'site-run-file) (symbol-value 'site-run-file))))
(or init-file-user
site-run-file))
(condition-case err
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)

35
lisp/net/tramp-cmds.el
View File

@ -31,6 +31,9 @@
(require 'tramp)
;; Pacify byte-compiler.
(declare-function mml-mode "mml")
(declare-function mml-insert-empty-tag "mml")
(declare-function reporter-dump-variable "reporter")
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
@ -128,7 +131,7 @@ This includes password cache, file cache, connection cache, buffers."
(setq tramp-locked nil)
;; Flush password cache.
(tramp-compat-funcall 'password-reset)
(password-reset)
;; Flush file and connection cache.
(clrhash tramp-cache-data)
@ -166,7 +169,6 @@ This includes password cache, file cache, connection cache, buffers."
(defun tramp-bug ()
"Submit a bug report to the Tramp developers."
(interactive)
(require 'reporter)
(catch 'dont-send
(let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
@ -185,7 +187,6 @@ This includes password cache, file cache, connection cache, buffers."
backup-by-copying-when-mismatch
backup-by-copying-when-privileged-mismatch
backup-directory-alist
bkup-backup-directory-info
password-cache
password-cache-expiry
remote-file-name-inhibit-cache
@ -194,8 +195,7 @@ This includes password cache, file cache, connection cache, buffers."
'tramp-load-report-modules ; pre-hook
'tramp-append-tramp-buffers ; post-hook
(tramp-compat-funcall
(if (functionp 'propertize) 'propertize 'progn)
(propertize
"\n" 'display "\
Enter your bug report in this message, including as much detail
as you possibly can about the problem, what you did to cause it
@ -243,7 +243,7 @@ buffer in your bug report.
(base64-encode-string (encode-coding-string val 'raw-text)))))))
;; Dump variable.
(tramp-compat-funcall 'reporter-dump-variable varsym mailbuf)
(reporter-dump-variable varsym mailbuf)
(unless (hash-table-p val)
;; Remove string quotation.
@ -264,15 +264,8 @@ buffer in your bug report.
(defun tramp-load-report-modules ()
"Load needed modules for reporting."
;; We load message.el and mml.el from Gnus.
(if (featurep 'xemacs)
(progn
(load "message" 'noerror)
(load "mml" 'noerror))
(require 'message nil 'noerror)
(require 'mml nil 'noerror))
(tramp-compat-funcall 'message-mode)
(tramp-compat-funcall 'mml-mode t))
(message-mode)
(mml-mode t))
(defun tramp-append-tramp-buffers ()
"Append Tramp buffers and buffer local variables into the bug report."
@ -303,7 +296,7 @@ buffer in your bug report.
;; Non-tramp variables of interest.
'(default-directory))
'string<))
(tramp-compat-funcall 'reporter-dump-variable varsym elbuf))
(reporter-dump-variable varsym elbuf))
(lisp-indent-line)
(insert ")\n"))
(insert-buffer-substring elbuf)))
@ -313,7 +306,7 @@ buffer in your bug report.
(ignore-errors
(mapc
(lambda (x) (when (string-match "tramp" x) (insert x "\n")))
(split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n")))
(split-string (list-load-path-shadows t) "\n")))
;; Append buffers only when we are in message mode.
(when (and
@ -322,7 +315,7 @@ buffer in your bug report.
(symbol-value 'mml-mode))
(let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
(buffer-list (tramp-compat-funcall 'tramp-list-tramp-buffers))
(buffer-list (tramp-list-tramp-buffers))
(curbuf (current-buffer)))
;; There is at least one Tramp buffer.
@ -364,13 +357,13 @@ the debug buffer(s).")
(kill-buffer nil)
(switch-to-buffer curbuf)
(goto-char (point-max))
(insert (tramp-compat-funcall 'propertize "\n" 'display "\n\
(insert (propertize "\n" 'display "\n\
This is a special notion of the `gnus/message' package. If you
use another mail agent (by copying the contents of this buffer)
please ensure that the buffers are attached to your email.\n\n"))
(dolist (buffer buffer-list)
(tramp-compat-funcall
'mml-insert-empty-tag 'part 'type "text/plain"
(mml-insert-empty-tag
'part 'type "text/plain"
'encoding "base64" 'disposition "attachment" 'buffer buffer
'description buffer))
(set-buffer-modified-p nil))

487
lisp/net/tramp-compat.el
View File

@ -23,9 +23,8 @@
;;; Commentary:
;; Tramp's main Emacs version for development is Emacs 24. This
;; package provides compatibility functions for Emacs 22, Emacs 23,
;; XEmacs 21.4+ and SXEmacs 22.
;; Tramp's main Emacs version for development is Emacs 25. This
;; package provides compatibility functions for Emacs 23 and Emacs 24.
;;; Code:
@ -33,164 +32,57 @@
(eval-when-compile
(require 'cl))
(eval-and-compile
(require 'auth-source)
(require 'advice)
(require 'custom)
(require 'format-spec)
(require 'password-cache)
(require 'shell)
(require 'timer)
(require 'ucs-normalize)
;; GNU Emacs 22.
(unless (fboundp 'ignore-errors)
(load "cl" 'noerror)
(load "cl-macs" 'noerror))
(require 'trampver)
(require 'tramp-loaddefs)
;; Some packages must be required for XEmacs, because we compile
;; with -no-autoloads.
(when (featurep 'xemacs)
(require 'cus-edit)
(require 'env)
(require 'executable)
(require 'outline)
(require 'passwd)
(require 'pp)
(require 'regexp-opt)
(require 'time-date))
;; `remote-file-name-inhibit-cache' has been introduced with Emacs
;; 24.1. Besides t, nil, and integer, we use also timestamps (as
;; returned by `current-time') internally.
(unless (boundp 'remote-file-name-inhibit-cache)
(defvar remote-file-name-inhibit-cache nil))
(require 'advice)
(require 'custom)
(require 'format-spec)
(require 'shell)
;; Introduced in Emacs 23.2.
(require 'ucs-normalize nil 'noerror)
;; For not existing functions, or functions with a changed argument
;; list, there are compiler warnings. We want to avoid them in cases
;; we know what we do.
(defmacro tramp-compat-funcall (function &rest arguments)
`(when (or (subrp ,function) (functionp ,function))
(with-no-warnings (funcall ,function ,@arguments))))
(require 'trampver)
(require 'tramp-loaddefs)
;; As long as password.el is not part of (X)Emacs, it shouldn't be
;; mandatory.
(if (featurep 'xemacs)
(load "password" 'noerror)
(or (require 'password-cache nil 'noerror)
(require 'password nil 'noerror))) ; Part of contrib.
;; auth-source is relatively new.
(if (featurep 'xemacs)
(load "auth-source" 'noerror)
(require 'auth-source nil 'noerror))
;; Load the appropriate timer package.
(if (featurep 'xemacs)
(require 'timer-funcs)
(require 'timer))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(when (featurep 'xemacs)
(unless (boundp 'byte-compile-default-warnings)
(defvar byte-compile-default-warnings nil))
(delq 'unused-vars byte-compile-default-warnings))
;; `last-coding-system-used' is unknown in XEmacs.
(unless (boundp 'last-coding-system-used)
(defvar last-coding-system-used nil))
;; `directory-sep-char' is an obsolete variable in Emacs. But it is
;; used in XEmacs, so we set it here and there. The following is
;; needed to pacify Emacs byte-compiler.
;; Note that it was removed altogether in Emacs 24.1.
(when (boundp 'directory-sep-char)
(defvar byte-compile-not-obsolete-var nil)
(setq byte-compile-not-obsolete-var 'directory-sep-char)
;; Emacs 23.2.
(defvar byte-compile-not-obsolete-vars nil)
(setq byte-compile-not-obsolete-vars '(directory-sep-char)))
;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1.
;; Besides t, nil, and integer, we use also timestamps (as
;; returned by `current-time') internally.
(unless (boundp 'remote-file-name-inhibit-cache)
(defvar remote-file-name-inhibit-cache nil))
;; For not existing functions, or functions with a changed argument
;; list, there are compiler warnings. We want to avoid them in
;; cases we know what we do.
(defmacro tramp-compat-funcall (function &rest arguments)
(if (featurep 'xemacs)
`(funcall (symbol-function ,function) ,@arguments)
`(when (or (subrp ,function) (functionp ,function))
(with-no-warnings (funcall ,function ,@arguments)))))
;; `set-buffer-multibyte' comes from Emacs Leim.
(unless (fboundp 'set-buffer-multibyte)
(defalias 'set-buffer-multibyte 'ignore))
;; The following functions cannot be aliases of the corresponding
;; `tramp-handle-*' functions, because this would bypass the locking
;; mechanism.
;; `process-file' does not exist in XEmacs.
(unless (fboundp 'process-file)
(defalias 'process-file
(lambda (program &optional infile buffer display &rest args)
(when (tramp-tramp-file-p default-directory)
(apply
'tramp-file-name-handler
'process-file program infile buffer display args)))))
;; `start-file-process' is new in Emacs 23.
(unless (fboundp 'start-file-process)
(defalias 'start-file-process
(lambda (name buffer program &rest program-args)
(when (tramp-tramp-file-p default-directory)
(apply
'tramp-file-name-handler
'start-file-process name buffer program program-args)))))
;; `set-file-times' is also new in Emacs 23.
(unless (fboundp 'set-file-times)
(defalias 'set-file-times
(lambda (filename &optional time)
(when (tramp-tramp-file-p filename)
(tramp-compat-funcall
'tramp-file-name-handler 'set-file-times filename time)))))
;; We currently use "[" and "]" in the filename format for IPv6
;; hosts of GNU Emacs. This means that Emacs wants to expand
;; wildcards if `find-file-wildcards' is non-nil, and then barfs
;; because no expansion could be found. We detect this situation
;; and do something really awful: we have `file-expand-wildcards'
;; return the original filename if it can't expand anything. Let's
;; just hope that this doesn't break anything else.
;; It is not needed anymore since GNU Emacs 23.2.
(unless (or (featurep 'xemacs)
;; `featurep' has only one argument in XEmacs.
(funcall 'featurep 'files 'remote-wildcards))
(defadvice file-expand-wildcards
;; We currently use "[" and "]" in the filename format for IPv6 hosts
;; of GNU Emacs. This means that Emacs wants to expand wildcards if
;; `find-file-wildcards' is non-nil, and then barfs because no
;; expansion could be found. We detect this situation and do
;; something really awful: we have `file-expand-wildcards' return the
;; original filename if it can't expand anything. Let's just hope
;; that this doesn't break anything else. It is not needed anymore
;; since GNU Emacs 23.2.
(unless (featurep 'files 'remote-wildcards)
(defadvice file-expand-wildcards
(around tramp-advice-file-expand-wildcards activate)
(let ((name (ad-get-arg 0)))
;; If it's a Tramp file, look if wildcards need to be expanded
;; at all.
(if (and
(tramp-tramp-file-p name)
(not (string-match
"[[*?]" (tramp-compat-funcall
'file-remote-p name 'localname))))
(setq ad-return-value (list name))
;; Otherwise, just run the original function.
ad-do-it)))
(add-hook
'tramp-unload-hook
(lambda ()
(ad-remove-advice
'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
(ad-activate 'file-expand-wildcards))))
;; `redisplay' does not exist in XEmacs.
(unless (fboundp 'redisplay)
(defalias 'redisplay 'ignore)))
;; `with-temp-message' does not exist in XEmacs.
(if (fboundp 'with-temp-message)
(defalias 'tramp-compat-with-temp-message 'with-temp-message)
(defmacro tramp-compat-with-temp-message (_message &rest body)
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
(let ((name (ad-get-arg 0)))
;; If it's a Tramp file, look if wildcards need to be expanded
;; at all.
(if (and
(tramp-tramp-file-p name)
(not (string-match "[[*?]" (file-remote-p name 'localname))))
(setq ad-return-value (list name))
;; Otherwise, just run the original function.
ad-do-it)))
(add-hook
'tramp-unload-hook
(lambda ()
(ad-remove-advice
'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
(ad-activate 'file-expand-wildcards))))
;; `condition-case-unless-debug' is introduced with Emacs 24.
(if (fboundp 'condition-case-unless-debug)
@ -208,105 +100,23 @@
(funcall ,bodysym)
,@handlers))))))
;; `font-lock-add-keywords' does not exist in XEmacs.
(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
"Add highlighting KEYWORDS for MODE."
(ignore-errors
(tramp-compat-funcall 'font-lock-add-keywords mode keywords how)))
(defsubst tramp-compat-temporary-file-directory ()
"Return name of directory for temporary files (compat function).
For Emacs, this is the variable `temporary-file-directory', for XEmacs
this is the function `temp-directory'."
(let (file-name-handler-alist)
;; We must return a local directory. If it is remote, we could
;; run into an infloop.
(cond
((and (boundp 'temporary-file-directory)
(eval (car (get 'temporary-file-directory 'standard-value)))))
((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
(file-name-as-directory (getenv "TEMP")))
((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
(file-name-as-directory (getenv "TMP")))
((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
(file-name-as-directory (getenv "TMPDIR")))
((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
(t (message (concat "Neither `temporary-file-directory' nor "
"`temp-directory' is defined -- using /tmp."))
(file-name-as-directory "/tmp")))))
"Return name of directory for temporary files.
It is the default value of `temporary-file-directory'."
;; We must return a local directory. If it is remote, we could run
;; into an infloop.
(eval (car (get 'temporary-file-directory 'standard-value))))
;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
;; implementation with `make-temp-name', creating the temporary file
;; immediately in order to avoid a security hole.
(defsubst tramp-compat-make-temp-file (f &optional dir-flag)
"Create a temporary file (compat function).
"Create a local temporary file (compat function).
Add the extension of F, if existing."
(let* (file-name-handler-alist
(prefix (expand-file-name
(symbol-value 'tramp-temp-name-prefix)
(tramp-compat-temporary-file-directory)))
(extension (file-name-extension f t))
result)
(condition-case nil
(setq result
(tramp-compat-funcall 'make-temp-file prefix dir-flag extension))
(error
;; We use our own implementation, taken from files.el.
(while
(condition-case ()
(progn
(setq result (concat (make-temp-name prefix) extension))
(if dir-flag
(make-directory result)
(write-region "" nil result nil 'silent))
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
;; `make-temp-name' and `write-region', let's try again.
nil)))
result))
(extension (file-name-extension f t)))
(make-temp-file prefix dir-flag extension)))
;; `most-positive-fixnum' does not exist in XEmacs.
(defsubst tramp-compat-most-positive-fixnum ()
"Return largest positive integer value (compat function)."
(cond
((boundp 'most-positive-fixnum) (symbol-value 'most-positive-fixnum))
;; Default value in XEmacs.
(t 134217727)))
(defun tramp-compat-decimal-to-octal (i)
"Return a string consisting of the octal digits of I.
Not actually used. Use `(format \"%o\" i)' instead?"
(cond ((< i 0) (error "Cannot convert negative number to octal"))
((not (integerp i)) (error "Cannot convert non-integer to octal"))
((zerop i) "0")
(t (concat (tramp-compat-decimal-to-octal (/ i 8))
(number-to-string (% i 8))))))
;; Kudos to Gerd Moellmann for this suggestion.
(defun tramp-compat-octal-to-decimal (ostr)
"Given a string of octal digits, return a decimal number."
(let ((x (or ostr "")))
;; `save-match' is in `tramp-mode-string-to-int' which calls this.
(unless (string-match "\\`[0-7]*\\'" x)
(error "Non-octal junk in string `%s'" x))
(string-to-number ostr 8)))
;; ID-FORMAT does not exist in XEmacs.
(defun tramp-compat-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files (compat function)."
(cond
((or (null id-format) (eq id-format 'integer))
(file-attributes filename))
((tramp-tramp-file-p filename)
(tramp-compat-funcall
'tramp-file-name-handler 'file-attributes filename id-format))
(t (condition-case nil
(tramp-compat-funcall 'file-attributes filename id-format)
(wrong-number-of-arguments (file-attributes filename))))))
;; PRESERVE-UID-GID does not exist in XEmacs.
;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1
;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3.
(defun tramp-compat-copy-file
@ -320,21 +130,13 @@ Not actually used. Use `(format \"%o\" i)' instead?"
'copy-file filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(wrong-number-of-arguments
(tramp-compat-copy-file
(copy-file
filename newname ok-if-already-exists keep-date preserve-uid-gid))))
(preserve-uid-gid
(condition-case nil
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
preserve-uid-gid)
(wrong-number-of-arguments
(tramp-compat-copy-file
filename newname ok-if-already-exists keep-date))))
(t
(copy-file filename newname ok-if-already-exists keep-date))))
(copy-file
filename newname ok-if-already-exists keep-date preserve-uid-gid))))
;; `copy-directory' is a new function in Emacs 23.2. Implementation
;; is taken from there.
;; COPY-CONTENTS has been introduced with Emacs 24.1.
(defun tramp-compat-copy-directory
(directory newname &optional keep-time parents copy-contents)
"Make a copy of DIRECTORY (compat function)."
@ -401,12 +203,10 @@ Not actually used. Use `(format \"%o\" i)' instead?"
(cond
(trash
(tramp-compat-funcall 'delete-directory directory recursive trash))
(recursive
(tramp-compat-funcall 'delete-directory directory recursive))
(t
(delete-directory directory)))
;; This Emacs version does not support the RECURSIVE or TRASH flag. We
;; use the implementation from Emacs 23.2.
(delete-directory directory recursive)))
;; This Emacs version does not support the TRASH flag. We use the
;; implementation from Emacs 23.2.
(wrong-number-of-arguments
(setq directory (directory-file-name (expand-file-name directory)))
(if (not (file-symlink-p directory))
@ -418,42 +218,6 @@ Not actually used. Use `(format \"%o\" i)' instead?"
directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
(delete-directory directory))))
;; MUST-SUFFIX doesn't exist on XEmacs.
(defun tramp-compat-load (file &optional noerror nomessage nosuffix must-suffix)
"Like `load' for Tramp files (compat function)."
(if must-suffix
(tramp-compat-funcall 'load file noerror nomessage nosuffix must-suffix)
(load file noerror nomessage nosuffix)))
;; `number-sequence' does not exist in XEmacs. Implementation is
;; taken from Emacs 23.
(defun tramp-compat-number-sequence (from &optional to inc)
"Return a sequence of numbers from FROM to TO as a list (compat function)."
(if (or (subrp 'number-sequence) (symbol-file 'number-sequence))
(tramp-compat-funcall 'number-sequence from to inc)
(if (or (not to) (= from to))
(list from)
(or inc (setq inc 1))
(when (zerop inc) (error "The increment can not be zero"))
(let (seq (n 0) (next from))
(if (> inc 0)
(while (<= next to)
(setq seq (cons next seq)
n (1+ n)
next (+ from (* n inc))))
(while (>= next to)
(setq seq (cons next seq)
n (1+ n)
next (+ from (* n inc)))))
(nreverse seq)))))
(defun tramp-compat-split-string (string pattern)
"Like `split-string' but omit empty strings.
In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
This is, the first, empty, element is omitted. In XEmacs, the first
element is not omitted."
(delete "" (split-string string pattern)))
(defun tramp-compat-process-running-p (process-name)
"Returns t if system process PROCESS-NAME is running for `user-login-name'."
(when (stringp process-name)
@ -466,7 +230,7 @@ element is not omitted."
((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
(let (result)
(dolist (pid (tramp-compat-funcall 'list-system-processes) result)
(let ((attributes (tramp-compat-funcall 'process-attributes pid)))
(let ((attributes (process-attributes pid)))
(when (and (string-equal
(cdr (assoc 'user attributes)) (user-login-name))
(let ((comm (cdr (assoc 'comm attributes))))
@ -476,135 +240,16 @@ element is not omitted."
(and comm (string-match
(concat "^" (regexp-quote comm))
process-name))))
(setq result t))))))
;; Fallback, if there is no Lisp support yet.
(t (let ((default-directory
(if (tramp-tramp-file-p default-directory)
(tramp-compat-temporary-file-directory)
default-directory))
(unix95 (getenv "UNIX95"))
result)
(setenv "UNIX95" "1")
(when (member
(user-login-name)
(tramp-compat-split-string
(shell-command-to-string
(format "ps -C %s -o user=" process-name))
"[ \f\t\n\r\v]+"))
(setq result t))
(setenv "UNIX95" unix95)
result)))))
;; The following functions do not exist in XEmacs. We ignore this;
;; they are used for checking a remote tty.
(defun tramp-compat-process-get (process propname)
"Return the value of PROCESS' PROPNAME property.
This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
(ignore-errors (tramp-compat-funcall 'process-get process propname)))
(defun tramp-compat-process-put (process propname value)
"Change PROCESS' PROPNAME property to VALUE.
It can be retrieved with `(process-get PROCESS PROPNAME)'."
(ignore-errors (tramp-compat-funcall 'process-put process propname value)))
(defun tramp-compat-set-process-query-on-exit-flag (process flag)
"Specify if query is needed for process when Emacs is exited.
If the second argument flag is non-nil, Emacs will query the user before
exiting if process is running."
(if (fboundp 'set-process-query-on-exit-flag)
(tramp-compat-funcall 'set-process-query-on-exit-flag process flag)
(tramp-compat-funcall 'process-kill-without-query process flag)))
;; There exist different implementations for this function.
(defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type)
"Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
EOL-TYPE can be one of `dos', `unix', or `mac'."
(cond ((fboundp 'coding-system-change-eol-conversion)
(tramp-compat-funcall
'coding-system-change-eol-conversion coding-system eol-type))
((fboundp 'subsidiary-coding-system)
(tramp-compat-funcall
'subsidiary-coding-system coding-system
(cond ((eq eol-type 'dos) 'crlf)
((eq eol-type 'unix) 'lf)
((eq eol-type 'mac) 'cr)
(t (error
"Unknown EOL-TYPE `%s', must be `dos', `unix', or `mac'"
eol-type)))))
(t (error "Can't change EOL conversion -- is MULE missing?"))))
;; `replace-regexp-in-string' does not exist in XEmacs.
;; Implementation is taken from Emacs 24.
(if (fboundp 'replace-regexp-in-string)
(defalias 'tramp-compat-replace-regexp-in-string 'replace-regexp-in-string)
(defun tramp-compat-replace-regexp-in-string
(regexp rep string &optional fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
Return a new string containing the replacements.
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
arguments with the same names of function `replace-match'. If START
is non-nil, start replacements at that index in STRING.
REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function, it is called with the actual text of each
match, and its value is used as the replacement text. When REP is called,
the match data are the result of matching REGEXP against a substring
of STRING.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
(replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
=> \" bar foo\""
(let ((l (length string))
(start (or start 0))
matches str mb me)
(save-match-data
(while (and (< start l) (string-match regexp string start))
(setq mb (match-beginning 0)
me (match-end 0))
;; If we matched the empty string, make sure we advance by one char
(when (= me mb) (setq me (min l (1+ mb))))
;; Generate a replacement for the matched substring.
;; Operate only on the substring to minimize string consing.
;; Set up match data for the substring for replacement;
;; presumably this is likely to be faster than munging the
;; match data directly in Lisp.
(string-match regexp (setq str (substring string mb me)))
(setq matches
(cons (replace-match (if (stringp rep)
rep
(funcall rep (match-string 0 str)))
fixedcase literal str subexp)
(cons (substring string start mb) ; unmatched prefix
matches)))
(setq start me))
;; Reconstruct a string from the pieces.
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches))))))
(setq result t)))))))))
;; `default-toplevel-value' has been declared in Emacs 24.
(unless (fboundp 'default-toplevel-value)
(defalias 'default-toplevel-value 'symbol-value))
;; `format-message' is new in Emacs 25, and does not exist in XEmacs.
;; `format-message' is new in Emacs 25.
(unless (fboundp 'format-message)
(defalias 'format-message 'format))
;; `delete-dups' does not exist in XEmacs 21.4.
(if (fboundp 'delete-dups)
(defalias 'tramp-compat-delete-dups 'delete-dups)
(defun tramp-compat-delete-dups (list)
"Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it. LIST must be a proper list.
Of several `equal' occurrences of an element in LIST, the first
one is kept."
(tramp-compat-funcall
'cl-delete-duplicates list '(:test equal :from-end) nil)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)

29
lisp/net/tramp-ftp.el
View File

@ -39,15 +39,6 @@
(defvar ange-ftp-name-format)
;; Disable Ange-FTP from file-name-handler-alist.
;; To handle EFS, the following functions need to be dealt with:
;;
;; * dired-before-readin-hook contains efs-dired-before-readin
;; * file-name-handler-alist contains efs-file-handler-function
;; and efs-root-handler-function and efs-sifn-handler-function
;; * find-file-hooks contains efs-set-buffer-mode
;;
;; But it won't happen for EFS since the XEmacs maintainers
;; don't want to use a unified filename syntax.
(defun tramp-disable-ange-ftp ()
"Turn Ange-FTP off.
This is useful for unified remoting. See
@ -104,14 +95,15 @@ present for backward compatibility."
;; ... and add it to the method list.
;;;###tramp-autoload
(unless (featurep 'xemacs)
(add-to-list 'tramp-methods (cons tramp-ftp-method nil))
(add-to-list 'tramp-methods (cons tramp-ftp-method nil))
;; Add some defaults for `tramp-default-method-alist'.
(add-to-list 'tramp-default-method-alist
(list "\\`ftp\\." nil tramp-ftp-method))
(add-to-list 'tramp-default-method-alist
(list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)))
;; Add some defaults for `tramp-default-method-alist'.
;;;###tramp-autoload
(add-to-list 'tramp-default-method-alist
(list "\\`ftp\\." nil tramp-ftp-method))
;;;###tramp-autoload
(add-to-list 'tramp-default-method-alist
(list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
;; Add completion function for FTP method.
;;;###tramp-autoload
@ -195,9 +187,8 @@ pass to the OPERATION."
tramp-ftp-method))
;;;###tramp-autoload
(unless (featurep 'xemacs)
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
(add-hook 'tramp-unload-hook
(lambda ()

64
lisp/net/tramp-gvfs.el
View File

@ -422,7 +422,6 @@ Every entry is a list (NAME ADDRESS).")
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-call-process . ignore)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
(expand-file-name . tramp-gvfs-handle-expand-file-name)
@ -474,7 +473,7 @@ Every entry is a list (NAME ADDRESS).")
(shell-command . ignore)
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-gvfs-handle-write-region))
@ -562,8 +561,7 @@ will be traced by Tramp with trace level 6."
(put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
(defvar tramp-gvfs-dbus-event-vector nil
"Current Tramp file name to be used, as vector.
@ -623,19 +621,19 @@ file names."
(and t2 (not (tramp-gvfs-file-name-p newname))))
;; We cannot copy or rename directly.
;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with
;; Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and renamed
;; in Emacs 24.3.
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(cond
(preserve-extended-attributes
(tramp-compat-funcall
(funcall
file-operation
filename tmpfile t keep-date preserve-uid-gid
preserve-extended-attributes))
(preserve-uid-gid
(tramp-compat-funcall
file-operation filename tmpfile t keep-date preserve-uid-gid))
(t
(tramp-compat-funcall
file-operation filename tmpfile t keep-date)))
(funcall
file-operation filename tmpfile t keep-date preserve-uid-gid)))
(rename-file tmpfile newname ok-if-already-exists))
;; Direct action.
@ -693,19 +691,18 @@ file names."
(tramp-gvfs-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))
;; Compat section.
;; Compat section. PRESERVE-EXTENDED-ATTRIBUTES has been
;; introduced with Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and
;; renamed in Emacs 24.3.
(preserve-extended-attributes
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)))
(preserve-uid-gid
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
(t
(tramp-run-real-handler
'copy-file (list filename newname ok-if-already-exists keep-date)))))
'copy-file
(list filename newname ok-if-already-exists keep-date preserve-uid-gid)))))
(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
@ -923,7 +920,7 @@ file names."
(tramp-error
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(copy-file filename tmpfile t t)
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
@ -960,7 +957,7 @@ file names."
(when cache-hit (list cache-hit))))
;; We cannot use a length of 0, because file properties
;; for "foo" and "foo/" are identical.
(tramp-compat-number-sequence (length filename) 1 -1)))))
(number-sequence (length filename) 1 -1)))))
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
@ -1024,9 +1021,9 @@ file names."
(tramp-message
v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p)
(tramp-set-connection-property p "vector" v)
(tramp-compat-process-put p 'events events)
(tramp-compat-process-put p 'watch-name localname)
(tramp-compat-set-process-query-on-exit-flag p nil)
(process-put p 'events events)
(process-put p 'watch-name localname)
(set-process-query-on-exit-flag p nil)
(set-process-filter p 'tramp-gvfs-monitor-file-process-filter)
;; There might be an error if the monitor is not supported.
;; Give the filter a chance to read the output.
@ -1039,7 +1036,7 @@ file names."
(defun tramp-gvfs-monitor-file-process-filter (proc string)
"Read output from \"gvfs-monitor-file\" and add corresponding \
file-notify events."
(let* ((rest-string (tramp-compat-process-get proc 'rest-string))
(let* ((rest-string (process-get proc 'rest-string))
(dd (with-current-buffer (process-buffer proc) default-directory))
(ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
(when rest-string
@ -1047,7 +1044,7 @@ file-notify events."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
string (tramp-compat-replace-regexp-in-string
string (replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(when (string-match "Monitoring not supported" string)
(delete-process proc))
@ -1060,7 +1057,7 @@ file-notify events."
string)
(let ((file (match-string 1 string))
(action (intern-soft
(tramp-compat-replace-regexp-in-string
(replace-regexp-in-string
"_" "-" (downcase (match-string 2 string))))))
(setq string (replace-match "" nil nil string))
;; File names are returned as URL paths. We must convert them.
@ -1079,12 +1076,12 @@ file-notify events."
;; Save rest of the string.
(when (zerop (length string)) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(tramp-compat-process-put proc 'rest-string string)))
(process-put proc 'rest-string string)))
(defun tramp-gvfs-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-executable-p"
(with-tramp-file-property v localname "file-readable-p"
(tramp-check-cached-permissions v ?r))))
(defun tramp-gvfs-handle-file-writable-p (filename)
@ -1125,7 +1122,8 @@ file-notify events."
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
(tramp-gvfs-do-copy-or-rename-file
'rename filename newname ok-if-already-exists t t)
'rename filename newname ok-if-already-exists
'keep-date 'preserve-uid-gid)
(tramp-run-real-handler
'rename-file (list filename newname ok-if-already-exists))))
@ -1133,8 +1131,7 @@ file-notify events."
(start end filename &optional append visit lockname confirm)
"Like `write-region' for Tramp files."
(with-parsed-tramp-file-name filename nil
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
(when (and confirm (file-exists-p filename))
(unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
(tramp-error v 'file-error "File not overwritten")))
@ -1203,8 +1200,7 @@ file-notify events."
(defun tramp-gvfs-file-name (object-path)
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
(tramp-compat-replace-regexp-in-string
"^.*/\\([^/]+\\)$" "\\1" object-path)))
(replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
(defun tramp-bluez-address (device)
"Return bluetooth device address from a given bluetooth DEVICE name."
@ -1293,7 +1289,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
;; host signature.
(with-temp-buffer
;; Preserve message for `progress-reporter'.
(tramp-compat-with-temp-message ""
(with-temp-message ""
(insert message)
(pop-to-buffer (current-buffer))
(setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))
@ -1533,7 +1529,7 @@ connection if a previous connection has died for some reason."
:name (tramp-buffer-name vec)
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t)))
(tramp-compat-set-process-query-on-exit-flag p nil)))
(set-process-query-on-exit-flag p nil)))
(unless (tramp-gvfs-connection-mounted-p vec)
(let* ((method (tramp-file-name-method vec))
@ -1751,7 +1747,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
'split-string
(shell-command-to-string (format "avahi-browse -trkp %s" service))
"[\n\r]+" 'omit "^\\+;.*$"))))
(tramp-compat-delete-dups
(delete-dups
(mapcar
(lambda (x)
(let* ((list (split-string x ";"))

10
lisp/net/tramp-gw.el
View File

@ -108,7 +108,7 @@
tramp-gw-vector 4
"Opening auxiliary process `%s', speaking with process `%s'"
proc tramp-gw-gw-proc)
(tramp-compat-set-process-query-on-exit-flag proc nil)
(set-process-query-on-exit-flag proc nil)
;; We don't want debug messages, because the corresponding debug
;; buffer might be undecided.
(let ((tramp-verbose 0))
@ -158,7 +158,7 @@ instead of the host name declared in TARGET-VEC."
:name (tramp-buffer-name aux-vec) :buffer nil :host 'local
:server t :noquery t :service t :coding 'binary))
(set-process-sentinel tramp-gw-aux-proc 'tramp-gw-aux-proc-sentinel)
(tramp-compat-set-process-query-on-exit-flag tramp-gw-aux-proc nil)
(set-process-query-on-exit-flag tramp-gw-aux-proc nil)
(tramp-message
vec 4 "Opening auxiliary process `%s', listening on port %d"
tramp-gw-aux-proc (process-contact tramp-gw-aux-proc :service))))
@ -204,7 +204,7 @@ instead of the host name declared in TARGET-VEC."
(tramp-file-name-port target-vec)))
(set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel)
(set-process-coding-system tramp-gw-gw-proc 'binary 'binary)
(tramp-compat-set-process-query-on-exit-flag tramp-gw-gw-proc nil)
(set-process-query-on-exit-flag tramp-gw-gw-proc nil)
(tramp-message
vec 4 "Opened %s process `%s'"
(case gw-method ('tunnel "HTTP tunnel") ('socks "SOCKS"))
@ -235,14 +235,14 @@ authentication is requested from proxy server, provide it."
(setq proc (open-network-stream
name buffer (nth 1 socks-server) (nth 2 socks-server)))
(set-process-coding-system proc 'binary 'binary)
(tramp-compat-set-process-query-on-exit-flag proc nil)
(set-process-query-on-exit-flag proc nil)
;; Send CONNECT command.
(process-send-string proc (format "%s%s\r\n" command authentication))
(tramp-message
tramp-gw-vector 6 "\n%s"
(format
"%s%s\r\n" command
(tramp-compat-replace-regexp-in-string ;; no password in trace!
(replace-regexp-in-string ;; no password in trace!
"Basic [^\r\n]+" "Basic xxxxx" authentication t)))
(with-current-buffer buffer
;; Trap errors to be traced in the right trace buffer. Often,

324
lisp/net/tramp-sh.el
View File

@ -32,7 +32,6 @@
(eval-when-compile
(require 'cl)
(require 'dired))
(defvar directory-sep-char)
(defvar tramp-gw-tunnel-method)
(defvar tramp-gw-socks-method)
(defvar vc-handled-backends)
@ -380,9 +379,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k")
("-q") ("-r")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
("-q")))
(tramp-copy-keep-date t)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
'("fcp"
@ -986,10 +984,7 @@ of command line.")
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-sh-handle-directory-files-and-attributes)
;; `dired-call-process' performed by default handler.
(dired-compress-file . tramp-sh-handle-dired-compress-file)
(dired-recursive-delete-directory
. tramp-sh-handle-dired-recursive-delete-directory)
(dired-uncache . tramp-handle-dired-uncache)
(expand-file-name . tramp-sh-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
@ -1025,8 +1020,6 @@ of command line.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-sh-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(insert-file-contents-literally
. tramp-sh-handle-insert-file-contents-literally)
(load . tramp-handle-load)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
@ -1041,7 +1034,7 @@ of command line.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-sh-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . tramp-sh-handle-vc-registered)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
(write-region . tramp-sh-handle-write-region))
@ -1148,10 +1141,8 @@ target of the symlink differ."
(format "tramp_perl_file_truename %s"
(tramp-shell-quote-argument localname)))))
;; Do it yourself. We bind `directory-sep-char' here for
;; XEmacs on Windows, which would otherwise use backslash.
(t (let ((directory-sep-char ?/)
(steps (tramp-compat-split-string localname "/"))
;; Do it yourself.
(t (let ((steps (split-string localname "/" 'omit))
(thisstep nil)
(numchase 0)
;; Don't make the following value larger than
@ -1200,9 +1191,8 @@ target of the symlink differ."
symlink-target))
(setq symlink-target localname))
(setq steps
(append (tramp-compat-split-string
symlink-target "/")
steps)))
(append
(split-string symlink-target "/" 'omit) steps)))
(t
;; It's a file.
(setq result (cons thisstep result)))))
@ -1355,8 +1345,8 @@ target of the symlink differ."
res-gid
;; 4. Last access time, as a list of integers. Normally
;; this would be in the same format as `current-time', but
;; the subseconds part is not currently implemented, and (0
;; 0) denotes an unknown time.
;; the subseconds part is not currently implemented, and
;; (0 0) denotes an unknown time.
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise.
'(0 0) '(0 0) '(0 0) ;CCC how to find out?
@ -1370,8 +1360,7 @@ target of the symlink differ."
;; 10. Inode number.
res-inode
;; 11. Device number. Will be replaced by a virtual device number.
-1
))))))
-1))))))
(defun tramp-do-file-attributes-with-perl
(vec localname &optional id-format)
@ -1428,8 +1417,7 @@ target of the symlink differ."
(attr (file-attributes f))
;; '(-1 65535) means file doesn't exists yet.
(modtime (or (nth 5 attr) '(-1 65535))))
(when (boundp 'last-coding-system-used)
(setq coding-system-used (symbol-value 'last-coding-system-used)))
(setq coding-system-used last-coding-system-used)
;; We use '(0 0) as a don't-know value. See also
;; `tramp-do-file-attributes-with-ls'.
(if (not (equal modtime '(0 0)))
@ -1443,8 +1431,7 @@ target of the symlink differ."
(setq attr (buffer-substring (point) (point-at-eol))))
(tramp-set-file-property
v localname "visited-file-modtime-ild" attr))
(when (boundp 'last-coding-system-used)
(set 'last-coding-system-used coding-system-used))
(setq last-coding-system-used coding-system-used)
nil)))))
;; This function makes the same assumption as
@ -1463,7 +1450,7 @@ of."
;; connection.
(if (or (not f)
(eq (visited-file-modtime) 0)
(not (tramp-file-name-handler 'file-remote-p f nil 'connected)))
(not (file-remote-p f nil 'connected)))
t
(with-parsed-tramp-file-name f nil
(let* ((remote-file-name-inhibit-cache t)
@ -1508,48 +1495,26 @@ of."
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
v
(format "chmod %s %s"
(tramp-compat-decimal-to-octal mode)
(tramp-shell-quote-argument localname))
(format "chmod %o %s" mode (tramp-shell-quote-argument localname))
"Error while changing file's mode %s" filename)))
(defun tramp-sh-handle-set-file-times (filename &optional time)
"Like `set-file-times' for Tramp files."
(if (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
(when (tramp-get-remote-touch v)
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(let ((time (if (or (null time) (equal time '(0 0)))
(current-time)
time))
;; With GNU Emacs, `format-time-string' has an
;; optional parameter UNIVERSAL. This is preferred,
;; because we could handle the case when the remote
;; host is located in a different time zone as the
;; local host.
(utc (not (featurep 'xemacs))))
(tramp-send-command-and-check
v (format
"%s %s %s %s"
(if utc "env TZ=UTC" "")
(tramp-get-remote-touch v)
(if (tramp-get-connection-property v "touch-t" nil)
(format "-t %s"
(if utc
(format-time-string "%Y%m%d%H%M.%S" time t)
(format-time-string "%Y%m%d%H%M.%S" time)))
"")
(tramp-shell-quote-argument localname))))))
;; We handle also the local part, because in older Emacsen,
;; without `set-file-times', this function is an alias for this.
;; We are local, so we don't need the UTC settings.
(zerop
(tramp-call-process
nil "touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument filename)))))
(with-parsed-tramp-file-name filename nil
(when (tramp-get-remote-touch v)
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(let ((time (if (or (null time) (equal time '(0 0)))
(current-time)
time)))
(tramp-send-command-and-check
v (format
"env TZ=UTC %s %s %s"
(tramp-get-remote-touch v)
(if (tramp-get-connection-property v "touch-t" nil)
(format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
"")
(tramp-shell-quote-argument localname)))))))
(defun tramp-set-file-uid-gid (filename &optional uid gid)
"Set the ownership for FILENAME.
@ -1653,8 +1618,7 @@ be non-negative integers."
(goto-char (point-max))
(delete-blank-lines)
(when (> (point-max) (point-min))
(tramp-compat-funcall
'substring-no-properties (buffer-string))))))))
(substring-no-properties (buffer-string))))))))
(defun tramp-sh-handle-set-file-acl (filename acl-string)
"Like `set-file-acl' for Tramp files."
@ -1905,7 +1869,7 @@ be non-negative integers."
(when cache-hit (list cache-hit))))
;; We cannot use a length of 0, because file properties
;; for "foo" and "foo/" are identical.
(tramp-compat-number-sequence (length filename) 1 -1)))))
(number-sequence (length filename) 1 -1)))))
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
@ -1928,14 +1892,7 @@ be non-negative integers."
(format "tramp_perl_file_name_all_completions %s %s %d"
(tramp-shell-quote-argument localname)
(tramp-shell-quote-argument filename)
(if (symbol-value
;; `read-file-name-completion-ignore-case'
;; is introduced with Emacs 22.1.
(if (boundp
'read-file-name-completion-ignore-case)
'read-file-name-completion-ignore-case
'completion-ignore-case))
1 0)))
(if read-file-name-completion-ignore-case 1 0)))
(format (concat
"(cd %s 2>&1 && (%s -a %s 2>/dev/null"
@ -2058,19 +2015,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(tramp-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))
;; Compat section.
;; Compat section. PRESERVE-EXTENDED-ATTRIBUTES has been
;; introduced with Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and
;; renamed in Emacs 24.3.
(preserve-extended-attributes
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)))
(preserve-uid-gid
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
(t
(tramp-run-real-handler
'copy-file (list filename newname ok-if-already-exists keep-date)))))
'copy-file
(list filename newname ok-if-already-exists keep-date preserve-uid-gid)))))
(defun tramp-sh-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
@ -2125,7 +2081,8 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
(tramp-do-copy-or-rename-file
'rename filename newname ok-if-already-exists t t)
'rename filename newname ok-if-already-exists
'keep-time 'preserve-uid-gid)
(tramp-run-real-handler
'rename-file (list filename newname ok-if-already-exists))))
@ -2291,11 +2248,11 @@ the uid and gid from FILENAME."
op))))
(localname1
(if t1
(tramp-file-name-handler 'file-remote-p filename 'localname)
(file-remote-p filename 'localname)
filename))
(localname2
(if t2
(tramp-file-name-handler 'file-remote-p newname 'localname)
(file-remote-p newname 'localname)
newname))
(prefix (file-remote-p (if t1 filename newname)))
cmd-result)
@ -2333,12 +2290,12 @@ the uid and gid from FILENAME."
(zerop
(logand
(file-modes (file-name-directory localname1))
(tramp-compat-octal-to-decimal "1000"))))
(string-to-number "1000" 8))))
(file-writable-p (file-name-directory localname2))
(or (file-directory-p localname2)
(file-writable-p localname2))))
(if (eq op 'copy)
(tramp-compat-copy-file
(copy-file
localname1 localname2 ok-if-already-exists
keep-date preserve-uid-gid)
(tramp-run-real-handler
@ -2378,15 +2335,14 @@ the uid and gid from FILENAME."
;; Since this does not work reliable, we also
;; give read permissions.
(set-file-modes
(concat prefix tmpfile)
(tramp-compat-octal-to-decimal "0777"))
(concat prefix tmpfile) (string-to-number "0777" 8))
(tramp-set-file-uid-gid
(concat prefix tmpfile)
(tramp-get-local-uid 'integer)
(tramp-get-local-gid 'integer)))
(t2
(if (eq op 'copy)
(tramp-compat-copy-file
(copy-file
localname1 tmpfile t
keep-date preserve-uid-gid)
(tramp-run-real-handler
@ -2395,8 +2351,7 @@ the uid and gid from FILENAME."
;; We must change the ownership as local user.
;; Since this does not work reliable, we also
;; give read permissions.
(set-file-modes
tmpfile (tramp-compat-octal-to-decimal "0777"))
(set-file-modes tmpfile (string-to-number "0777" 8))
(tramp-set-file-uid-gid
tmpfile
(tramp-get-remote-uid v 'integer)
@ -2455,7 +2410,7 @@ The method used must be an out-of-band method."
;; Save exit.
(ignore-errors
(if dir-flag
(tramp-compat-delete-directory
(delete-directory
(expand-file-name ".." tmpfile) 'recursive)
(delete-file tmpfile)))))
@ -2628,7 +2583,7 @@ The method used must be an out-of-band method."
orig-vec 6 "%s"
(mapconcat 'identity (process-command p) " "))
(tramp-set-connection-property p "vector" orig-vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
;; We must adapt `tramp-local-end-of-line' for
;; sending the password.
@ -2676,7 +2631,7 @@ The method used must be an out-of-band method."
(unless (eq op 'copy)
(if (file-regular-p filename)
(delete-file filename)
(tramp-compat-delete-directory filename 'recursive))))))
(delete-directory filename 'recursive))))))
(defun tramp-sh-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@ -2716,51 +2671,16 @@ The method used must be an out-of-band method."
;; Dired.
;; CCC: This does not seem to be enough. Something dies when
;; we try and delete two directories under Tramp :/
(defun tramp-sh-handle-dired-recursive-delete-directory (filename)
"Recursively delete the directory given.
This is like `dired-recursive-delete-directory' for Tramp files."
(with-parsed-tramp-file-name filename nil
;; Run a shell command 'rm -r <localname>'.
;; Code shamelessly stolen from the dired implementation and, um, hacked :)
(unless (file-exists-p filename)
(tramp-error v 'file-error "No such directory: %s" filename))
;; Which is better, -r or -R? (-r works for me <daniel@danann.net>).
(tramp-send-command
v
(format "rm -rf %s" (tramp-shell-quote-argument localname))
;; Don't read the output, do it explicitly.
nil t)
;; Wait for the remote system to return to us...
;; This might take a while, allow it plenty of time.
(tramp-wait-for-output (tramp-get-connection-process v) 120)
;; Make sure that it worked...
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-directory-property v localname)
(and (file-exists-p filename)
(tramp-error
v 'file-error "Failed to recursively delete %s" filename))))
(defvar dired-compress-file-suffixes)
(declare-function dired-remove-file "dired-aux")
(defun tramp-sh-handle-dired-compress-file (file &rest _ok-flag)
(defun tramp-sh-handle-dired-compress-file (file)
"Like `dired-compress-file' for Tramp files."
;; OK-FLAG is valid for XEmacs only, but not implemented.
;; Code stolen mainly from dired-aux.el.
(with-parsed-tramp-file-name file nil
(tramp-flush-file-property v localname)
(save-excursion
(let ((suffixes
(if (not (featurep 'xemacs))
;; Emacs case
(symbol-value 'dired-compress-file-suffixes)
;; XEmacs has `dired-compression-method-alist', which is
;; transformed into `dired-compress-file-suffixes' structure.
(mapcar
(lambda (x)
(list (concat (regexp-quote (nth 1 x)) "\\'")
nil
(mapconcat 'identity (nth 3 x) " ")))
(symbol-value 'dired-compression-method-alist))))
(let ((suffixes dired-compress-file-suffixes)
suffix)
;; See if any suffix rule matches this file name.
(while suffixes
@ -2778,8 +2698,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(when (tramp-send-command-and-check
v (concat (nth 2 suffix) " "
(tramp-shell-quote-argument localname)))
;; `dired-remove-file' is not defined in XEmacs.
(tramp-compat-funcall 'dired-remove-file file)
(dired-remove-file file)
(string-match (car suffix) file)
(concat (substring file 0 (match-beginning 0))))))
(t
@ -2789,8 +2708,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(when (tramp-send-command-and-check
v (concat "gzip -f "
(tramp-shell-quote-argument localname)))
;; `dired-remove-file' is not defined in XEmacs.
(tramp-compat-funcall 'dired-remove-file file)
(dired-remove-file file)
(cond ((file-exists-p (concat file ".gz"))
(concat file ".gz"))
((file-exists-p (concat file ".z"))
@ -2900,9 +2818,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
;; Decode the output, it could be multibyte.
(decode-coding-region
beg (point-max)
(or file-name-coding-system
(and (boundp 'default-file-name-coding-system)
(symbol-value 'default-file-name-coding-system))))
(or file-name-coding-system default-file-name-coding-system))
;; The inserted file could be from somewhere else.
(when (and (not wildcard) (not full-directory-p))
@ -2965,13 +2881,10 @@ the result will be a local, non-Tramp, file name."
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../"). We bind
;; `directory-sep-char' here for XEmacs on Windows, which would
;; otherwise use backslash. `default-directory' is bound,
;; because on Windows there would be problems with UNC shares or
;; Cygwin mounts.
(let ((directory-sep-char ?/)
(default-directory (tramp-compat-temporary-file-directory)))
;; `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
;; be problems with UNC shares or Cygwin mounts.
(let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name
method user host
(tramp-drop-volume-letter
@ -3093,7 +3006,7 @@ the result will be a local, non-Tramp, file name."
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
(unless (tramp-compat-process-get
(unless (process-get
(tramp-get-connection-process v) 'remote-tty)
(tramp-error
v 'file-error
@ -3103,7 +3016,7 @@ the result will be a local, non-Tramp, file name."
;; process. We ignore errors, because the process
;; could have finished already.
(ignore-errors
(tramp-compat-set-process-query-on-exit-flag p t)
(set-process-query-on-exit-flag p t)
(set-marker (process-mark p) (point)))
;; Return process.
p))))
@ -3227,12 +3140,7 @@ the result will be a local, non-Tramp, file name."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
;; `process-file-side-effects' has been introduced with GNU
;; Emacs 23.2. If set to nil, no remote file will be changed
;; by `program'. If it doesn't exist, we assume its default
;; value t.
(unless (and (boundp 'process-file-side-effects)
(not (symbol-value 'process-file-side-effects)))
(unless process-file-side-effects
(tramp-flush-directory-property v ""))
;; Return exit status.
@ -3258,7 +3166,7 @@ the result will be a local, non-Tramp, file name."
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
(tramp-method-out-of-band-p v size))
(copy-file filename tmpfile t t))
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time))
;; Use inline encoding for file transfer.
(rem-enc
@ -3319,30 +3227,6 @@ the result will be a local, non-Tramp, file name."
(run-hooks 'tramp-handle-file-local-copy-hook)
tmpfile)))
;; This is needed for XEmacs only. Code stolen from files.el.
(defun tramp-sh-handle-insert-file-contents-literally
(filename &optional visit beg end replace)
"Like `insert-file-contents-literally' for Tramp files."
(let ((format-alist nil)
(after-insert-file-functions nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
(find-buffer-file-type-function
(if (fboundp 'find-buffer-file-type)
(symbol-function 'find-buffer-file-type)
nil))
(inhibit-file-name-handlers
'(epa-file-handler image-file-handler jka-compr-handler))
(inhibit-file-name-operation 'insert-file-contents))
(unwind-protect
(progn
(fset 'find-buffer-file-type (lambda (_filename) t))
(insert-file-contents filename visit beg end replace))
;; Save exit.
(if find-buffer-file-type-function
(fset 'find-buffer-file-type find-buffer-file-type-function)
(fmakunbound 'find-buffer-file-type)))))
;; CCC grok LOCKNAME
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname confirm)
@ -3359,14 +3243,13 @@ the result will be a local, non-Tramp, file name."
;; (error
;; "tramp-sh-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
(when (and confirm (file-exists-p filename))
(unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
(tramp-error v 'file-error "File not overwritten")))
(let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer))
(let ((uid (or (nth 2 (file-attributes filename 'integer))
(tramp-get-remote-uid v 'integer)))
(gid (or (nth 3 (tramp-compat-file-attributes filename 'integer))
(gid (or (nth 3 (file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer))))
(if (and (tramp-local-host-p v)
@ -3424,9 +3307,7 @@ the result will be a local, non-Tramp, file name."
(signal (car err) (cdr err))))
;; Now, `last-coding-system-used' has the right value. Remember it.
(when (boundp 'last-coding-system-used)
(setq coding-system-used
(symbol-value 'last-coding-system-used))))
(setq coding-system-used last-coding-system-used))
;; The permissions of the temporary file should be set. If
;; FILENAME does not exist (eq modes nil) it has been
@ -3436,7 +3317,7 @@ the result will be a local, non-Tramp, file name."
(when modes
(set-file-modes
tmpfile
(logior (or modes 0) (tramp-compat-octal-to-decimal "0400"))))
(logior (or modes 0) (string-to-number "0400" 8))))
;; This is a bit lengthy due to the different methods
;; possible for file transfer. First, we check whether the
@ -3576,7 +3457,7 @@ the result will be a local, non-Tramp, file name."
(let (last-coding-system-used (need-chown t))
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(let ((file-attr (tramp-compat-file-attributes filename 'integer)))
(let ((file-attr (file-attributes filename 'integer)))
(set-visited-file-modtime
;; We must pass modtime explicitly, because FILENAME can
;; be different from (buffer-file-name), f.e. if
@ -3611,7 +3492,7 @@ the result will be a local, non-Tramp, file name."
;; any other remote command.
(defun tramp-sh-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
(tramp-compat-with-temp-message ""
(with-temp-message ""
(with-parsed-tramp-file-name file nil
(with-tramp-progress-reporter
v 3 (format-message "Checking `vc-registered' for %s" file)
@ -3790,9 +3671,9 @@ Fall back to normal file name handler if no Tramp handler exists."
(tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p)
(tramp-set-connection-property p "vector" v)
;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'.
(tramp-compat-process-put p 'events events)
(tramp-compat-process-put p 'watch-name localname)
(tramp-compat-set-process-query-on-exit-flag p nil)
(process-put p 'events events)
(process-put p 'watch-name localname)
(set-process-query-on-exit-flag p nil)
(set-process-filter p filter)
;; There might be an error if the monitor is not supported.
;; Give the filter a chance to read the output.
@ -3808,13 +3689,13 @@ file-notify events."
(let ((remote-prefix
(with-current-buffer (process-buffer proc)
(file-remote-p default-directory)))
(rest-string (tramp-compat-process-get proc 'rest-string)))
(rest-string (process-get proc 'rest-string)))
(when rest-string
(tramp-message proc 10 "Previous string:\n%s" rest-string))
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
string (tramp-compat-replace-regexp-in-string
string (replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(when (string-match "Monitoring not supported" string)
(delete-process proc))
@ -3832,7 +3713,7 @@ file-notify events."
(list
proc
(intern-soft
(tramp-compat-replace-regexp-in-string
(replace-regexp-in-string
"_" "-" (downcase (match-string 4 string))))
;; File names are returned as absolute paths. We must
;; add the remote prefix.
@ -3841,24 +3722,23 @@ file-notify events."
(setq string (replace-match "" nil nil string))
;; Remove watch when file or directory to be watched is deleted.
(when (and (member (cadr object) '(moved deleted))
(string-equal
file (tramp-compat-process-get proc 'watch-name)))
(string-equal file (process-get proc 'watch-name)))
(delete-process proc))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the callback directly.
(when (member (cadr object) (tramp-compat-process-get proc 'events))
(when (member (cadr object) (process-get proc 'events))
(tramp-compat-funcall 'file-notify-callback object))))
;; Save rest of the string.
(when (zerop (length string)) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(tramp-compat-process-put proc 'rest-string string)))
(process-put proc 'rest-string string)))
(defun tramp-sh-inotifywait-process-filter (proc string)
"Read output from \"inotifywait\" and add corresponding file-notify events."
(tramp-message proc 6 "%S\n%s" proc string)
(dolist (line (split-string string "[\n\r]+" 'omit-nulls))
(dolist (line (split-string string "[\n\r]+" 'omit))
;; Check, whether there is a problem.
(unless
(string-match
@ -3874,8 +3754,8 @@ file-notify events."
(mapcar
(lambda (x)
(intern-soft
(tramp-compat-replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit-nulls))
(replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit))
(match-string 3 line))))
;; Remove watch when file or directory to be watched is deleted.
(when (equal (cadr object) 'ignored)
@ -3899,7 +3779,7 @@ Only send the definition if it has not already been done."
vec 5 (format-message "Sending script `%s'" name)
;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
;; could result in unwanted command expansion. Avoid this.
(setq script (tramp-compat-replace-regexp-in-string
(setq script (replace-regexp-in-string
(make-string 1 ?\t) (make-string 8 ? ) script))
;; The script could contain a call of Perl. This is masked with `%s'.
(when (and (string-match "%s" script)
@ -3972,8 +3852,7 @@ This function expects to be in the right *tramp* buffer."
(setq result (concat "\\" progname))))
(unless result
(when ignore-tilde
;; Remove all ~/foo directories from dirlist. In XEmacs,
;; `remove' is in CL, and we want to avoid CL dependencies.
;; Remove all ~/foo directories from dirlist.
(let (newdl d)
(while dirlist
(setq d (car dirlist))
@ -4222,14 +4101,14 @@ process to set up. VEC specifies the connection."
(let ((cs (or (and (memq 'utf-8 (coding-system-list))
(string-match "utf-?8" (tramp-get-remote-locale vec))
(cons 'utf-8 'utf-8))
(tramp-compat-funcall 'process-coding-system proc)
(process-coding-system proc)
(cons 'undecided 'undecided)))
cs-decode cs-encode)
(when (symbolp cs) (setq cs (cons cs cs)))
(setq cs-decode (or (car cs) 'undecided)
cs-encode (or (cdr cs) 'undecided))
(setq cs-encode
(tramp-compat-coding-system-change-eol-conversion
(coding-system-change-eol-conversion
cs-encode
(if (string-match
"^Darwin" (tramp-get-connection-property vec "uname" ""))
@ -4237,7 +4116,7 @@ process to set up. VEC specifies the connection."
(tramp-send-command vec "echo foo ; echo bar" t)
(goto-char (point-min))
(when (search-forward "\r" nil t)
(setq cs-decode (tramp-compat-coding-system-change-eol-conversion
(setq cs-decode (coding-system-change-eol-conversion
cs-decode 'dos)))
;; Special setting for Mac OS X.
(when (and (string-match
@ -4245,8 +4124,7 @@ process to set up. VEC specifies the connection."
(memq 'utf-8-hfs (coding-system-list)))
(setq cs-decode 'utf-8-hfs
cs-encode 'utf-8-hfs))
(tramp-compat-funcall
'set-buffer-process-coding-system cs-decode cs-encode)
(set-buffer-process-coding-system cs-decode cs-encode)
(tramp-message
vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))
;; Look for ^M and do something useful if found.
@ -4311,7 +4189,7 @@ process to set up. VEC specifies the connection."
;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror)))
(unless (zerop (length tty))
(tramp-compat-process-put proc 'remote-tty tty)))
(process-put proc 'remote-tty tty)))
;; Dump stty settings in the traces.
(when (>= tramp-verbose 9)
@ -4324,7 +4202,7 @@ process to set up. VEC specifies the connection."
(copy-sequence tramp-remote-process-environment)))
unset vars item)
(while env
(setq item (tramp-compat-split-string (car env) "="))
(setq item (split-string (car env) "=" 'omit))
(setcdr item (mapconcat 'identity (cdr item) "="))
(if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
(push (format "%s %s" (car item) (cdr item)) vars)
@ -4514,8 +4392,7 @@ Goes through the list `tramp-local-coding-commands' and
value
(format-spec-make
?t
(tramp-file-name-handler
'file-remote-p tmpfile 'localname)))))
(file-remote-p tmpfile 'localname)))))
(tramp-maybe-send-script vec value name)
(setq rem-dec name)))
(tramp-message
@ -4711,7 +4588,7 @@ Gateway hops are already opened."
(push
(vector
(tramp-file-name-method hop) (tramp-file-name-user hop)
(tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil)
(tramp-gw-open-connection vec gw hop) nil nil)
target-alist)
;; For the password prompt, we need the correct values.
;; Therefore, we must remember the gateway vector. But we
@ -4845,6 +4722,7 @@ connection if a previous connection has died for some reason."
(unless (and p (processp p) (memq (process-status p) '(run open)))
;; If `non-essential' is non-nil, don't reopen a new connection.
;; This variable has been introduced with Emacs 24.1.
(when (and (boundp 'non-essential) (symbol-value 'non-essential))
(throw 'non-essential 'non-essential))
@ -4897,7 +4775,7 @@ connection if a previous connection has died for some reason."
;; Set sentinel and query flag.
(tramp-set-connection-property p "vector" vec)
(set-process-sentinel p 'tramp-process-sentinel)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
(setq tramp-current-connection
(cons (butlast (append vec nil) 2) (current-time))
tramp-current-host (system-name))
@ -5193,12 +5071,12 @@ Return ATTR."
(when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
(setcar (nthcdr 2 attr) -1))
(when (and (floatp (nth 2 attr))
(<= (nth 2 attr) (tramp-compat-most-positive-fixnum)))
(<= (nth 2 attr) most-positive-fixnum))
(setcar (nthcdr 2 attr) (round (nth 2 attr))))
(when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
(setcar (nthcdr 3 attr) -1))
(when (and (floatp (nth 3 attr))
(<= (nth 3 attr) (tramp-compat-most-positive-fixnum)))
(<= (nth 3 attr) most-positive-fixnum))
(setcar (nthcdr 3 attr) (round (nth 3 attr))))
;; Convert last access time.
(unless (listp (nth 4 attr))
@ -5219,7 +5097,7 @@ Return ATTR."
(when (< (nth 7 attr) 0)
(setcar (nthcdr 7 attr) -1))
(when (and (floatp (nth 7 attr))
(<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
(<= (nth 7 attr) most-positive-fixnum))
(setcar (nthcdr 7 attr) (round (nth 7 attr))))
;; Convert file mode bits to string.
(unless (stringp (nth 8 attr))
@ -5351,7 +5229,7 @@ Return ATTR."
(when elt1
(setcdr elt1
(append
(tramp-compat-split-string (or default-remote-path "") ":")
(split-string (or default-remote-path "") ":" 'omit)
(cdr elt1)))
(setq remote-path (delq 'tramp-default-remote-path remote-path)))
@ -5359,7 +5237,7 @@ Return ATTR."
(when elt2
(setcdr elt2
(append
(tramp-compat-split-string (or own-remote-path "") ":")
(split-string (or own-remote-path "") ":" 'omit)
(cdr elt2)))
(setq remote-path (delq 'tramp-own-remote-path remote-path)))
@ -5563,7 +5441,7 @@ Return ATTR."
"%s -t %s %s"
result
(format-time-string "%Y%m%d%H%M.%S")
(tramp-file-name-handler 'file-remote-p tmpfile 'localname))))
(file-remote-p tmpfile 'localname))))
(delete-file tmpfile))
result)))

68
lisp/net/tramp-smb.el
View File

@ -224,7 +224,6 @@ See `tramp-actions-before-shell' for more info.")
(directory-files . tramp-smb-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-call-process . ignore)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
(expand-file-name . tramp-smb-handle-expand-file-name)
@ -276,7 +275,7 @@ See `tramp-actions-before-shell' for more info.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-smb-handle-write-region))
@ -419,12 +418,11 @@ pass to the OPERATION."
(unwind-protect
(progn
(make-directory tmpdir)
(tramp-compat-copy-directory
dirname tmpdir keep-date 'parents)
(tramp-compat-copy-directory
(copy-directory dirname tmpdir keep-date 'parents)
(copy-directory
(expand-file-name (file-name-nondirectory dirname) tmpdir)
newname keep-date parents))
(tramp-compat-delete-directory tmpdir 'recursive))))
(delete-directory tmpdir 'recursive))))
;; We can copy recursively.
((or t1 t2)
@ -448,7 +446,7 @@ pass to the OPERATION."
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (file-name-as-directory
(tramp-compat-replace-regexp-in-string
(replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))))
(tmpdir (make-temp-name
(expand-file-name
@ -510,7 +508,7 @@ pass to the OPERATION."
(tramp-message
v 6 "%s" (mapconcat 'identity (process-command p) " "))
(tramp-set-connection-property p "vector" v)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-with-tar)
(while (memq (process-status p) '(run open))
@ -520,7 +518,7 @@ pass to the OPERATION."
;; Reset the transfer process properties.
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil)
(when t1 (tramp-compat-delete-directory tmpdir 'recurse))))
(when t1 (delete-directory tmpdir 'recurse))))
;; Handle KEEP-DATE argument.
(when keep-date
@ -555,7 +553,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
0 (format "Copying %s to %s" filename newname)
(if (file-directory-p filename)
(tramp-compat-copy-directory filename newname keep-date t t)
(tramp-compat-copy-directory
filename newname keep-date 'parents 'copy-contents)
(let ((tmpfile (file-local-copy filename)))
(if tmpfile
@ -601,7 +600,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(mapc
(lambda (file)
(if (file-directory-p file)
(tramp-compat-delete-directory file recursive)
(delete-directory file recursive)
(delete-file file)))
;; We do not want to delete "." and "..".
(directory-files
@ -665,7 +664,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Sort them if necessary.
(unless nosort (setq result (sort result 'string-lessp)))
;; Remove double entries.
(tramp-compat-delete-dups result)))
(delete-dups result)))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
@ -730,7 +729,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(domain (tramp-file-name-domain v))
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (tramp-compat-replace-regexp-in-string
(localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" real-host "/" share) "-E")))
@ -765,11 +764,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-message
v 6 "%s" (mapconcat 'identity (process-command p) " "))
(tramp-set-connection-property p "vector" v)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-get-acl)
(when (> (point-max) (point-min))
(tramp-compat-funcall
'substring-no-properties (buffer-string)))))
(substring-no-properties (buffer-string)))))
;; Reset the transfer process properties.
(tramp-set-connection-property v "process-name" nil)
@ -1068,9 +1066,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-smb-send-command
v
(if (tramp-smb-get-cifs-capabilities v)
(format
"posix_mkdir \"%s\" %s"
file (tramp-compat-decimal-to-octal (default-file-modes)))
(format "posix_mkdir \"%s\" %o" file (default-file-modes))
(format "mkdir \"%s\"" file)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
@ -1240,12 +1236,7 @@ target of the symlink differ."
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
;; `process-file-side-effects' has been introduced with GNU
;; Emacs 23.2. If set to nil, no remote file will be changed
;; by `program'. If it doesn't exist, we assume its default
;; value t.
(unless (and (boundp 'process-file-side-effects)
(not (symbol-value 'process-file-side-effects)))
(unless process-file-side-effects
(tramp-flush-directory-property v ""))
;; Return exit status.
@ -1296,9 +1287,10 @@ target of the symlink differ."
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
;; We must rename via copy.
(tramp-compat-copy-file filename newname ok-if-already-exists t t t)
(copy-file
filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
(if (file-directory-p filename)
(tramp-compat-delete-directory filename 'recursive)
(delete-directory filename 'recursive)
(delete-file filename)))))
(defun tramp-smb-action-set-acl (proc vec)
@ -1325,10 +1317,10 @@ target of the symlink differ."
(domain (tramp-file-name-domain v))
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (tramp-compat-replace-regexp-in-string
(localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" real-host "/" share) "-E" "-S"
(tramp-compat-replace-regexp-in-string
(replace-regexp-in-string
"\n" "," acl-string))))
(if (not (zerop (length real-user)))
@ -1364,7 +1356,7 @@ target of the symlink differ."
(tramp-message
v 6 "%s" (mapconcat 'identity (process-command p) " "))
(tramp-set-connection-property p "vector" v)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-set-acl)
(goto-char (point-max))
(unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
@ -1387,9 +1379,7 @@ target of the symlink differ."
(when (tramp-smb-get-cifs-capabilities v)
(tramp-flush-file-property v localname)
(unless (tramp-smb-send-command
v (format "chmod \"%s\" %s"
(tramp-smb-get-localname v)
(tramp-compat-decimal-to-octal mode)))
v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))
@ -1460,9 +1450,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs))
confirm (file-exists-p filename))
(when (and confirm (file-exists-p filename))
(unless (y-or-n-p (format "File %s exists; overwrite anyway? "
filename))
(tramp-error v 'file-error "File not overwritten")))
@ -1575,10 +1563,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
;; Add directory itself.
(push '("" "drwxrwxrwx" 0 (0 0)) res)
;; There's a very strange error (debugged with XEmacs 21.4.14)
;; If there's no short delay, it returns nil. No idea about.
(when (featurep 'xemacs) (sleep-for 0.01))
;; Return entries.
(delq nil res))))))
@ -1738,7 +1722,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
(member
"pathnames"
(split-string
(buffer-substring (point) (point-at-eol)) nil t)))))))))
(buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
(defun tramp-smb-get-stat-capability (vec)
"Check, whether the SMB server supports the STAT command."
@ -1878,7 +1862,7 @@ If ARGUMENT is non-nil, use it as argument for
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
(tramp-set-connection-property p "vector" vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-query-on-exit-flag p nil)
;; Set variables for computing the prompt for reading password.
(setq tramp-current-method tramp-smb-method

645
lisp/net/tramp.el
View File

File diff suppressed because it is too large Load Diff

45
lisp/net/trampver.el
View File

@ -6,7 +6,7 @@
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Keywords: comm, processes
;; Package: tramp
;; Version: 2.2.13.25.1
;; Version: 2.3.0-pre
;; This file is part of GNU Emacs.
@ -27,45 +27,36 @@
;; In the Tramp GIT repository, the version number and the bug report
;; address are auto-frobbed from configure.ac, so you should edit that
;; file and run "autoconf && ./configure" to change them. (X)Emacs
;; file and run "autoconf && ./configure" to change them. Emacs
;; version check is defined in macro AC_EMACS_INFO of aclocal.m4;
;; should be changed only there.
;;;###tramp-autoload
(defconst tramp-version "2.2.13.25.1"
(defconst tramp-version "2.3.0-pre"
"This version of Tramp.")
;;;###tramp-autoload
(defconst tramp-bug-report-address "tramp-devel@gnu.org"
"Email address to send bug reports to.")
;; `locate-dominating-file' does not exist in XEmacs. But it is not used here.
(autoload 'locate-dominating-file "files")
(autoload 'tramp-compat-replace-regexp-in-string "tramp-compat")
(defun tramp-repository-get-version ()
"Try to return as a string the repository revision of the Tramp sources."
(unless (featurep 'xemacs)
(let ((dir (locate-dominating-file (locate-library "tramp") ".git")))
(when dir
(with-temp-buffer
(let ((default-directory (file-name-as-directory dir)))
(and (zerop
(ignore-errors
(call-process "git" nil '(t nil) nil "rev-parse" "HEAD")))
(not (zerop (buffer-size)))
(tramp-compat-replace-regexp-in-string
"\n" "" (buffer-string)))))))))
(let ((dir (locate-dominating-file (locate-library "tramp") ".git")))
(when dir
(with-temp-buffer
(let ((default-directory (file-name-as-directory dir)))
(and (zerop
(ignore-errors
(call-process "git" nil '(t nil) nil "rev-parse" "HEAD")))
(not (zerop (buffer-size)))
(replace-regexp-in-string "\n" "" (buffer-string))))))))
;; Check for (X)Emacs version.
(let ((x (if (or (>= emacs-major-version 22)
(and (featurep 'xemacs)
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
(format "Tramp 2.2.13.25.1 is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
;; Check for Emacs version.
(let ((x (if (>= emacs-major-version 23)
"ok"
(format "Tramp 2.3.0-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
(add-hook 'tramp-unload-hook