Commit af9ff9e8 authored by Michael Albinus's avatar Michael Albinus

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.
parent 3aff2f57
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
......
......@@ -137,7 +137,7 @@
(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)
......@@ -407,9 +407,9 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
(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
......
......@@ -289,7 +289,12 @@ KEY identifies the connection, it is either a process or a vector."
(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)
......
......@@ -190,7 +190,9 @@ This includes password cache, file cache, connection cache, buffers."
'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.
......
......@@ -313,13 +313,21 @@ Not actually used. Use `(format \"%o\" i)' instead?"
"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))))
......@@ -518,6 +526,58 @@ EOL-TYPE can be one of `dos', `unix', or `mac'."
"`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)))
......
......@@ -453,7 +453,7 @@ Every entry is a list (NAME ADDRESS).")
(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)
......@@ -594,15 +594,19 @@ is no information where to trace the message.")
(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))
......@@ -950,7 +954,7 @@ is no information where to trace the message.")
(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
......@@ -960,7 +964,7 @@ is no information where to trace the message.")
"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))
......@@ -1158,7 +1162,8 @@ is no information where to trace the message.")
(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."
......@@ -1709,11 +1714,13 @@ They are retrieved from the hal daemon."
(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))
......
......@@ -238,7 +238,7 @@ authentication is requested from proxy server, provide it."
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,
......
......@@ -850,7 +850,7 @@ of command line.")
(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)
......@@ -2978,48 +2978,6 @@ the result will be a local, non-Tramp, filename."
(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)
......@@ -3425,7 +3383,7 @@ Fall back to normal file name handler if no Tramp handler 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
......@@ -3439,7 +3397,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(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.
......@@ -3475,7 +3433,8 @@ Fall back to normal file name handler if no Tramp handler exists."
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,
......@@ -4252,7 +4211,7 @@ Gateway hops are already opened."
?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)))))
......@@ -4270,11 +4229,11 @@ Gateway hops are already opened."
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
......
......@@ -229,7 +229,7 @@ See `tramp-actions-before-shell' for more info.")
(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)
......@@ -403,7 +403,7 @@ pass to the OPERATION."
(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
......@@ -537,7 +537,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(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
......@@ -1151,7 +1152,8 @@ target of the symlink differ."
(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))))
......@@ -1364,14 +1366,14 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
(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.
......@@ -1719,8 +1721,10 @@ If ARGUMENT is non-nil, use it as argument for
(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)
......
......@@ -1222,10 +1222,11 @@ their replacement."
;; 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.
......@@ -1243,10 +1244,11 @@ This is USER, if non-nil. Otherwise, do a lookup in
(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.
......@@ -1641,7 +1643,7 @@ without a visible progress reporter."
(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.
......@@ -1656,10 +1658,10 @@ without a visible progress reporter."
#'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\\>"))
......@@ -3920,6 +3922,48 @@ Return the local name of the temporary file."
;;; 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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment