;; Activate `outline-mode'. This runs `text-mode-hook' and
;; `outline-mode-hook'. We must prevent that local processes
;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
- ;; Furthermore, `outline-regexp' must have the correct value
- ;; already, because it is used by `font-lock-compile-keywords'.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (outline-regexp tramp-debug-outline-regexp))
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
(outline-mode))
- (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
(set (make-local-variable 'outline-level) 'tramp-debug-outline-level)
- `(t
- (eval ,tramp-debug-font-lock-keywords)
- ,(eval tramp-debug-font-lock-keywords)))
+ (set (make-local-variable 'font-lock-keywords)
++ `(t (eval ,tramp-debug-font-lock-keywords)
++ ,(eval tramp-debug-font-lock-keywords)))
;; Do not edit the debug buffer.
(set-keymap-parent (current-local-map) special-mode-map))
(current-buffer)))
(save-match-data
(setq filename (tramp-replace-environment-variables filename))
(with-parsed-tramp-file-name filename nil
- (let ((completion (tramp-completion-mode-p))
- (foreign
- (tramp-find-foreign-file-name-handler filename operation))
- result)
- ;; Call the backend function.
- (if foreign
- (tramp-condition-case-unless-debug err
- (let ((sf (symbol-function foreign)))
- ;; Some packages set the default directory to a
- ;; remote path, before respective Tramp packages
- ;; are already loaded. This results in
- ;; recursive loading. Therefore, we load the
- ;; Tramp packages locally.
- (when (autoloadp sf)
- (let ((default-directory
- (tramp-compat-temporary-file-directory))
- file-name-handler-alist)
- (load (cadr sf) 'noerror 'nomessage)))
-;; (tramp-message
-;; v 4 "Running `%s'..." (cons operation args))
- ;; If `non-essential' is non-nil, Tramp shall
- ;; not open a new connection.
- ;; If Tramp detects that it shouldn't continue
- ;; to work, it throws the `suppress' event.
- ;; This could happen for example, when Tramp
- ;; tries to open the same connection twice in a
- ;; short time frame.
- ;; In both cases, we try the default handler then.
- (setq result
- (catch 'non-essential
- (catch 'suppress
- (when (and tramp-locked (not tramp-locker))
- (setq tramp-locked nil)
- (tramp-error
- (car-safe tramp-current-connection)
- 'file-error
- "Forbidden reentrant call of Tramp"))
- (let ((tl tramp-locked))
- (setq tramp-locked t)
- (unwind-protect
- (let ((tramp-locker t))
- (apply foreign operation args))
- (setq tramp-locked tl))))))
-;; (tramp-message
-;; v 4 "Running `%s'...`%s'" (cons operation args) result)
- (cond
- ((eq result 'non-essential)
- (tramp-message
- v 5 "Non-essential received in operation %s"
- (cons operation args))
- (tramp-run-real-handler operation args))
- ((eq result 'suppress)
- (let (tramp-message-show-message)
+ ;; Give other threads a chance.
+ (tramp-compat-thread-yield)
+ ;; The mutex allows concurrent run of operations. It
+ ;; guarantees, that the threads are not mixed.
+ (tramp-compat-with-mutex (tramp-get-mutex v)
+ (let ((completion (tramp-completion-mode-p))
+ (foreign
+ (tramp-find-foreign-file-name-handler filename operation))
+ result)
+ ;; Call the backend function.
+ (if foreign
+ (tramp-condition-case-unless-debug err
+ (let ((sf (symbol-function foreign))
+ p)
+ ;; Some packages set the default directory to
+ ;; a remote path, before respective Tramp
+ ;; packages are already loaded. This results
+ ;; in recursive loading. Therefore, we load
+ ;; the Tramp packages locally.
+ (when (autoloadp sf)
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory))
- file-name-handler-alist)
++ file-name-handler-alist)
+ (load (cadr sf) 'noerror 'nomessage)))
+ ;; (tramp-message
+ ;; v 4 "Running `%s'..." (cons operation args))
+ ;; Switch process thread.
+ (when (and tramp-mutex
+ (setq p (tramp-get-connection-process v)))
+ (tramp-compat-funcall
+ 'set-process-thread p (tramp-compat-current-thread)))
+ ;; If `non-essential' is non-nil, Tramp shall
+ ;; not open a new connection.
+ ;; If Tramp detects that it shouldn't continue
+ ;; to work, it throws the `suppress' event.
+ ;; This could happen for example, when Tramp
+ ;; tries to open the same connection twice in
+ ;; a short time frame.
+ ;; In both cases, we try the default handler
+ ;; then.
+ (setq result
+ (catch 'non-essential
+ (catch 'suppress
+ (when (and tramp-locked (not tramp-locker))
+ (setq tramp-locked nil)
+ (tramp-error
+ (car-safe tramp-current-connection)
+ 'file-error
+ "Forbidden reentrant call of Tramp"))
+ (let ((tl tramp-locked))
+ (setq tramp-locked t)
+ (unwind-protect
+ (let ((tramp-locker t))
+ (apply foreign operation args))
+ (setq tramp-locked tl))))))
+ ;; (tramp-message
+ ;; v 4 "Running `%s'...`%s'" (cons operation args) result)
+ (cond
+ ((eq result 'non-essential)
(tramp-message
- v 1 "Suppress received in operation %s"
+ v 5 "Non-essential received in operation %s"
(cons operation args))
- (tramp-cleanup-connection v t)
- (tramp-run-real-handler operation args)))
- (t result)))
-
- ;; Trace that somebody has interrupted the operation.
- ((debug quit)
- (let (tramp-message-show-message)
- (tramp-message
- v 1 "Interrupt received in operation %s"
- (cons operation args)))
- ;; Propagate the signal.
- (signal (car err) (cdr err)))
-
- ;; When we are in completion mode, some failed
- ;; operations shall return at least a default
- ;; value in order to give the user a chance to
- ;; correct the file name in the minibuffer.
- ;; In order to get a full backtrace, one could apply
- ;; (setq tramp-debug-on-error t)
- (error
- (cond
- ((and completion (zerop (length localname))
- (memq operation '(file-exists-p file-directory-p)))
- t)
- ((and completion (zerop (length localname))
- (memq operation
- '(expand-file-name file-name-as-directory)))
- filename)
- ;; Propagate the error.
- (t (signal (car err) (cdr err))))))
-
- ;; Nothing to do for us. However, since we are in
- ;; `tramp-mode', we must suppress the volume letter on
- ;; MS Windows.
- (setq result (tramp-run-real-handler operation args))
- (if (stringp result)
- (tramp-drop-volume-letter result)
- result)))))
+ (tramp-run-real-handler operation args))
+ ((eq result 'suppress)
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Suppress received in operation %s"
+ (cons operation args))
+ (tramp-cleanup-connection v t)
+ (tramp-run-real-handler operation args)))
+ (t result)))
+
+ ;; Trace that somebody has interrupted the operation.
+ ((debug quit)
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Interrupt received in operation %s"
+ (cons operation args)))
+ ;; Propagate the signal.
+ (signal (car err) (cdr err)))
+
+ ;; When we are in completion mode, some failed
+ ;; operations shall return at least a default
+ ;; value in order to give the user a chance to
+ ;; correct the file name in the minibuffer. In
+ ;; order to get a full backtrace, one could
+ ;; apply (setq tramp-debug-on-error t)
+ (error
+ (cond
+ ((and completion (zerop (length localname))
+ (memq operation
+ '(file-exists-p file-directory-p)))
+ t)
+ ((and completion (zerop (length localname))
+ (memq operation
+ '(expand-file-name file-name-as-directory)))
+ filename)
+ ;; Propagate the error.
+ (t (signal (car err) (cdr err))))))
+
+ ;; Nothing to do for us. However, since we are in
+ ;; `tramp-mode', we must suppress the volume letter
+ ;; on MS Windows.
+ (setq result (tramp-run-real-handler operation args))
+ (if (stringp result)
+ (tramp-drop-volume-letter result)
+ result))))))
;; When `tramp-mode' is not enabled, or the file name is quoted,
;; we don't do anything.
projects / emacs.git / commitdiff