+2013-09-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve compatibility with older Emacsen, and XEmacs.
+
+ * net/tramp.el (tramp-find-method, tramp-find-user): Call `propertize'
+ only if it is bound. It isn't for XEmacs.
+ (with-tramp-progress-reporter): Do not let-bind `result'. This
+ yields to scoping errors in XEmacs.
+ (tramp-handle-make-auto-save-file-name): New function, moved from
+ tramp-sh.el.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Add handler
+ for `make-auto-save-file-name'.
+ (tramp-adb--gnu-switches-to-ash): Use
+ `tramp-compat-replace-regexp-in-string'.
+
+ * net/tramp-cache.el (tramp-cache-print): Call
+ `substring-no-properties' only if it is bound. It isn't for XEmacs.
+
+ * net/tramp-cmds.el (tramp-bug): Call `propertize' only if it is
+ bound. It isn't for XEmacs.
+
+ * net/tramp-compat.el (tramp-compat-copy-file): Catch
+ `wrong-number-of-arguments' error.
+ (tramp-compat-replace-regexp-in-string): New defun.
+
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add handler
+ for `make-auto-save-file-name'.
+ (tramp-gvfs-handle-copy-file): Use `tramp-compat-funcall' for
+ `copy-file'.
+ (tramp-gvfs-file-gvfs-monitor-file-process-filter)
+ (tramp-gvfs-file-name): Use `tramp-compat-replace-regexp-in-string'.
+ (tramp-synce-list-devices): Use `push' instead of `pushnew'.
+
+ * net/tramp-gw.el (tramp-gw-open-network-stream): Use
+ `tramp-compat-replace-regexp-in-string'.
+
+ * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Call
+ `tramp-handle-make-auto-save-file-name'.
+ (tramp-sh-handle-make-auto-save-file-name): Move to tramp.el.
+ (tramp-sh-file-gvfs-monitor-dir-process-filter)
+ (tramp-sh-file-inotifywait-process-filter): Use
+ `tramp-compat-replace-regexp-in-string'.
+ (tramp-compute-multi-hops): Use `push' instead of `pushnew'.
+
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add handler
+ for `make-auto-save-file-name'.
+ (tramp-smb-handle-copy-directory): Call
+ `tramp-compat-replace-regexp-in-string'.
+ (tramp-smb-get-file-entries): Use `push' instead of `pushnew'.
+ (tramp-smb-handle-copy-file): Improve error message.
+ (tramp-smb-handle-rename-file): Rename directly only in case
+ `newname' does not exist yet. This is a restriction of smbclient.
+ (tramp-smb-maybe-open-connection): Rerun the function only when
+ `auth-sources' is non-nil.
+
2013-09-08 Kenichi Handa <handa@gnu.org>
* international/characters.el: Set category "^" (Combining) for
(insert-directory . tramp-adb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
- ;; `make-auto-save-file-name' performed by default handler.
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
(make-symbolic-link . ignore)
(split-string
(apply 'concat
(mapcar (lambda (s)
- (replace-regexp-in-string
+ (tramp-compat-replace-regexp-in-string
"\\(.\\)" " -\\1"
- (replace-regexp-in-string "^-" "" s)))
+ (tramp-compat-replace-regexp-in-string "^-" "" s)))
;; FIXME: Warning about removed switches (long and non-dash).
(delq nil
(mapcar
(when (vectorp key)
(dotimes (i (length key))
(when (stringp (aref key i))
- (aset key i (substring-no-properties (aref key i))))))
+ (aset key i
+ (funcall
+ ;; `substring-no-properties' does not exist in XEmacs.
+ (if (functionp 'substring-no-properties)
+ 'substring-no-properties 'identity)
+ (aref key i))))))
(let ((tmp (format
"(%s %s)"
(if (processp key)
'tramp-load-report-modules ; pre-hook
'tramp-append-tramp-buffers ; post-hook
- (propertize "\n" 'display "\
+ (funcall
+ (if (functionp 'propertize) 'propertize 'progn)
+ "\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
and what the local and remote machines are.
"Like `copy-file' for Tramp files (compat function)."
(cond
(preserve-extended-attributes
- (tramp-compat-funcall
- 'copy-file filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))
+ (condition-case nil
+ (tramp-compat-funcall
+ 'copy-file filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (wrong-number-of-arguments
+ (tramp-compat-copy-file
+ filename newname ok-if-already-exists keep-date preserve-uid-gid))))
(preserve-uid-gid
- (tramp-compat-funcall
- 'copy-file filename newname ok-if-already-exists keep-date
- 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))))
"`dos', `unix', or `mac'")))))
(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))))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-compat 'force)))
(insert-directory . tramp-gvfs-handle-insert-directory)
(insert-file-contents . tramp-gvfs-handle-insert-file-contents)
(load . tramp-handle-load)
- ;; `make-auto-save-file-name' performed by default handler.
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
(make-symbolic-link . ignore)
(and (tramp-tramp-file-p newname)
(not (tramp-gvfs-file-name-p newname))))
- ;; We cannot copy directly.
+ ;; We cannot call `copy-file' directly. Use
+ ;; `tramp-compat-funcall' for backward compatibility (number
+ ;; of arguments).
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(cond
(preserve-extended-attributes
- (copy-file
+ (tramp-compat-funcall
+ 'copy-file
filename tmpfile t keep-date preserve-uid-gid
preserve-extended-attributes))
(preserve-uid-gid
- (copy-file filename tmpfile t keep-date preserve-uid-gid))
+ (tramp-compat-funcall
+ 'copy-file filename tmpfile t keep-date preserve-uid-gid))
(t
(copy-file filename tmpfile t keep-date)))
(rename-file tmpfile newname ok-if-already-exists))
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
- string (replace-regexp-in-string
+ string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(while (string-match
"Event = \\([^[:blank:]]+\\)[\n\r]+")
string)
(let ((action (intern-soft
- (replace-regexp-in-string
+ (tramp-compat-replace-regexp-in-string
"_" "-" (downcase (match-string 2 string)))))
(file (match-string 1 string)))
(setq string (replace-match "" nil nil string))
(defun tramp-gvfs-file-name (object-path)
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
- (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+ (tramp-compat-replace-regexp-in-string
+ "^.*/\\([^/]+\\)$" "\\1" object-path)))
(defun tramp-bluez-address (device)
"Return bluetooth device address from a given bluetooth DEVICE name."
(when (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
:system tramp-hal-service device tramp-hal-interface-device
"PropertyExists" "sync.plugin")
- (pushnew
- (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
- :system tramp-hal-service device tramp-hal-interface-device
- "GetPropertyString" "pda.pocketpc.name")
- tramp-synce-devices :test #'equal)))
+ (let ((prop
+ (with-tramp-dbus-call-method
+ tramp-gvfs-dbus-event-vector t
+ :system tramp-hal-service device tramp-hal-interface-device
+ "GetPropertyString" "pda.pocketpc.name")))
+ (unless (member prop tramp-synce-devices)
+ (push prop tramp-synce-devices)))))
(tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-synce-devices)
tramp-synce-devices))
tramp-gw-vector 6 "\n%s"
(format
"%s%s\r\n" command
- (replace-regexp-in-string ;; no password in trace!
+ (tramp-compat-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,
(insert-file-contents-literally
. tramp-sh-handle-insert-file-contents-literally)
(load . tramp-handle-load)
- (make-auto-save-file-name . tramp-sh-handle-make-auto-save-file-name)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(process-file . tramp-sh-handle-process-file)
(fset 'find-buffer-file-type find-buffer-file-type-function)
(fmakunbound 'find-buffer-file-type)))))
-(defun tramp-sh-handle-make-auto-save-file-name ()
- "Like `make-auto-save-file-name' for Tramp files.
-Returns a file name in `tramp-auto-save-directory' for autosaving this file."
- (let ((tramp-auto-save-directory tramp-auto-save-directory)
- (buffer-file-name
- (tramp-subst-strs-in-string
- '(("_" . "|")
- ("/" . "_a")
- (":" . "_b")
- ("|" . "__")
- ("[" . "_l")
- ("]" . "_r"))
- (buffer-file-name))))
- ;; File name must be unique. This is ensured with Emacs 22 (see
- ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
- ;; all other cases we must do it ourselves.
- (when (boundp 'auto-save-file-name-transforms)
- (mapc
- (lambda (x)
- (when (and (string-match (car x) buffer-file-name)
- (not (car (cddr x))))
- (setq tramp-auto-save-directory
- (or tramp-auto-save-directory
- (tramp-compat-temporary-file-directory)))))
- (symbol-value 'auto-save-file-name-transforms)))
- ;; Create directory.
- (when tramp-auto-save-directory
- (setq buffer-file-name
- (expand-file-name buffer-file-name tramp-auto-save-directory))
- (unless (file-exists-p tramp-auto-save-directory)
- (make-directory tramp-auto-save-directory t)))
- ;; Run plain `make-auto-save-file-name'. There might be an advice when
- ;; it is not a magic file name operation (since Emacs 22).
- ;; We must deactivate it temporarily.
- (if (not (ad-is-active 'make-auto-save-file-name))
- (tramp-run-real-handler 'make-auto-save-file-name nil)
- ;; else
- (ad-deactivate 'make-auto-save-file-name)
- (prog1
- (tramp-run-real-handler 'make-auto-save-file-name nil)
- (ad-activate 'make-auto-save-file-name)))))
-
;; CCC grok LOCKNAME
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname confirm)
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
- string (replace-regexp-in-string
+ string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(while (string-match
(list
proc
(intern-soft
- (replace-regexp-in-string
+ (tramp-compat-replace-regexp-in-string
"_" "-" (downcase (match-string 4 string))))
;; File names are returned as absolute paths. We must
;; add the remote prefix.
proc
(mapcar
(lambda (x)
- (intern-soft (replace-regexp-in-string "_" "-" (downcase x))))
+ (intern-soft
+ (tramp-compat-replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit-nulls))
(match-string 3 line))))
;; Usually, we would add an Emacs event now. Unfortunately,
?h (or (tramp-file-name-host (car target-alist)) ""))))
(with-parsed-tramp-file-name proxy l
;; Add the hop.
- (pushnew l target-alist :test #'equal)
+ (push l target-alist)
;; Start next search.
(setq choices tramp-default-proxies-alist)))))
vec 'file-error
"Connection `%s' is not supported for gateway access." hop))
;; Open the gateway connection.
- (pushnew
+ (push
(vector
(tramp-file-name-method hop) (tramp-file-name-user hop)
(tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil)
- target-alist :test #'equal)
+ target-alist)
;; For the password prompt, we need the correct values.
;; Therefore, we must remember the gateway vector. But we
;; cannot do it as connection property, because it shouldn't
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
- ;; `make-auto-save-file-name' performed by default handler.
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (file-name-as-directory
- (replace-regexp-in-string
+ (tramp-compat-replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))))
(tmpdir (make-temp-name
(expand-file-name
(unless (tramp-smb-send-command
v (format "put \"%s\" \"%s\""
filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
+ (tramp-error
+ v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
;; KEEP-DATE handling.
(when keep-date
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
- (if (and (tramp-equal-remote filename newname)
+ (if (and (not (file-exists-p newname))
+ (tramp-equal-remote filename newname)
(string-equal
(tramp-smb-get-share (tramp-dissect-file-name filename))
(tramp-smb-get-share (tramp-dissect-file-name newname))))
(while (not (eobp))
(setq entry (tramp-smb-read-file-entry share))
(forward-line)
- (when entry (pushnew entry res :test #'equal))))
+ (when entry (push entry res))))
;; Cache share entries.
(unless share
(tramp-set-connection-property v "share-cache" res)))
;; Add directory itself.
- (pushnew '("" "drwxrwxrwx" 0 (0 0)) res :test #'equal)
+ (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.
(error
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (if (search-forward-regexp
- tramp-smb-wrong-passwd-regexp nil t)
+ (if (and (boundp 'auth-sources)
+ (symbol-value 'auth-sources)
+ (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t))
;; Disable `auth-source' and `password-cache'.
(let (auth-sources)
(tramp-cleanup vec)
;; This works with the current set of `tramp-obsolete-methods'.
;; Must be improved, if their are more sophisticated replacements.
(setq result (substring result 0 -1)))
- ;; We must mark, whether a default value has been used.
- (if (or method (null result))
+ ;; We must mark, whether a default value has been used. Not
+ ;; applicable for XEmacs.
+ (if (or method (null result) (null (functionp 'propertize)))
result
- (propertize result 'tramp-default t))))
+ (tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-user (method user host)
"Return the right user string to use.
(setq choices nil)))
luser)
tramp-default-user)))
- ;; We must mark, whether a default value has been used.
- (if (or user (null result))
+ ;; We must mark, whether a default value has been used. Not
+ ;; applicable for XEmacs.
+ (if (or user (null result) (null (functionp 'propertize)))
result
- (propertize result 'tramp-default t))))
+ (tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-host (method user host)
"Return the right host string to use.
(declare (indent 3) (debug t))
`(progn
(tramp-message ,vec ,level "%s..." ,message)
- (let ((result "failed")
+ (let ((cookie "failed")
(tm
;; We start a pulsing progress reporter after 3 seconds. Feature
;; introduced in Emacs 24.1.
#'tramp-progress-reporter-update pr)))))))
(unwind-protect
;; Execute the body.
- (prog1 (progn ,@body) (setq result "done"))
+ (prog1 (progn ,@body) (setq cookie "done"))
;; Stop progress reporter.
(if tm (tramp-compat-funcall 'cancel-timer tm))
- (tramp-message ,vec ,level "%s...%s" ,message result)))))
+ (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
;;; Auto saving to a special directory:
+(defun tramp-handle-make-auto-save-file-name ()
+ "Like `make-auto-save-file-name' for Tramp files.
+Returns a file name in `tramp-auto-save-directory' for autosaving this file."
+ (let ((tramp-auto-save-directory tramp-auto-save-directory)
+ (buffer-file-name
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ (buffer-file-name))))
+ ;; File name must be unique. This is ensured with Emacs 22 (see
+ ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
+ ;; all other cases we must do it ourselves.
+ (when (boundp 'auto-save-file-name-transforms)
+ (mapc
+ (lambda (x)
+ (when (and (string-match (car x) buffer-file-name)
+ (not (car (cddr x))))
+ (setq tramp-auto-save-directory
+ (or tramp-auto-save-directory
+ (tramp-compat-temporary-file-directory)))))
+ (symbol-value 'auto-save-file-name-transforms)))
+ ;; Create directory.
+ (when tramp-auto-save-directory
+ (setq buffer-file-name
+ (expand-file-name buffer-file-name tramp-auto-save-directory))
+ (unless (file-exists-p tramp-auto-save-directory)
+ (make-directory tramp-auto-save-directory t)))
+ ;; Run plain `make-auto-save-file-name'. There might be an advice when
+ ;; it is not a magic file name operation (since Emacs 22).
+ ;; We must deactivate it temporarily.
+ (if (not (ad-is-active 'make-auto-save-file-name))
+ (tramp-run-real-handler 'make-auto-save-file-name nil)
+ ;; else
+ (ad-deactivate 'make-auto-save-file-name)
+ (prog1
+ (tramp-run-real-handler 'make-auto-save-file-name nil)
+ (ad-activate 'make-auto-save-file-name)))))
+
(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
(defadvice make-auto-save-file-name
(around tramp-advice-make-auto-save-file-name () activate)
projects / emacs.git / commitdiff