Commit 28dbc92f authored by Michael Albinus's avatar Michael Albinus
Browse files

Fix Bug#6019, Bug#9315.

* files.el (set-auto-mode): Call `file-name-sans-versions' for the
complete `buffer-file-name', the local file name part could look
remotely (for example on VMS).

* net/ange-ftp.el (ange-ftp-run-real-handler): Make it an alias of
`tramp-run-real-handler'.
(ange-ftp-fix-name-for-vms): Handle the case, where `name' is
already quoted by '"'.

* net/tramp.el (tramp-rfn-eshadow-update-overlay): Ignore errors.
Let `file-name-handler-alist' be nil, the local file name part
could look remotely (for example on VMS).
parent e1a3f5b1
2011-10-12 Michael Albinus <michael.albinus@gmx.de>
Fix Bug#6019, Bug#9315.
* files.el (set-auto-mode): Call `file-name-sans-versions' for the
complete `buffer-file-name', the local file name part could look
remotely (for example on VMS).
* net/ange-ftp.el (ange-ftp-run-real-handler): Make it an alias of
`tramp-run-real-handler'.
(ange-ftp-fix-name-for-vms): Handle the case, where `name' is
already quoted by '"'.
* net/tramp.el (tramp-rfn-eshadow-update-overlay): Ignore errors.
Let `file-name-handler-alist' be nil, the local file name part
could look remotely (for example on VMS).
2011-10-12 Stefan Monnier <monnier@iro.umontreal.ca> 2011-10-12 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/flyspell.el (flyspell-word): Move with-local-quit * textmodes/flyspell.el (flyspell-word): Move with-local-quit
......
...@@ -2629,12 +2629,12 @@ we don't actually set it to the same mode the buffer already has." ...@@ -2629,12 +2629,12 @@ we don't actually set it to the same mode the buffer already has."
(if buffer-file-name (if buffer-file-name
(let ((name buffer-file-name) (let ((name buffer-file-name)
(remote-id (file-remote-p buffer-file-name))) (remote-id (file-remote-p buffer-file-name)))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
;; Remove remote file name identification. ;; Remove remote file name identification.
(when (and (stringp remote-id) (when (and (stringp remote-id)
(string-match (regexp-quote remote-id) name)) (string-match (regexp-quote remote-id) name))
(setq name (substring name (match-end 0)))) (setq name (substring name (match-end 0))))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
(while name (while name
;; Find first matching alist entry. ;; Find first matching alist entry.
(setq mode (setq mode
......
...@@ -4412,14 +4412,16 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ...@@ -4412,14 +4412,16 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;;; Define ways of getting at unmodified Emacs primitives, ;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler. ;;; turning off our handler.
(defun ange-ftp-run-real-handler (operation args) ;(defun ange-ftp-run-real-handler (operation args)
(let ((inhibit-file-name-handlers ; (let ((inhibit-file-name-handlers
(cons 'ange-ftp-hook-function ; (cons 'ange-ftp-hook-function
(cons 'ange-ftp-completion-hook-function ; (cons 'ange-ftp-completion-hook-function
(and (eq inhibit-file-name-operation operation) ; (and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))) ; inhibit-file-name-handlers))))
(inhibit-file-name-operation operation)) ; (inhibit-file-name-operation operation))
(apply operation args))) ; (apply operation args)))
(defalias 'ange-ftp-run-real-handler 'tramp-run-real-handler)
(defun ange-ftp-real-file-name-directory (&rest args) (defun ange-ftp-real-file-name-directory (&rest args)
(ange-ftp-run-real-handler 'file-name-directory args)) (ange-ftp-run-real-handler 'file-name-directory args))
...@@ -5005,7 +5007,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ...@@ -5005,7 +5007,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
dir (and dir "/") dir (and dir "/")
file)) file))
(error "name %s didn't match" name)) (error "name %s didn't match" name))
(let (drive dir file tmp) (let (drive dir file tmp quote)
(if (string-match "\\`\".+\"\\'" name)
(setq name (substring name 1 -1)
quote "\"")
(setq quote ""))
(if (string-match "\\`/[^:]+:/" name) (if (string-match "\\`/[^:]+:/" name)
(setq drive (substring name 1 (setq drive (substring name 1
(1- (match-end 0))) (1- (match-end 0)))
...@@ -5014,9 +5020,9 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ...@@ -5014,9 +5020,9 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(if tmp (if tmp
(setq dir (subst-char-in-string ?/ ?. (substring tmp 0 -1) t))) (setq dir (subst-char-in-string ?/ ?. (substring tmp 0 -1) t)))
(setq file (file-name-nondirectory name)) (setq file (file-name-nondirectory name))
(concat drive (concat quote drive
(and dir (concat "[" (if drive nil ".") dir "]")) (and dir (concat "[" (if drive nil ".") dir "]"))
file))))) file quote)))))
;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1") ;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1")
;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t) ;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t)
......
...@@ -1606,24 +1606,28 @@ This is intended to be used as a minibuffer `post-command-hook' for ...@@ -1606,24 +1606,28 @@ This is intended to be used as a minibuffer `post-command-hook' for
`file-name-shadow-mode'; the minibuffer should have already `file-name-shadow-mode'; the minibuffer should have already
been set up by `rfn-eshadow-setup-minibuffer'." been set up by `rfn-eshadow-setup-minibuffer'."
;; In remote files name, there is a shadowing just for the local part. ;; In remote files name, there is a shadowing just for the local part.
(let ((end (or (tramp-compat-funcall (ignore-errors
'overlay-end (symbol-value 'rfn-eshadow-overlay)) (let ((end (or (tramp-compat-funcall
(tramp-compat-funcall 'minibuffer-prompt-end)))) 'overlay-end (symbol-value 'rfn-eshadow-overlay))
(when (tramp-compat-funcall 'minibuffer-prompt-end))))
(file-remote-p (when
(tramp-compat-funcall 'buffer-substring-no-properties end (point-max))) (file-remote-p
(save-excursion (tramp-compat-funcall
(save-restriction 'buffer-substring-no-properties end (point-max)))
(narrow-to-region (save-excursion
(1+ (or (string-match (save-restriction
tramp-rfn-eshadow-update-overlay-regexp (buffer-string) end) (narrow-to-region
end)) (1+ (or (string-match
(point-max)) tramp-rfn-eshadow-update-overlay-regexp
(let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) (buffer-string) end)
(rfn-eshadow-update-overlay-hook nil)) end))
(tramp-compat-funcall (point-max))
'move-overlay rfn-eshadow-overlay (point-max) (point-max)) (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
(tramp-compat-funcall 'rfn-eshadow-update-overlay))))))) (rfn-eshadow-update-overlay-hook nil)
file-name-handler-alist)
(tramp-compat-funcall
'move-overlay rfn-eshadow-overlay (point-max) (point-max))
(tramp-compat-funcall 'rfn-eshadow-update-overlay))))))))
(when (boundp 'rfn-eshadow-update-overlay-hook) (when (boundp 'rfn-eshadow-update-overlay-hook)
(add-hook 'rfn-eshadow-update-overlay-hook (add-hook 'rfn-eshadow-update-overlay-hook
......
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