* net/tramp.el (tramp-handle-directory-files-and-attributes-with-stat)

[gnu-emacs] / lisp / net / tramp-smb.el

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 429b3579c2f0bf7a39897b29e330571cff775d5f..41f4c25318a4e982912477539cb8d30b236dc069 100644 (file)
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1,17 +1,17 @@
 ;;; tramp-smb.el --- Tramp access functions for SMB servers
 
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007,
-;;   2008 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;;   2009 Free Software Foundation, Inc.
 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, processes
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,8 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, see
-;; <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -28,6 +27,7 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))      ; block, return
 (require 'tramp)
 (require 'tramp-cache)
 (require 'tramp-compat)
@@ -44,7 +44,7 @@
 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
 ;; a domain in USER, it must be the SMB method.
 (add-to-list 'tramp-default-method-alist
-            `(nil "%" ,tramp-smb-method))
+            `(nil ,tramp-prefix-domain-regexp ,tramp-smb-method))
 
 ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
 ;; the anonymous user is chosen.
@@ -150,7 +150,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-remote-p . tramp-handle-file-remote-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
-    ;; `file-name-as-directory' performed by default handler
+    (file-name-as-directory . tramp-handle-file-name-as-directory)
     (file-name-completion . tramp-handle-file-name-completion)
     (file-name-directory . tramp-handle-file-name-directory)
     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
@@ -216,7 +216,11 @@ PRESERVE-UID-GID is completely ignored."
 
     (if tmpfile
        ;; Remote filename.
-       (rename-file tmpfile newname ok-if-already-exists)
+       (condition-case err
+           (rename-file tmpfile newname ok-if-already-exists)
+         ((error quit)
+          (delete-file tmpfile)
+          (signal (car err) (cdr err))))
 
       ;; Remote newname.
       (when (file-directory-p newname)
@@ -548,10 +552,14 @@ PRESERVE-UID-GID is completely ignored."
   (let ((tmpfile (file-local-copy filename)))
 
     (if tmpfile
-       ;; remote filename
-       (rename-file tmpfile newname ok-if-already-exists)
+       ;; Remote filename.
+       (condition-case err
+           (rename-file tmpfile newname ok-if-already-exists)
+         ((error quit)
+          (delete-file tmpfile)
+          (signal (car err) (cdr err))))
 
-      ;; remote newname
+      ;; Remote newname.
       (when (file-directory-p newname)
        (setq newname (expand-file-name
                      (file-name-nondirectory filename) newname)))
@@ -618,12 +626,13 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
         (list start end tmpfile append 'no-message lockname)))
 
       (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfile filename)
-      (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfile file))
-         (tramp-message
-          v 5 "Writing tmp file %s to file %s...done" tmpfile filename)
-       (tramp-error v 'file-error "Cannot write `%s'" filename))
+      (unwind-protect
+         (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfile file))
+             (tramp-message
+              v 5 "Writing tmp file %s to file %s...done" tmpfile filename)
+           (tramp-error v 'file-error "Cannot write `%s'" filename))
+       (delete-file tmpfile))
 
-      (delete-file tmpfile)
       (unless (equal curbuf (current-buffer))
        (tramp-error
         v 'file-error
@@ -905,20 +914,13 @@ connection if a previous connection has died for some reason."
                  (executable-find tramp-smb-program))
          (error "Cannot find command %s in %s" tramp-smb-program exec-path))
 
-       (let* ((user (tramp-file-name-user vec))
-              (host (tramp-file-name-host vec))
-              (real-user user)
-              (real-host host)
-              domain port args)
-
-         ;; Check for domain ("user%domain") and port ("host#port").
-         (when (and user (string-match "\\(.+\\)%\\(.+\\)" user))
-           (setq real-user (or (match-string 1 user) user)
-                 domain (match-string 2 user)))
-
-         (when (and host (string-match "\\(.+\\)#\\(.+\\)" host))
-           (setq real-host (or (match-string 1 host) host)
-                 port (match-string 2 host)))
+       (let* ((user      (tramp-file-name-user vec))
+              (host      (tramp-file-name-host vec))
+              (real-user (tramp-file-name-real-user vec))
+              (real-host (tramp-file-name-real-host vec))
+              (domain    (tramp-file-name-domain vec))
+              (port      (tramp-file-name-port vec))
+              args)
 
          (if share
              (setq args (list (concat "//" real-host "/" share)))
@@ -948,7 +950,6 @@ connection if a previous connection has died for some reason."
 
            (tramp-message
             vec 6 "%s" (mapconcat 'identity (process-command p) " "))
-           (set-process-sentinel p 'tramp-process-sentinel)
            (tramp-set-process-query-on-exit-flag p nil)
            (tramp-set-connection-property p "smb-share" share)