;;; 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
;; 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:
;;; Code:
+(eval-when-compile (require 'cl)) ; block, return
(require 'tramp)
(require 'tramp-cache)
(require 'tramp-compat)
;; 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.
(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)
(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)
(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)))
(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
(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)))
(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)