From 28dbc92f2ca5d862a9e517dca1ff11a4396b12f8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 12 Oct 2011 20:32:35 +0200 Subject: [PATCH] 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). --- lisp/ChangeLog | 17 +++++++++++++++++ lisp/files.el | 4 ++-- lisp/net/ange-ftp.el | 28 +++++++++++++++++----------- lisp/net/tramp.el | 40 ++++++++++++++++++++++------------------ 4 files changed, 58 insertions(+), 31 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 58a038676e7..62d7cc449ab 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2011-10-12 Michael Albinus + + 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 * textmodes/flyspell.el (flyspell-word): Move with-local-quit diff --git a/lisp/files.el b/lisp/files.el index 8b05b62e524..6321cff91fd 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2629,12 +2629,12 @@ we don't actually set it to the same mode the buffer already has." (if buffer-file-name (let ((name 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. (when (and (stringp remote-id) (string-match (regexp-quote remote-id) name)) (setq name (substring name (match-end 0)))) - ;; Remove backup-suffixes from file name. - (setq name (file-name-sans-versions name)) (while name ;; Find first matching alist entry. (setq mode diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 41716dbdacd..488a4fdb976 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -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, ;;; turning off our handler. -(defun ange-ftp-run-real-handler (operation args) - (let ((inhibit-file-name-handlers - (cons 'ange-ftp-hook-function - (cons 'ange-ftp-completion-hook-function - (and (eq inhibit-file-name-operation operation) - inhibit-file-name-handlers)))) - (inhibit-file-name-operation operation)) - (apply operation args))) +;(defun ange-ftp-run-real-handler (operation args) +; (let ((inhibit-file-name-handlers +; (cons 'ange-ftp-hook-function +; (cons 'ange-ftp-completion-hook-function +; (and (eq inhibit-file-name-operation operation) +; inhibit-file-name-handlers)))) +; (inhibit-file-name-operation operation)) +; (apply operation args))) + +(defalias 'ange-ftp-run-real-handler 'tramp-run-real-handler) (defun ange-ftp-real-file-name-directory (&rest 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.") dir (and dir "/") file)) (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) (setq drive (substring name 1 (1- (match-end 0))) @@ -5014,9 +5020,9 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (if tmp (setq dir (subst-char-in-string ?/ ?. (substring tmp 0 -1) t))) (setq file (file-name-nondirectory name)) - (concat drive + (concat quote drive (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" t) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7ace2911501..adc66f6766c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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 been set up by `rfn-eshadow-setup-minibuffer'." ;; In remote files name, there is a shadowing just for the local part. - (let ((end (or (tramp-compat-funcall - 'overlay-end (symbol-value 'rfn-eshadow-overlay)) - (tramp-compat-funcall 'minibuffer-prompt-end)))) - (when - (file-remote-p - (tramp-compat-funcall 'buffer-substring-no-properties end (point-max))) - (save-excursion - (save-restriction - (narrow-to-region - (1+ (or (string-match - tramp-rfn-eshadow-update-overlay-regexp (buffer-string) end) - end)) - (point-max)) - (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) - (rfn-eshadow-update-overlay-hook nil)) - (tramp-compat-funcall - 'move-overlay rfn-eshadow-overlay (point-max) (point-max)) - (tramp-compat-funcall 'rfn-eshadow-update-overlay))))))) + (ignore-errors + (let ((end (or (tramp-compat-funcall + 'overlay-end (symbol-value 'rfn-eshadow-overlay)) + (tramp-compat-funcall 'minibuffer-prompt-end)))) + (when + (file-remote-p + (tramp-compat-funcall + 'buffer-substring-no-properties end (point-max))) + (save-excursion + (save-restriction + (narrow-to-region + (1+ (or (string-match + tramp-rfn-eshadow-update-overlay-regexp + (buffer-string) end) + end)) + (point-max)) + (let ((rfn-eshadow-overlay tramp-rfn-eshadow-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) (add-hook 'rfn-eshadow-update-overlay-hook -- 2.11.4.GIT