From: Michael Albinus Date: Mon, 2 Sep 2013 13:41:08 +0000 (+0200) Subject: * net/tramp-compat.el (tramp-compat-user-error): Move it ... X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~1686^2~16 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=95beaef369763423111bca752a7a3c5c3d853fb0;p=emacs.git * net/tramp-compat.el (tramp-compat-user-error): Move it ... * net/tramp.el (tramp-user-error): ... here. (tramp-find-method, tramp-check-proper-host) (tramp-dissect-file-name, tramp-debug-message) (tramp-handle-shell-command): * net/tramp-adb.el (tramp-adb-handle-shell-command): * net/tramp-gvfs.el (tramp-gvfs-file-name-handler): Adapt callees. * net/tramp-cache.el (tramp-cache-print): Don't print text properties. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c9cdc559a17..201d29fa558 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2013-09-02 Michael Albinus + + * net/tramp-compat.el (tramp-compat-user-error): Move it ... + * net/tramp.el (tramp-user-error): ... here. + (tramp-find-method, tramp-check-proper-host) + (tramp-dissect-file-name, tramp-debug-message) + (tramp-handle-shell-command): + * net/tramp-adb.el (tramp-adb-handle-shell-command): + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler): Adapt callees. + + * net/tramp-cache.el (tramp-cache-print): Don't print text properties. + 2013-09-02 Martin Rudalics * avoid.el (mouse-avoidance-point-position) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index ff6d0d10671..a5f59227ef7 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -874,7 +874,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (tramp-compat-user-error "Shell command in progress"))) + (tramp-user-error p "Shell command in progress"))) (if current-buffer-p (progn diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 118be597433..b89c5124721 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -285,6 +285,11 @@ KEY identifies the connection, it is either a process or a vector." (let (result) (maphash (lambda (key value) + ;; Remove text properties from KEY. + (when (vectorp key) + (dotimes (i (length key)) + (when (stringp (aref key i)) + (aset key i (substring-no-properties (aref key i)))))) (let ((tmp (format "(%s %s)" (if (processp key) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index f0905245dea..3081c45cc7d 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -518,12 +518,6 @@ EOL-TYPE can be one of `dos', `unix', or `mac'." "`dos', `unix', or `mac'"))))) (t (error "Can't change EOL conversion -- is MULE missing?")))) -;; `user-error' has been added to Emacs 24.3. -(defun tramp-compat-user-error (format &rest args) - "Signal a pilot error." -; (tramp-backtrace) - (apply (if (fboundp 'user-error) 'user-error 'error) format args)) - (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-compat 'force))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e26ffb26e84..9ae352eccc1 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -490,7 +490,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.") First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (unless tramp-gvfs-enabled - (tramp-compat-user-error "Package `tramp-gvfs' not supported")) + (tramp-user-error nil "Package `tramp-gvfs' not supported")) (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) (if fn (save-match-data (apply (cdr fn) args)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 43aa0031cb1..ff0200c1161 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1120,6 +1120,12 @@ calling HANDLER.") ;;; Internal functions which must come first: +(defsubst tramp-user-error (vec-or-proc format &rest args) + "Signal a pilot error." + (apply + 'tramp-error vec-or-proc + (if (fboundp 'user-error) 'user-error 'error) format args)) + ;; Conversion functions between external representation and ;; internal data structure. Convenience functions for internal ;; data structure. @@ -1232,9 +1238,9 @@ their replacement." (if noninteractive (warn "Method %s is obsolete, using %s" result (substring result 0 -1)) - (unless (y-or-n-p (format "Method %s is obsolete, use %s? " + (unless (y-or-n-p (format "Method \"%s\" is obsolete, use \"%s\"? " result (substring result 0 -1))) - (tramp-compat-user-error "Method \"%s\" not supported" result))) + (tramp-user-error nil "Method \"%s\" not supported" result))) (add-to-list 'tramp-warned-obsolete-methods result)) ;; This works with the current set of `tramp-obsolete-methods'. ;; Must be improved, if their are more sophisticated replacements. @@ -1289,8 +1295,8 @@ This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." (or (null method) (get-text-property 0 'tramp-default method)) (or (null user) (get-text-property 0 'tramp-default user)) (member host (mapcar 'car tramp-methods))) - (tramp-compat-user-error - "Host name must not match method `%s'" host)))) + (tramp-cleanup-connection vec) + (tramp-user-error vec "Host name must not match method \"%s\"" host)))) (defun tramp-dissect-file-name (name &optional nodefault) "Return a `tramp-file-name' structure. @@ -1300,7 +1306,7 @@ non-nil, the file name parts are not expanded to their default values." (save-match-data (let ((match (string-match (nth 0 tramp-file-name-structure) name))) - (unless match (tramp-compat-user-error "Not a Tramp file name: %s" name)) + (unless match (tramp-user-error nil "Not a Tramp file name: \"%s\"" name)) (let ((method (match-string (nth 1 tramp-file-name-structure) name)) (user (match-string (nth 2 tramp-file-name-structure) name)) (host (match-string (nth 3 tramp-file-name-structure) name)) @@ -1485,7 +1491,8 @@ ARGUMENTS to actually emit the message (if applicable)." "tramp-debug-message" "tramp-error" "tramp-error-with-buffer" - "tramp-message") + "tramp-message" + "tramp-user-error") t) "$") fn))) @@ -3236,7 +3243,7 @@ User is always nil." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (tramp-compat-user-error "Shell command in progress"))) + (tramp-user-error p "Shell command in progress"))) (if current-buffer-p (progn